#line 1 package Pod::Markdown; use 5.006; use strict; use warnings; our $VERSION = '0.02'; use base qw(Pod::Parser); sub initialize { my $self = shift; $self->SUPER::initialize(@_); $self->_private; $self; } sub _private { my $self = shift; $self->{_MyParser} ||= { Text => [], # final text Indent => 0, # list indent levels counter ListType => '-', # character on every item searching => undef, # what are we searching for? (title, author etc.) Title => undef, # page title Author => undef, # page author }; } sub as_markdown { my ($parser, %args) = @_; my $data = $parser->_private; my $lines = $data->{Text}; my @header; if ($args{with_meta}) { @header = $parser->_build_markdown_head; } join("\n" x 2, @header, @{$lines}); } sub _build_markdown_head { my $parser = shift; my $data = $parser->_private; my $paragraph = ''; if (defined $data->{Title}) { $paragraph .= sprintf '[[meta title="%s"]]', $data->{Title}; } if (defined $data->{Author}) { $paragraph .= "\n" . sprintf '[[meta author="%s"]]', $data->{Author}; } return $paragraph; } sub _save { my ($parser, $text) = @_; my $data = $parser->_private; $text = $parser->_indent_text($text); push @{ $data->{Text} }, $text; return; } sub _indent_text { my ($parser, $text) = @_; my $data = $parser->_private; my $level = $data->{Indent}; my $indent = undef; if ($level > 0) { $level--; } $indent = ' ' x ($level * 4); my @lines = map { $indent . $_; } split(/\n/, $text); return wantarray ? @lines : join("\n", @lines); } sub _clean_text { my $parser = shift; my $text = shift; my @trimmed = grep { $_; } split(/\n/, $text); return wantarray ? @trimmed : join("\n", @trimmed); } sub command { my ($parser, $command, $paragraph, $line_num) = @_; my $data = $parser->_private; # cleaning the text $paragraph = $parser->_clean_text($paragraph); # is it a header ? if ($command =~ m{head(\d)}xms) { my $level = $1; # the headers never are indented $parser->_save(sprintf '%s %s', '#' x $level, $paragraph); if ($level == 1) { if ($paragraph =~ m{NAME}xmsi) { $data->{searching} = 'title'; } elsif ($paragraph =~ m{AUTHOR}xmsi) { $data->{searching} = 'author'; } else { $data->{searching} = undef; } } } # opening a list ? elsif ($command =~ m{over}xms) { # update indent level $data->{Indent}++; # closing a list ? } elsif ($command =~ m{back}xms) { # decrement indent level $data->{Indent}--; } elsif ($command =~ m{item}xms) { $parser->_save(sprintf '%s %s', $data->{ListType}, $parser->interpolate($paragraph, $line_num)); } # ignore other commands return; } sub verbatim { my ($parser, $paragraph, $line_num) = @_; $parser->_save($paragraph); } sub textblock { my ($parser, $paragraph, $line_num) = @_; my $data = $parser->_private; # interpolate the paragraph for embebed sequences $paragraph = $parser->interpolate($paragraph, $line_num); # clean the empty lines $paragraph = $parser->_clean_text($paragraph); # searching ? if ($data->{searching}) { if ($data->{searching} =~ m{title|author}xms) { $data->{ ucfirst $data->{searching} } = $paragraph; $data->{searching} = undef; } } # save the text $parser->_save($paragraph); } sub interior_sequence { my ($parser, $seq_command, $seq_argument, $pod_seq) = @_; my $data = $parser->_private; my %interiors = ( 'I' => sub { return '_' . $_[1] . '_' }, # italic 'B' => sub { return '__' . $_[1] . '__' }, # bold 'C' => sub { return '`' . $_[1] . '`' }, # monospace 'F' => sub { return '`' . $_[1] . '`' }, # system path 'S' => sub { return '`' . $_[1] . '`' }, # code 'E' => sub { my ($seq, $charname) = @_; return '<' if $charname eq 'lt'; return '>' if $charname eq 'gt'; return '|' if $charname eq 'verbar'; return '/' if $charname eq 'sol'; return "&$charname;"; }, 'L' => \&_resolv_link, ); if (exists $interiors{$seq_command}) { my $code = $interiors{$seq_command}; return $code->($seq_command, $seq_argument, $pod_seq); } else { return sprintf '%s<%s>', $seq_command, $seq_argument; } } sub _resolv_link { my ($cmd, $arg, $pod_seq) = @_; if ($arg =~ m{^http|ftp}xms) { # direct link to a URL return sprintf '<%s>', $arg; } elsif ($arg =~ m{^(\w+(::\w+)*)$}) { return "[$1](http://search.cpan.org/perldoc?$1)"; } else { return sprintf '%s<%s>', $cmd, $arg; } } 1; __END__ #line 284