libpod-tree-perl 1.17-1 / usr / share / perl5 / Pod / Tree.pm

# Copyright (c) 1999-2009 by Steven McDougall.  This module is free
# software; you can redistribute it and/or modify it under the same
# terms as Perl itself.


package Pod::Tree::Stream;

sub new
{
    my($package, $fh) = @_;

    my $stream = { fh   => $fh,
	           line => ''   };

    bless $stream, $package
}

sub get_paragraph
{
    my $stream = shift;
    my $fh     = $stream->{fh};
    my $line   = $stream->{line};

    defined $line or return undef;

    my(@lines) = ($line);
    while ($line = $fh->getline)
    {
	push @lines, $line;
	$line =~ /\S/ or last;
    }

    while ($line = $fh->getline)
    {
	$line =~ /\S/ and last;
	push @lines, $line;
    }

    $stream->{line} = $line;
    join '', @lines
}



package Pod::Tree;

require Exporter;

use strict;
use IO::File;
use Pod::Tree::Node;
use base qw(Exporter);

$Pod::Tree::VERSION = '1.17';


sub new
{
    my $class = shift;
    my $tree  = { loaded     => 0,
		  paragraphs => [] };
    bless $tree, $class
}


sub load_file
{
    my($tree, $file, %options) = @_;
    
    Pod::Tree::Node->set_filename($file);

    my $fh = new IO::File;
    $fh->open($file) or return '';
    $tree->load_fh($fh, %options);

    Pod::Tree::Node->set_filename("");
    1
}


sub load_fh
{
    my($tree, $fh, %options) = @_;

    $tree->{in_pod} = 0;
    $tree->_load_options(%options);
    my $limit = $tree->{limit};

    my $stream = new Pod::Tree::Stream $fh;
    my $paragraph;
    my @paragraphs;
    while ($paragraph = $stream->get_paragraph)
    {
	push @paragraphs, $paragraph;
	$limit and $limit==@paragraphs and last;
    }

    $tree->{paragraphs} = \@paragraphs;
    $tree->_parse;
}


sub load_string
{
    my($tree, $string, %options) = @_;

    my @chunks = split /( \n\s*\n | \r\s*\r | \r\n\s*\r\n )/x, $string;

    my(@paragraphs);
    while (@chunks)
    {
	push @paragraphs, join '', splice @chunks, 0, 2;
    }

    $tree->load_paragraphs(\@paragraphs, %options);
}


sub load_paragraphs
{
    my($tree, $paragraphs, %options) = @_; 

    $tree->{in_pod} = 1;
    $tree->_load_options(%options);

    my $limit      = $tree->{limit};
    my @paragraphs = @$paragraphs;
    $limit and splice @paragraphs, $limit;

    $tree->{paragraphs} = \@paragraphs;
    $tree->_parse;
}


sub loaded { shift->{'loaded'} }


sub _load_options
{
    my($tree, %options) = @_;

    my($key, $value);
    while (($key, $value) = each %options)
    {
	$tree->{$key} = $value;
    }
}


sub _parse
{
    my $tree = shift;

    $tree->_make_nodes;
    $tree->_make_for;
    $tree->_make_sequences;

    my $root = $tree->{root};

    $root->parse_links;
    $root->unescape;
    $root->consolidate;
    $root->make_lists;

    $tree->{'loaded'} = 1;
}


sub _add_paragraph
{
    my($tree, $paragraph) = @_;

    for ($paragraph)
    {
	/^=cut/         and do { $tree->{in_pod}=0;		
				 last };
	$tree->{in_pod} and do { push @{$tree->{paragraphs}}, $paragraph; 
				 last };
	/^=\w/          and do { $tree->{in_pod}=1;
				 push @{$tree->{paragraphs}}, $paragraph;  
				 last };
    }
}


my %Command = map { $_ => 1 } qw(=pod =cut
				 =head1 =head2 =head3 =head4
				 =over =item =back 
				 =for =begin =end);

sub _make_nodes
{
    my $tree       = shift;
    my $paragraphs = $tree->{paragraphs};
    my $in_pod     = $tree->{in_pod};
    my @children;

    for my $paragraph (@$paragraphs)
    {
	my($word) = split(/\s/, $paragraph);
	my $node;

	if ($in_pod)
	{
	    if ($paragraph =~ /^\s/)
	    {
		$node = verbatim Pod::Tree::Node $paragraph;
	    }
	    elsif ($Command{$word})
	    {
		$node = command  Pod::Tree::Node $paragraph;
		$in_pod = $word ne '=cut';
	    }
	    else
	    {
		$node = ordinary Pod::Tree::Node $paragraph;
	    }
	}
	else
	{
	    if ($Command{$word})
	    {
		$node = command  Pod::Tree::Node $paragraph;
		$in_pod = $word ne '=cut';
	    }
	    else
	    {
		$node = code     Pod::Tree::Node $paragraph;
	    }
	}

	push @children, $node;
    }

    $tree->{root} = root Pod::Tree::Node \@children;
}


