#!/usr/bin/perl -w
=head1 What is this?
THIS is basically what C<Pod::Tree::dump> does for you, but not
embedded in and spread accross Pod::Tree and Pod::Tree::Node;
Writing your own pod interpreter ought to be easy with this
example.
Enjoy
Sincerely, I<B<crazyinsomniac>>
P.S. you ought to look at some I<comments> i have below, before C<__DA
+TA__>
=cut
use Pod::Tree;
use Pod::Tree::Node;
use vars qw( $String $Indent );
my $tree = new Pod::Tree;
$tree->load_file(__FILE__);
print DumpTree($tree);
# Pod::Tree::Node::DumpList()
sub DumpList {
my($nodes, $open, $close) = @_;
$String .= ' ' x $Indent . "$open\n";
$Indent += 3;
for my $node (@$nodes) {
_dump($node);
}
$Indent -= 3;
return $String .= ' ' x $Indent . "$close\n";
}
#Pod::Tree::Node::SplitBar()
sub SplitBar {
my $children = shift;
my(@text, @link);
while (@$children)
{
my $child = shift @$children;
is_text $child or do
{
push @text, $child;
next;
};
my($text, $link) = split m(\|), $child->{'text'}, 2;
$link and do
{
push @text, text Pod::Tree::Node $text if $text;
push @link, (text Pod::Tree::Node $link), @$children;
return (\@text, \@link)
};
push @text, $child;
}
return (\@text, \@text);
}
#Pod::Tree::Node::SplitTarget()
sub SplitTarget {
my $text = shift;
my($page, $section);
if ($text =~ /^"(.*)"$/s) { # L<"sec">;
$page = '';
$section = $1;
} else { # all other cases
($page, $section) = split m(/), $text, 2;
# to quiet -w
defined $page or $page = '';
defined $section or $section = '';
$page =~ s/\s*\(\d\)$//; # ls (1) -> ls
$section =~ s( ^" | "$ )()xg; # lose the quotes
# L<section in this man page> (without quotes)
if ($page !~ /^[\w.-]+(::[\w.-]+)*$/ and $section eq '') {
$section = $page;
$page = '';
}
}
$section =~ s( \s*\n\s* )( )xg; # close line breaks
$section =~ s( ^\s+ | \s+$ )()xg; # clip leading and trailing W
+S
return ($page, $section);
}
#Pod::Tree::Node::_dump()
sub _dump {
my $node = shift;
my $type = $node->get_type;
$String .= ' ' x $Indent . uc $type . " ";
for ($type) {
/command/ and $String .= _dump_command($node);
/code/ and $String .= _dump_code($node);
/for/ and $String .= _dump_for($node);
/item/ and $String .= _dump_item($node);
/list/ and $String .= _dump_list($node);
/ordinary/ and $String .= "\n";
/root/ and $String .= "\n";
/sequence/ and $String .= _dump_sequence($node);
/text/ and $String .= _dump_text($node);
/verbatim/ and $String .= _dump_verbatim($node);
}
_dump_children($node);
return _dump_siblings($node);
}
#Pod::Tree::Node::_dump_command()
sub _dump_command {
my $node = shift;
my $command = $node->get_command;
my $arg = $node->get_arg;
return "$command $arg\n";
}
#Pod::Tree::Node::_dump_code()
sub _dump_code {
my $node = shift;
my $text = _indent($node->get_text, 3);
my $block = "\n{\n$text}\n";
return _indent($block, $Indent);
}
#Pod::Tree::Node::_dump_for()
sub _dump_for {
my $node = shift;
my $arg = $node->get_arg;
my $text = _indent($node->get_text, $Indent+3);
return "$arg\n$text\n";
}
#Pod::Tree::Node::_dump_item()
sub _dump_item {
my $node = shift;
return uc $node->get_item_type . "\n";
}
#Pod::Tree::Node::_dump_list()
sub _dump_list {
my $node = shift;
return uc $node->get_list_type . "\n";
}
#Pod::Tree::Node::_dump_sequence()
sub _dump_sequence {
my $node = shift;
my $letter = $node->get_letter;
my $link = $node->is_link ? _dump_target($node) : '';
return "$letter$link\n";
}
#Pod::Tree::Node::_dump_text()
sub _dump_text {
my $node = shift;
my $text = $node->get_text;
my $indent = ' ' x ($Indent+5);
$text =~ s( (?<=\n) (?=.) )($indent)xg;
return "$text\n";
}
#Pod::Tree::Node::_dump_verbatim()
sub _dump_verbatim {
my $node = shift;
"\n" . $node->get_text . "\n"
}
#Pod::Tree::Node::_dump_target()
sub _dump_target {
my $node = shift;
my $target = $node->get_target;
my $page = $target->{page};
my $section = $target->{section};
return " $page / $section";
}
#Pod::Tree::Node::_dump_children()
sub _dump_children {
my $node = shift;
my $children = $node->get_children;
$children and DumpList($children, '{', '}');
}
#Pod::Tree::Node::_dump_siblings()
sub _dump_siblings {
my $node = shift;
my $siblings = $node->get_siblings;
$siblings and DumpList($siblings, '[', ']');
}
#Pod::Tree::Node::_indent()
sub _indent {
my($text, $spaces) = @_;
my $indent = ' ' x $spaces;
$text =~ s( (?<=\n) (?=.) )($indent)xg;
$indent . $text
}
#Pod::Tree::Node::_make_item();
sub _make_item {
my($item, $old) = @_;
my $siblings = [];
while (@$old) {
my $sibling = $old->[0];
is_c_item $sibling and last;
is_c_back $sibling and last;
shift @$old;
is_c_over $sibling and do {
$sibling->_make_lists($old);
};
push @$siblings, $sibling;
}
$item->{type } = 'item';
$item->{siblings} = $siblings;
return $item->_set_item_type;
}
#Pod::Tree::Node::make_lists();
sub make_lists {
my $root = shift;
my $nodes = $root->{children};
return $root->_make_lists($nodes);
}
#Pod::Tree::Node::_make_lists()
sub _make_lists {
my($node, $old) = @_;
my $new = [];
my $back;
while (@$old) {
my $child = shift @$old;
is_c_over $child and _make_lists($child, $old);
is_c_item $child and _make_item($child, $old);
is_c_back $child and $back = $child, last;
push @$new, $child;
}
$node->{children} = $new;
is_root $node and return;
$node->{type} = 'list';
$node->{back} = $back;
return $node->_set_list_type;
}
#Pod::Tree::Node::parse_links()
sub parse_links {
my $node = shift;
is_link $node and _parse_link($node); ## my _parse_link
my $children = $node->{children};
for my $child (@$children) {
parse_links($child); ## my parse_links
}
}
#Pod::Tree::Node::_parse_link()
sub _parse_link {
my $node = shift;
$node->{raw_kids} = $node->clone->{children};
my $children = $node->{children};
my($text_kids, $target_kids) = SplitBar($children);
$node->{ children } = $text_kids;
$node->{'target' } = target Pod::Tree::Node $target_kids;
return $node->{'target' };
}
#Pod::Tree::Node::_parse_text()
sub _parse_text {
my $tokens = shift;
my(@stack, @width);
while (@$tokens) {
my $token = shift @$tokens;
length $token or next;
$token =~ /^[A-Z]</ and do {
my $width = $token =~ tr/</</;
push @width, $width;
my $node = letter Pod::Tree::Node $token;
push @stack, $node;
next;
};
@width and $token =~ />{$width[-1],}$/ and do {
my $width = pop @width;
my($letter, $interior) = _pop_sequence(\@stack, $width);
my $node = sequence Pod::Tree::Node $letter, $interior;
push @stack, $node;
$token =~ s/^\s*>{$width}//;
my @tokens = split //, $token;
unshift @$tokens, @tokens;
next;
};
my $node = text Pod::Tree::Node $token;
push @stack, $node;
}
if (@width) {
my @text = map { $_->get_deep_text } @stack;
Pod::Tree::Node->_warn("Missing '>' delimiter in\n@text");
}
return \@stack;
}
#Pod::Tree::Node::_pop_sequence()
sub _pop_sequence {
my($stack, $width) = @_;
my($node, @interior);
while (@$stack)
{
$node = pop @$stack;
is_letter $node and $node->{width} == $width and
return ($node, \@interior);
unshift @interior, $node;
}
my @text = map { $_->get_deep_text } @interior;
$node->_warn("Mismatched sequence delimiters around\n@text");
$node = letter Pod::Tree::Node ' ';
return $node, \@interior;
}
#Pod::Tree::Node::unescape()
sub unescape {
my $node = shift;
my $children = $node->{children};
for my $child (@$children) {
unescape($child);
}
is_sequence $node and _unescape_sequence($node);
}
## Pod::Tree::Node::_unescape_sequence()
sub _unescape_sequence {
my $node = shift;
for ($node->{'letter'}) {
/Z/ and $node->force_text(''), last;
/E/ and do {
my $child = $node->{children}[0];
$child or last;
my $text = _unescape_text($child);
$text and $node->force_text($text);
last;
};
}
}
my %EscapeMap = ('lt' => '<',
'gt' => '>',
sol => '/',
verbar => '|');
#Pod::Tree::Node::_unescape_text()
sub _unescape_text {
my $node = shift;
my $text = $node->{'text'};
my $escape = $EscapeMap{$text};
$escape and return $escape;
$text =~ /^\d+$/ and return chr($text);
return '';
}
#Pod::Tree::Node::dump()
sub DumpTree {
my $tree = shift;
$Indent = 0;
$String = '';
_dump($tree->{root}); # my _dump
return $String;
}
## using any of these would just complicate things without any reason
## (more logic than i need or care to reinvent/modify )
## all of the get_* do should be left alone
## same goes for force_*
## same goes for is_*
## same goes for /^[a-z]+/
#Pod::Tree::Node::_set_item_type(); # we let the original handle it
#Pod::Tree::Node::_set_list_type(); # we let the original handle it
#Pod::Tree::Node::clone(); # HEEEEL NO
#Pod::Tree::Node::code(); # HEEEEL NO
#Pod::Tree::Node::command(); # HEEEEL NO
#Pod::Tree::Node::consolidate();# HEEEEL NO
#Pod::Tree::Node::force_for();
#Pod::Tree::Node::force_text();
#Pod::Tree::Node::get_arg();
#Pod::Tree::Node::get_children();
#Pod::Tree::Node::get_command();
#Pod::Tree::Node::get_deep_text();
#Pod::Tree::Node::get_item_type();
#Pod::Tree::Node::get_letter();
#Pod::Tree::Node::get_list_type();
#Pod::Tree::Node::get_siblings();
#Pod::Tree::Node::get_target();
#Pod::Tree::Node::get_text();
#Pod::Tree::Node::get_type();
#Pod::Tree::Node::is_c_back();
#Pod::Tree::Node::is_c_begin();
#Pod::Tree::Node::is_c_end();
#Pod::Tree::Node::is_c_for();
#Pod::Tree::Node::is_c_item();
#Pod::Tree::Node::is_c_over();
#Pod::Tree::Node::is_code();
#Pod::Tree::Node::is_for();
#Pod::Tree::Node::is_letter();
#Pod::Tree::Node::is_link();
#Pod::Tree::Node::is_root();
#Pod::Tree::Node::is_sequence();
#Pod::Tree::Node::is_text();
#Pod::Tree::Node::is_verbatim();
#Pod::Tree::Node::letter();
#Pod::Tree::Node::make_sequences(); ######
#Pod::Tree::Node::ordinary();
#Pod::Tree::Node::parse_begin();
#Pod::Tree::Node::sequence();
#Pod::Tree::Node::target();
#Pod::Tree::Node::text();
#Pod::Tree::Node::verbatim();
#Pod::Tree::dump() # essentially $tree->{root}->dump
__DATA__
Not in pod.
=pod
In pod.
=cut
Not in pod.
=head1 POD
More in pod.
=pod
=head1 HEAD
=for html Line 1<br> <<em>Line 2</em>>
=for html <a href="http://world.std.com/~swmcd/steven/index.html">Stev
+en</a>
VERBATIM
VERBATIM
VERBATIM
Fee, Fie, Foe, Fum
Foo, Bar, Baz, Buz
=begin text
=head2 Not really a command
VERBATIM
VERBATIM
VERBATIM
Fee, Fie, Foe, Fum
Foo, Bar, Baz, Buz
=end text
=head2 Really a commmand.
=head1 NAME
Links
=head2 Original
A L<name> manual page.
An L<name/ident> item in manual page.
A L<name/"sec"> section in other manual page.
A L<"sec"> section in this manual page (the quotes are B<not> op
+tional).
A L< sec > section in this manual page
A L<sec tion > section in this manual page
A L<mod::ule.foo> link to a module POD
A L</"sec"> section in this manual page (the quotes are optional)
+.
=head2 Total Control
A L<text|name> manual page.
An L<text|name/ident> item in manual page.
A L<text|name/"sec"> section in other manual page.
A L<text|"sec"> section in this manual page (quotes are B<not> o
+ptional).
A L<text| sec > section in this manual page
A L<text|sec tion> section in this manual page
A L<text|bar-mod::ule> link to a module POD
A L<text|/"sec"> section in this manual page (quotes are optional
+).
=head2 Targets
X<target>
X<target with spaces>
X<target w/spaces>
X<I<italic> target>
=head2 Links
L</target>
L<"target with spaces">
L<" target w/spaces ">
L<"target with
line
breaks">
L</I<italic> B<target>>
L<I<page>/I<section>>
L<target|c|foo.html> This probably won't do what you want
L<fooE<sol>bar|blort>
L<fooE<verbar>bar|blort>
L<fooE<sol>barE<verbar>baz|blort>
=head1 NAME
Lists
=head2 Bullet
=over 4
=item *
foo
=item *
bar
=item *
baz
=back
=head2 Number
=over 4
=item 1
foo
=item 2
bar
=item 3
baz
=back
=head2 Text
=over 4
=item do
a deer, a female deer
=item ray
a drop of goden sun
=item me
me, a name, I call myself
=item fa
a long, long way to run
=back
=over 4
=item * do
a deer, a female deer
=item * ray
a drop of goden sun
=back
=over 4
=item 3 me
me, a name, I call myself
=item 4 fa
a long, long way to run
=back
=head2 Siblings
=over 4
=item *
Star 1 Para 1
Star 1 Para 2
Star 1 Para 3
=item *
Star 2
Star 2 Verbatim 1
Star 2 Verbatim 2
Star 2 Verbatim 3
=item *
Star 3
=back
=head2 Markups
=over 4
=item term 1
definition 1
=item I<term 2>
C<definition 2>
=item I<term B<3>>
S<definition 3>
=back
=head2 Nested
=over 4
=item *
Level 1, Star 1 of 2
=over 4
=item *
Level 2, Star 1 of 2
=item *
Level 2, Star 2 of 2
=back
=item *
=over 4
=item 1
Level 2, Number 1 of 2
=item 2
Level 2, Number 2 of 2
=back
=back
=over 4
=item Level 1, term 1 of 2
=over 4
=item *
Level 2, Star 1 of 3
=item *
Level 2, Star 2 of 3
=item *
Level 2, Star 3 of 3
=back
=item Level 1, term 2 of 2
=over 4
=item *
Level 2, Star 1 of 3
=over 4
=item 1
Level 3, Number 1 of 2
=item 2
Level 3, Number 2 of 2
=back
=item *
Level 2, Star 2 of 3
=item *
Level 2, Star 3 of 3
=back
=back
=head2 Pathological
=over 8
=item *
Over 8
=back
=over 4
=item *
Star 1
=item 2
Number 2
=item Term 3
Definition 3
=back
Empty
=over 4
=back
=over 4
No Items
=back
=over 4
=item *
Star 1
=item *
No =back
=head1 HEAD1
Head 1 text
=head2 HEADI<2>
Head2 B<text>
+------------------------------+
| This is a verbatim paragraph |
+------------------------------+
=head1 NAME
B<print> [-n] I<file>
=head1 DESCRIPTION
=Z<>head1 introduces a 1st level heading.
B<print> sends I<file> to a printer.
B<bold>, I<italic>, zero, B<bold, I<bold italic>, bold> normal.
S<Non-breaking space>, C<0>.
C<code>, B<bold C<code>>, F<file>, X<index>
<, >, /, |, A, E<Agrave>
B<<, E<gt>, /, |, A, E<Agrave>>
I<B<<, E<gt>, /, |, A, E<Agrave>>>
E<copy> E<deg> E<divide> E<frac12> E<micro> E<middot> E<not> E<reg> E<
+times>
C<$a <=E<gt> $b>
C<B<$foo-E<gt>bar>>,
I<C<B<$foo-E<gt>bar>>>,
An C<L<page/section>> markup.
C<$a << $b>,
B<C<$a E<gt>E<gt>$b>>;
|