#!/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<__DATA__>

=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 WS
    
    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


##</code><code>##


__DATA__

Not in pod.

=pod

In pod.

=cut

Not in pod.

=head1 POD

More in pod.

=pod

=head1 HEAD

=for html Line 1<br> &lt;<em>Line 2</em>&gt;

=for html <a href="http://world.std.com/~swmcd/steven/index.html">Steven</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> optional).

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> optional).

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>>;