sub _make_for
{
    my $tree = shift;
    my $root = $tree->{root};
    my $old  = $root->get_children;
    
    my @new;
    while (@$old)
    {
	my $node = shift @$old;
	is_c_for   $node and $node->force_for;
	is_c_begin $node and $node->parse_begin($old);
	push @new, $node;
    }

    $root->set_children(\@new);
}


sub _make_sequences
{
    my $tree  = shift;
    my $root  = $tree->{root};
    my $nodes = $root->get_children;

    for my $node (@$nodes)
    {
	is_code     $node and next;
	is_verbatim $node and next;
	is_for      $node and next;
	$node->make_sequences;
    }
}


sub dump
{
    my $tree = shift;
    $tree->{root}->dump
}


sub get_root { shift->{root} }

sub set_root
{
    my($tree, $root) = @_;
    $tree->{root} = $root;
}


sub push
{
    my($tree, @nodes) = @_;
    my $root     = $tree->{root};
    my $children = $root->get_children;
    push @$children, @nodes;
}
	

sub pop
{
    my $tree     = shift;
    my $root     = $tree->get_root;
    my $children = $root->get_children;
    pop @$children
}


sub walk
{
    my($tree, $sub) = @_;

    my $root = $tree->get_root;
    _walk($root, $sub);
}


sub _walk
{
    my $sub = $_[1];

    my $descend = &$sub($_[0]); # :TRICKY: sub can modify node
    $descend or return;

    my $node = $_[0];

    my $children = $node->get_children;
    for my $child (@$children)
    {
	_walk($child, $sub);
    }

    my $siblings = $node->get_siblings;
    for my $sibling (@$siblings)
    {
	_walk($sibling, $sub);
    }
}

sub has_pod
{
    my $tree     = shift;
    my $root     = $tree->get_root;
    my $children = $root->get_children;

    scalar grep { $_->get_type ne 'code' } @$children;
}


1

__END__

=head1 NAME

Pod::Tree - Create a static syntax tree for a POD


=head1 SYNOPSIS

  use Pod::Tree;
  
  $tree = new Pod::Tree;
  $tree->load_file      ( $file, %options)
  $tree->load_fh        ( $fh  , %options);
  $tree->load_string    ( $pod , %options);
  $tree->load_paragraphs(\@pod , %options);
  
  $loaded = $tree->loaded;  
  
  $node   = $tree->get_root;
            $tree->set_root  ($node);
  $node =   $tree->pop;
            $tree->push(@nodes);
  
            $tree->walk(\&sub);
            $tree->has_pod and ...
  print     $tree->dump;


=head1 REQUIRES

Pod::Escapes


=head1 EXPORTS

Nothing


=head1 DESCRIPTION

C<Pod::Tree> parses a POD into a static syntax tree.
Applications walk the tree to recover the structure and content of the POD.
See L<C<Pod::Tree::Node>> for a description of the tree.


=head1 METHODS

=over 4

=item I<$tree> = C<new> C<Pod::Tree>

Creates a new C<Pod::Tree> object.
The syntax tree is initially empty.


=item I<$ok> = I<$tree>->C<load_file>(I<$file>, I<%options>)

Parses a POD and creates a syntax tree for it.
I<$file> is the name of a file containing the POD.
Returns null iff it can't open I<$file>.

See L</OPTIONS> for a description of I<%options>


=item I<$tree>->C<load_fh>(I<$fh>, I<%options>)

Parses a POD and creates a syntax tree for it.
I<$fh> is an C<IO::File> object that is open on a file containing the POD.

See L</OPTIONS> for a description of I<%options>


=item I<$tree>->C<load_string>(I<$pod>, I<%options>)

Parses a POD and creates a syntax tree for it.
I<$pod> is a single string containing the POD.

See L</OPTIONS> for a description of I<%options>


=item I<$tree>->C<load_paragraphs>(\I<@pod>, I<%options>)

Parses a POD and creates a syntax tree for it.
I<\@pod> is a reference to an array of strings.
Each string is one paragraph of the POD.

See L</OPTIONS> for a description of I<%options>


=item I<$loaded> = I<$tree>->C<loaded>

Returns true iff one of the C<load_>* methods has been called on I<$tree>.


