diff --git a/lib/Text/Dokuwiki.pm b/lib/Text/Dokuwiki.pm index 0d18b37..ecac1f5 100644 --- a/lib/Text/Dokuwiki.pm +++ b/lib/Text/Dokuwiki.pm @@ -99,6 +99,95 @@ sub _parse_table { return [table => {}, @rows]; } +sub _parse_link { + my ($self, $content) = @_; + my ($href, @text); + + if ((my $pos = index($content, "|")) >= 0) { + $href = substr($content, 0, $pos); + @text = $self->_parse_text(substr($content, $pos + 1)); + } else { + $href = $content; + @text = ($content); + } + + unless ($href =~ m!^[a-z]+://!io) { + $href =~ s{:}{/}oi; + } + + return [a => {href => $href}, @text]; +} + +my $inlines = { + "__" => "__", # underline + "//" => "//", # italic + "**" => "**", # bold + "''" => "''", # monospace + "{{" => "}}", # module/image + "[[" => "]]", # link + "((" => "))", # footnote +}; +sub _parse_text { + my ($self, $line) = @_; + my ($endtag, $endpos, $content); + my @parts = (); + + while ($line) { + $line =~ m!^(?:(.*?)(__|//|''|\*\*|\[\[|\{\{|\(\())?(.*)!o; + my ($before, $match, $after) = ($1, $2, $3); + if ($before) { + push @parts, $before; + $line = $match . $after; + next; + } + if ($after and not $match) { + push @parts, $after; + last; + } + + given ($match) { + when ('\\ ') { # force newline + push @parts, [br => {}]; + $line = $after; + next; + } + default { + $endtag = $inlines->{$match}; + $endpos = index($after, $endtag, 0); + if ($endpos < 0) { # no closing marker? + push @parts, $match; + $line = $after; + next; + } + $content = substr($after, 0, $endpos); + $line = substr($after, $endpos + 2); + continue; + } + } + + my %attrs; + given ($match) { + when ("//") { %attrs = ('font-style' => 'italic'); } + when ("**") { %attrs = ('font-weight' => 'bold'); } + when ("''") { %attrs = ('font-family' => 'monospace'); } + when ("__") { %attrs = ('text-decoration' => 'underline'); } + when ("[[") { push @parts, $self->_parse_link($content); next; } + when ("((") { ...; next; } + when ("{{") { ...; next; } + default { + die("unrecognized inline: $match\n"); + next; + } + } + if (%attrs) { + push @parts, [span => \%attrs, $self->_parse_text($content)]; + next; + } + } + + return @parts; +} + sub parse { my ($self, $text) = @_; my ($tree, $mode, $attrs, $buf) = ([], 'text', '', '');