libtext-dokuwiki-perl/lib/Text/Dokuwiki/Render/Markdown.pm

package Text::Dokuwiki::Render::Markdown;

use strict;
use warnings;
use utf8;

use base 'Text::Dokuwiki::Render';

sub _header {
  my ($self, $tag, $attrs, $content) = @_;
  my $title = $content;
  utf8::decode($title);

  my $text = $content . "\n";
  $text .= (($tag eq 'h1') ? "=" : "-") x length($title);
  $text .= "\n\n";

  return $text;
}

sub _list {
  my ($self, $attrs, $content) = @_;

  $self->{list_depth} += 1;
  my $text = $self->treewalk($content);
  $self->{list_depth} -= 1;

  return $text . "\n";
}

sub _wrap {
  my ($self, $border, $attrs, $content) = @_;
  return $border . $self->treewalk($content) . $border;
}

sub h1 { my $self = shift; $self->_header('h1', @_); };
sub h2 { my $self = shift; $self->_header('h2', @_); };
sub h3 { my $self = shift; $self->_header('h3', @_); };
sub h4 { my $self = shift; $self->_header('h4', @_); };
sub h5 { my $self = shift; $self->_header('h5', @_); };
sub h6 { my $self = shift; $self->_header('h6', @_); };

sub ul { my $self = shift; $self->_list(@_); };
sub ol { my $self = shift; $self->_list(@_); };

sub b  { my $self = shift; $self->_wrap('**', @_); } # bold
sub i  { my $self = shift; $self->_wrap('*',  @_); } # italics
sub u  { my $self = shift; $self->_wrap('*',  @_); } # underline, replace with italics
sub code { my $self = shift; $self->_wrap('`', @_); } # inline code

sub div {
  my ($self, $attrs, $content) = @_;
  return $content;
}

sub br { return "\n"; };

sub li {
  my ($self, $attrs, $content) = @_;

  my $text = '  ' x $self->{list_depth};
  $text .= ($self->{trace}->[-2] eq 'ol') ? '- ' : '* ';
  $text .= $self->treewalk($content);
  $text .= "\n";

  return $text;
}

sub a {
  my ($self, $attrs, $content) = @_;

  return qq[<a name="$attrs->{name}"></a> ] . $content
    if ($attrs->{name});

  return sprintf("[%s](%s)", $content, $attrs->{href});
}

sub p {
  my ($self, $attrs, $content) = @_;

  return $self->treewalk($content) . "\n\n";
}

sub img {
  my ($self, $attrs, $content) = @_;
  my $title = ($attrs->{title}) ? qq( "$attrs->{title}") : "";
  my $alt   = $attrs->{alt} || $attrs->{title} || '';

  return sprintf("![%s](%s%s)", $alt, $attrs->{src}, $title);
}

sub fn_ref {
  my ($self, $attr, $content) = @_;
  return "[^fn$content]";
}

sub footnote {
  my ($self, $attrs, $content) = @_;

  return "[^fn$attrs->{number}]: " . $self->treewalk($content) . "\n";
}

sub blockquote {
  my ($self, $attrs, $content) = @_;

  my @out = map { "> $_\n" } split /\r?\n/, $content;
  return join("\n", @out);
}

sub pre {
  my ($self, $attrs, $content) = @_;

  my @lines = map { "  " . $_ } split(/\r?\n/o, $content);

  return join("\n", @lines) . "\n\n";
}

sub codeblock {
  my ($self, $attrs, $content) = @_;

  my $out;
  $out = "```";
  $out .= $attrs->{syntax} if $attrs->{syntax};
  $out .= "\n";
  $out .= $content . "\n";
  $out .= "```\n";

  return $out;
}

sub table {
  my ($self, $attrs, $content) = @_;
  return $content . "\n";
}

sub tr {
  my ($self, $attrs, $content) = @_;
  return "|" . $content . "\n";
}

sub _cell {
  my ($self, $attrs, $content) = @_;
  my $cs = $attrs->{colspan} || 1;
  my ($pl, $pr); # read as: padding left/right
  unless ($attrs->{align}) { ($pl, $pr) = ('', ''); }
  elsif  ($attrs->{align} eq 'center') { ($pl, $pr) = (" ", " "); }
  elsif  ($attrs->{align} eq 'left')   { ($pl, $pr) = ("",  " "); }
  elsif  ($attrs->{align} eq 'right')  { ($pl, $pr) = (" ",  ""); }
  return $pl . $content . $pr . ("|" x $cs);
}

sub td { my $self = shift; $self->_cell(@_); }
sub th { my $self = shift; $self->_cell(@_); }

1;