Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/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> &lt;<em>Line 2</em>&gt; =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>>;

In reply to Pod::Tree dump for the stealing by crazyinsomniac

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others browsing the Monastery: (9)
    As of 2014-07-25 07:12 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My favorite superfluous repetitious redundant duplicative phrase is:









      Results (169 votes), past polls