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