Pod-Knit/lib/Pod/Knit/PodParser.pm
package Pod::Knit::PodParser;
our $AUTHORITY = 'cpan:YANICK';
# ABSTRACT: parse POD into an XML documen
$Pod::Knit::PodParser::VERSION = '0.0.1';
use strict;
use warnings;
use Pod::Simple::PullParser;
use XML::Writer::Simpler;
use List::AllUtils qw/ first_index /;
use Moose;
use experimental 'smartmatch', 'signatures', 'postderef';
extends 'Pod::Simple::PullParser';
has levels => (
traits => [ 'Array' ],
handles => { all_levels => 'elements' },
is => 'ro',
lazy => 1,
default => sub { [
[],
[ qw/ B L / ],
[qw/ Para Verbatim /],
[qw/ item-text /],
[qw/ over-text /],
( map { ["head$_"] } reverse 1..4),
[ 'Document' ],
]
},
);
has commands => (
is => 'ro',
lazy => 1,
default => sub {
+{
'Document' => { },
'item-text' => { section => 1, },
'verbatim' => { section => 0, },
map {( "head$_" => { section => 1, } )} 1..4,
}
},
);
has xml => (
is => 'ro',
lazy => 1,
default => sub {
XML::Writer::Simpler->new( OUTPUT => 'self' );
},
clearer => 'clear_xml',
);
has to_xml => (
is => 'ro',
lazy => 1,
default => sub($self) {
$self->run;
},
);
sub parse($self,$source) {
$self->set_source( \$source );
$self->strip_verbatim_indent(sub {
my $lines = shift;
(my $indent = $lines->[0]) =~ s/\S.*//;
return $indent;
});
$self->parse_pod;
my $xml = $self->xml->to_string;
$self->clear_xml;
return $xml;
}
sub podname ( $self, $token ) {
$self->commands->{$token}{alias} || $token;
}
sub node_level($self,$token) {
$token = $self->podname($token);
first_index { $token ~~ @$_ } $self->all_levels;
}
sub parse_pod($self, $end_cond = undef ) {
while( my $token = $self->get_token ) {
if( $end_cond and $end_cond->($token) ) {
$self->unget_token($token);
return;
}
if( $token->is_text) {
$self->xml->characters( $token->text );
next;
}
my $tag = $token->tagname;
next if $token->is_end;
my $normalized = $tag;
if( my $alias = $self->commands->{$tag}{alias} ) {
$normalized = $alias;
$token->attr( class => $tag );
}
$self->xml->tag( $self->commands->{$normalized}{section} ? 'section' : $normalized, [
map { s/~//gr } $token->attr_hash->%*
], sub {
if( $self->commands->{$normalized}{section} ) {
$self->xml->tag( $normalized, sub {
$self->parse_pod( sub($tag) {
$tag->is_end and $tag->is_tag( $token->tagname)
});
});
my $level = $self->node_level($normalized);
$self->parse_pod( sub($tag) {
return $tag->is_start && $level <= $self->node_level( $tag->tagname )
});
}
else {
$self->parse_pod( sub($tag) { $tag->is_end and $tag->is_tag(
$token->tagname
) } );
}
});
}
}
1;
__END__
=pod
=encoding UTF-8
Uses L<Pod::Simple::PullParser> to convert a POD document into XML.
=head1 NAME
Pod::Knit::PodParser - parse POD into an XML documen
=head1 VERSION
version 0.0.1
=head1 POD ERRORS
Hey! B<The above document had some coding errors, which are explained
below:>
=over
=item Around line 5:
Unknown directive: =descriptio
=back
=head1 AUTHOR
Yanick Champoux <yanick@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 by Yanick Champoux.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
Full text of the license can be found in the F<LICENSE> file included in
this distribution.
=cut