+ Text::Dokuwiki->_parse_text

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', '', '');