=item I<$node> = I<$tree>->C<get_root>

Returns the root node of the syntax tree.
See L<Pod::Tree::Node> for a description of the syntax tree.


=item I<$tree>->C<set_root>(I<$node>)

Sets the root of the syntax tree to I<$node>.


=item I<$tree>->C<push>(I<@nodes>)

Pushes I<@nodes> onto the end of the top-level list of nodes in I<$tree>.


=item I<$node> = I<$tree>->C<pop>

Pops I<$node> off of the end of the top-level list of nodes in I<$tree>.


=item I<$tree>->C<walk>(I<\&sub>)

Walks the syntax tree, depth first.
Calls I<sub> once for each node in the tree.
The current node is passed as the first argument to I<sub>.

C<walk> descends to the children and siblings of I<$node> iff
I<sub()> returns true.


=item I<$tree>->C<has_pod>

Returns true iff I<$tree> contains POD paragraphs.


=item I<$tree>->C<dump>

Pretty prints the syntax tree.
This will show you how C<Pod::Tree> interpreted your POD.

=back


=head1 OPTIONS

These options may be passed in the I<%options> hash to the C<load_>* methods.

=over 4

=item C<< in_pod => 0 >>

=item C<< in_pod => 1 >>

Sets the initial value of C<in_pod>.
When C<in_pod> is false,
the parser ignores all text until the next =command paragraph.

The initial value of C<in_pod> 
defaults to false for C<load_file()> and C<load_fh()> calls
and true for  C<load_string()> and C<load_paragraphs()> calls.
This is usually what you want, unless you want consistency.
If this isn't what you want,
pass different initial values in the I<%options> hash.


=item C<limit> => I<n>

Only parse the first I<n> paragraphs in the POD.

=back


=head1 DIAGNOSTICS

=over 4

=item C<load_file>(I<$file>)

Returns null iff it can't open I<$file>.

=back


=head1 NOTES

=head2 No round-tripping

Currently, C<Pod::Tree> does not provide a complete, exact 
representation of its input. For example, it doesn't distingish
between 

    C<$foo-E<gt>bar>

and 

   C<< $foo->bar >>

As a result, it is not guaranteed that a file can be
exactly reconstructed from its C<Pod::Tree> representation.


=head2 LZ<><> markups

In the documentation of the 

    L<"sec">	section in this manual page

markup, L<C<perlpod>> has always claimed

		(the quotes are optional)

However, there is no way to decide from the syntax alone whether

    L<foo>

is a link to the F<foo> man page or 
a link to the C<foo> section of this man page.

C<Pod::Tree> parses C<< LZ<><foo> >> as a link to a section if
C<foo> looks like a section name (e.g. contains whitespace), 
and as a link to a man page otherswise. 

In practice, this tends to break links to sections.
If you want your section links to work reliably, 
write them as C<< LZ<><"foo"> >> or C<< LZ<></foo> >>.


=head1 SEE ALSO

perl(1), L<C<Pod::Tree::Node>>, L<C<Pod::Tree::HTML>>


=head1 ACKNOWLEDGMENTS

=over 4

=item *

<crazyinsomniac@yahoo.com>

=item *

<joenio@cpan.org>

=item *

Paul Bettinger <paul@n8geil.de>

=item *

Sean M. Burke <sburke@spinn.net>

=item *

Brad Choate <brad@bradchoate.com>

=item *

Havard Eidnes <he@NetBSD.org>

=item *

Rudi Farkas <rudif@bluemail.ch>

=item *

Paul Gibeault <pagibeault@micron.com>

=item *

Jay Hannah <jhannah@omnihotels.com>

=item *

Paul Hawkins <phawkins@datajunction.com>

=item *

Jost Krieger <Jost.Krieger@ruhr-uni-bochum.de>

=item *

Marc A. Lehmann <pcg@goof.com> 

=item *

Jonas Liljegren <jonas@jonas.rit.se>

=item *

Thomas Linden <tom@co.daemon.de>

=item *

Johan Lindstrom <johanl@bahnhof.se>

=item *

Terry Luedtke <terry_luedtke@nlm.nih.gov>

=item *

Rob Napier <rnapier@employees.org>

=item *

Kate L Pugh <kake@earth.li>

=item *

Christopher Shalah <trance@drizzle.com>

=item *

Johan Vromans <JVromans@Squirrel.nl>

=back


=head1 AUTHOR

Steven McDougall <swmcd@world.std.com>


=head1 COPYRIGHT

Copyright (c) 1999-2009 by Steven McDougall. This module is free
software; you can redistribute it and/or modify it under the same
terms as Perl itself.