cpan/Pod-Simple/t/x_nixer.t Pod::Simple test file
cpan/Pod-Usage/lib/Pod/Usage.pm
cpan/Pod-Usage/scripts/pod2usage.PL
+cpan/Pod-Usage/t/inc/Pod/InputObjects.pm
+cpan/Pod-Usage/t/inc/Pod/Parser.pm
+cpan/Pod-Usage/t/inc/Pod/PlainText.pm
+cpan/Pod-Usage/t/inc/Pod/Select.pm
cpan/Pod-Usage/t/pod/headwithmarkup.pl
cpan/Pod-Usage/t/pod/headwithmarkup.t
cpan/Pod-Usage/t/pod/p2u_data.pl
},
'Pod::Usage' => {
- 'DISTRIBUTION' => 'MAREKR/Pod-Usage-1.68.tar.gz',
+ 'DISTRIBUTION' => 'MAREKR/Pod-Usage-1.69.tar.gz',
'FILES' => q[cpan/Pod-Usage],
},
use strict;
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = '1.68'; ## Current version of this package
+$VERSION = '1.69'; ## Current version of this package
require 5.006; ## requires this Perl version or later
#use diagnostics;
--- /dev/null
+#############################################################################\r
+# Pod/InputObjects.pm -- package which defines objects for input streams\r
+# and paragraphs and commands when parsing POD docs.\r
+#\r
+# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.\r
+# This file is part of "PodParser". PodParser is free software;\r
+# you can redistribute it and/or modify it under the same terms\r
+# as Perl itself.\r
+#############################################################################\r
+\r
+package Pod::InputObjects;\r
+use strict;\r
+\r
+use vars qw($VERSION);\r
+$VERSION = '1.60'; ## Current version of this package\r
+require 5.005; ## requires this Perl version or later\r
+\r
+#############################################################################\r
+\r
+=head1 NAME\r
+\r
+Pod::InputObjects - objects representing POD input paragraphs, commands, etc.\r
+\r
+=head1 SYNOPSIS\r
+\r
+ use Pod::InputObjects;\r
+\r
+=head1 REQUIRES\r
+\r
+perl5.004, Carp\r
+\r
+=head1 EXPORTS\r
+\r
+Nothing.\r
+\r
+=head1 DESCRIPTION\r
+\r
+This module defines some basic input objects used by B<Pod::Parser> when\r
+reading and parsing POD text from an input source. The following objects\r
+are defined:\r
+\r
+=begin __PRIVATE__\r
+\r
+=over 4\r
+\r
+=item package B<Pod::InputSource>\r
+\r
+An object corresponding to a source of POD input text. It is mostly a\r
+wrapper around a filehandle or C<IO::Handle>-type object (or anything\r
+that implements the C<getline()> method) which keeps track of some\r
+additional information relevant to the parsing of PODs.\r
+\r
+=back\r
+\r
+=end __PRIVATE__\r
+\r
+=over 4\r
+\r
+=item package B<Pod::Paragraph>\r
+\r
+An object corresponding to a paragraph of POD input text. It may be a\r
+plain paragraph, a verbatim paragraph, or a command paragraph (see\r
+L<perlpod>).\r
+\r
+=item package B<Pod::InteriorSequence>\r
+\r
+An object corresponding to an interior sequence command from the POD\r
+input text (see L<perlpod>).\r
+\r
+=item package B<Pod::ParseTree>\r
+\r
+An object corresponding to a tree of parsed POD text. Each "node" in\r
+a parse-tree (or I<ptree>) is either a text-string or a reference to\r
+a B<Pod::InteriorSequence> object. The nodes appear in the parse-tree\r
+in the order in which they were parsed from left-to-right.\r
+\r
+=back\r
+\r
+Each of these input objects are described in further detail in the\r
+sections which follow.\r
+\r
+=cut\r
+\r
+#############################################################################\r
+\r
+package Pod::InputSource;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin __PRIVATE__\r
+\r
+=head1 B<Pod::InputSource>\r
+\r
+This object corresponds to an input source or stream of POD\r
+documentation. When parsing PODs, it is necessary to associate and store\r
+certain context information with each input source. All of this\r
+information is kept together with the stream itself in one of these\r
+C<Pod::InputSource> objects. Each such object is merely a wrapper around\r
+an C<IO::Handle> object of some kind (or at least something that\r
+implements the C<getline()> method). They have the following\r
+methods/attributes:\r
+\r
+=end __PRIVATE__\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin __PRIVATE__\r
+\r
+=head2 B<new()>\r
+\r
+ my $pod_input1 = Pod::InputSource->new(-handle => $filehandle);\r
+ my $pod_input2 = new Pod::InputSource(-handle => $filehandle,\r
+ -name => $name);\r
+ my $pod_input3 = new Pod::InputSource(-handle => \*STDIN);\r
+ my $pod_input4 = Pod::InputSource->new(-handle => \*STDIN,\r
+ -name => "(STDIN)");\r
+\r
+This is a class method that constructs a C<Pod::InputSource> object and\r
+returns a reference to the new input source object. It takes one or more\r
+keyword arguments in the form of a hash. The keyword C<-handle> is\r
+required and designates the corresponding input handle. The keyword\r
+C<-name> is optional and specifies the name associated with the input\r
+handle (typically a file name).\r
+\r
+=end __PRIVATE__\r
+\r
+=cut\r
+\r
+sub new {\r
+ ## Determine if we were called via an object-ref or a classname\r
+ my $this = shift;\r
+ my $class = ref($this) || $this;\r
+\r
+ ## Any remaining arguments are treated as initial values for the\r
+ ## hash that is used to represent this object. Note that we default\r
+ ## certain values by specifying them *before* the arguments passed.\r
+ ## If they are in the argument list, they will override the defaults.\r
+ my $self = { -name => '(unknown)',\r
+ -handle => undef,\r
+ -was_cutting => 0,\r
+ @_ };\r
+\r
+ ## Bless ourselves into the desired class and perform any initialization\r
+ bless $self, $class;\r
+ return $self;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin __PRIVATE__\r
+\r
+=head2 B<name()>\r
+\r
+ my $filename = $pod_input->name();\r
+ $pod_input->name($new_filename_to_use);\r
+\r
+This method gets/sets the name of the input source (usually a filename).\r
+If no argument is given, it returns a string containing the name of\r
+the input source; otherwise it sets the name of the input source to the\r
+contents of the given argument.\r
+\r
+=end __PRIVATE__\r
+\r
+=cut\r
+\r
+sub name {\r
+ (@_ > 1) and $_[0]->{'-name'} = $_[1];\r
+ return $_[0]->{'-name'};\r
+}\r
+\r
+## allow 'filename' as an alias for 'name'\r
+*filename = \&name;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin __PRIVATE__\r
+\r
+=head2 B<handle()>\r
+\r
+ my $handle = $pod_input->handle();\r
+\r
+Returns a reference to the handle object from which input is read (the\r
+one used to contructed this input source object).\r
+\r
+=end __PRIVATE__\r
+\r
+=cut\r
+\r
+sub handle {\r
+ return $_[0]->{'-handle'};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin __PRIVATE__\r
+\r
+=head2 B<was_cutting()>\r
+\r
+ print "Yes.\n" if ($pod_input->was_cutting());\r
+\r
+The value of the C<cutting> state (that the B<cutting()> method would\r
+have returned) immediately before any input was read from this input\r
+stream. After all input from this stream has been read, the C<cutting>\r
+state is restored to this value.\r
+\r
+=end __PRIVATE__\r
+\r
+=cut\r
+\r
+sub was_cutting {\r
+ (@_ > 1) and $_[0]->{-was_cutting} = $_[1];\r
+ return $_[0]->{-was_cutting};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+#############################################################################\r
+\r
+package Pod::Paragraph;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<Pod::Paragraph>\r
+\r
+An object representing a paragraph of POD input text.\r
+It has the following methods/attributes:\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 Pod::Paragraph-E<gt>B<new()>\r
+\r
+ my $pod_para1 = Pod::Paragraph->new(-text => $text);\r
+ my $pod_para2 = Pod::Paragraph->new(-name => $cmd,\r
+ -text => $text);\r
+ my $pod_para3 = new Pod::Paragraph(-text => $text);\r
+ my $pod_para4 = new Pod::Paragraph(-name => $cmd,\r
+ -text => $text);\r
+ my $pod_para5 = Pod::Paragraph->new(-name => $cmd,\r
+ -text => $text,\r
+ -file => $filename,\r
+ -line => $line_number);\r
+\r
+This is a class method that constructs a C<Pod::Paragraph> object and\r
+returns a reference to the new paragraph object. It may be given one or\r
+two keyword arguments. The C<-text> keyword indicates the corresponding\r
+text of the POD paragraph. The C<-name> keyword indicates the name of\r
+the corresponding POD command, such as C<head1> or C<item> (it should\r
+I<not> contain the C<=> prefix); this is needed only if the POD\r
+paragraph corresponds to a command paragraph. The C<-file> and C<-line>\r
+keywords indicate the filename and line number corresponding to the\r
+beginning of the paragraph \r
+\r
+=cut\r
+\r
+sub new {\r
+ ## Determine if we were called via an object-ref or a classname\r
+ my $this = shift;\r
+ my $class = ref($this) || $this;\r
+\r
+ ## Any remaining arguments are treated as initial values for the\r
+ ## hash that is used to represent this object. Note that we default\r
+ ## certain values by specifying them *before* the arguments passed.\r
+ ## If they are in the argument list, they will override the defaults.\r
+ my $self = {\r
+ -name => undef,\r
+ -text => (@_ == 1) ? shift : undef,\r
+ -file => '<unknown-file>',\r
+ -line => 0,\r
+ -prefix => '=',\r
+ -separator => ' ',\r
+ -ptree => [],\r
+ @_\r
+ };\r
+\r
+ ## Bless ourselves into the desired class and perform any initialization\r
+ bless $self, $class;\r
+ return $self;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_para-E<gt>B<cmd_name()>\r
+\r
+ my $para_cmd = $pod_para->cmd_name();\r
+\r
+If this paragraph is a command paragraph, then this method will return \r
+the name of the command (I<without> any leading C<=> prefix).\r
+\r
+=cut\r
+\r
+sub cmd_name {\r
+ (@_ > 1) and $_[0]->{'-name'} = $_[1];\r
+ return $_[0]->{'-name'};\r
+}\r
+\r
+## let name() be an alias for cmd_name()\r
+*name = \&cmd_name;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_para-E<gt>B<text()>\r
+\r
+ my $para_text = $pod_para->text();\r
+\r
+This method will return the corresponding text of the paragraph.\r
+\r
+=cut\r
+\r
+sub text {\r
+ (@_ > 1) and $_[0]->{'-text'} = $_[1];\r
+ return $_[0]->{'-text'};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_para-E<gt>B<raw_text()>\r
+\r
+ my $raw_pod_para = $pod_para->raw_text();\r
+\r
+This method will return the I<raw> text of the POD paragraph, exactly\r
+as it appeared in the input.\r
+\r
+=cut\r
+\r
+sub raw_text {\r
+ return $_[0]->{'-text'} unless (defined $_[0]->{'-name'});\r
+ return $_[0]->{'-prefix'} . $_[0]->{'-name'} .\r
+ $_[0]->{'-separator'} . $_[0]->{'-text'};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_para-E<gt>B<cmd_prefix()>\r
+\r
+ my $prefix = $pod_para->cmd_prefix();\r
+\r
+If this paragraph is a command paragraph, then this method will return \r
+the prefix used to denote the command (which should be the string "="\r
+or "==").\r
+\r
+=cut\r
+\r
+sub cmd_prefix {\r
+ return $_[0]->{'-prefix'};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_para-E<gt>B<cmd_separator()>\r
+\r
+ my $separator = $pod_para->cmd_separator();\r
+\r
+If this paragraph is a command paragraph, then this method will return\r
+the text used to separate the command name from the rest of the\r
+paragraph (if any).\r
+\r
+=cut\r
+\r
+sub cmd_separator {\r
+ return $_[0]->{'-separator'};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_para-E<gt>B<parse_tree()>\r
+\r
+ my $ptree = $pod_parser->parse_text( $pod_para->text() );\r
+ $pod_para->parse_tree( $ptree );\r
+ $ptree = $pod_para->parse_tree();\r
+\r
+This method will get/set the corresponding parse-tree of the paragraph's text.\r
+\r
+=cut\r
+\r
+sub parse_tree {\r
+ (@_ > 1) and $_[0]->{'-ptree'} = $_[1];\r
+ return $_[0]->{'-ptree'};\r
+}\r
+\r
+## let ptree() be an alias for parse_tree()\r
+*ptree = \&parse_tree;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_para-E<gt>B<file_line()>\r
+\r
+ my ($filename, $line_number) = $pod_para->file_line();\r
+ my $position = $pod_para->file_line();\r
+\r
+Returns the current filename and line number for the paragraph\r
+object. If called in a list context, it returns a list of two\r
+elements: first the filename, then the line number. If called in\r
+a scalar context, it returns a string containing the filename, followed\r
+by a colon (':'), followed by the line number.\r
+\r
+=cut\r
+\r
+sub file_line {\r
+ my @loc = ($_[0]->{'-file'} || '<unknown-file>',\r
+ $_[0]->{'-line'} || 0);\r
+ return (wantarray) ? @loc : join(':', @loc);\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+#############################################################################\r
+\r
+package Pod::InteriorSequence;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<Pod::InteriorSequence>\r
+\r
+An object representing a POD interior sequence command.\r
+It has the following methods/attributes:\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 Pod::InteriorSequence-E<gt>B<new()>\r
+\r
+ my $pod_seq1 = Pod::InteriorSequence->new(-name => $cmd\r
+ -ldelim => $delimiter);\r
+ my $pod_seq2 = new Pod::InteriorSequence(-name => $cmd,\r
+ -ldelim => $delimiter);\r
+ my $pod_seq3 = new Pod::InteriorSequence(-name => $cmd,\r
+ -ldelim => $delimiter,\r
+ -file => $filename,\r
+ -line => $line_number);\r
+\r
+ my $pod_seq4 = new Pod::InteriorSequence(-name => $cmd, $ptree);\r
+ my $pod_seq5 = new Pod::InteriorSequence($cmd, $ptree);\r
+\r
+This is a class method that constructs a C<Pod::InteriorSequence> object\r
+and returns a reference to the new interior sequence object. It should\r
+be given two keyword arguments. The C<-ldelim> keyword indicates the\r
+corresponding left-delimiter of the interior sequence (e.g. 'E<lt>').\r
+The C<-name> keyword indicates the name of the corresponding interior\r
+sequence command, such as C<I> or C<B> or C<C>. The C<-file> and\r
+C<-line> keywords indicate the filename and line number corresponding\r
+to the beginning of the interior sequence. If the C<$ptree> argument is\r
+given, it must be the last argument, and it must be either string, or\r
+else an array-ref suitable for passing to B<Pod::ParseTree::new> (or\r
+it may be a reference to a Pod::ParseTree object).\r
+\r
+=cut\r
+\r
+sub new {\r
+ ## Determine if we were called via an object-ref or a classname\r
+ my $this = shift;\r
+ my $class = ref($this) || $this;\r
+\r
+ ## See if first argument has no keyword\r
+ if (((@_ <= 2) or (@_ % 2)) and $_[0] !~ /^-\w/) {\r
+ ## Yup - need an implicit '-name' before first parameter\r
+ unshift @_, '-name';\r
+ }\r
+\r
+ ## See if odd number of args\r
+ if ((@_ % 2) != 0) {\r
+ ## Yup - need an implicit '-ptree' before the last parameter\r
+ splice @_, $#_, 0, '-ptree';\r
+ }\r
+\r
+ ## Any remaining arguments are treated as initial values for the\r
+ ## hash that is used to represent this object. Note that we default\r
+ ## certain values by specifying them *before* the arguments passed.\r
+ ## If they are in the argument list, they will override the defaults.\r
+ my $self = {\r
+ -name => (@_ == 1) ? $_[0] : undef,\r
+ -file => '<unknown-file>',\r
+ -line => 0,\r
+ -ldelim => '<',\r
+ -rdelim => '>',\r
+ @_\r
+ };\r
+\r
+ ## Initialize contents if they havent been already\r
+ my $ptree = $self->{'-ptree'} || new Pod::ParseTree();\r
+ if ( ref $ptree =~ /^(ARRAY)?$/ ) {\r
+ ## We have an array-ref, or a normal scalar. Pass it as an\r
+ ## an argument to the ptree-constructor\r
+ $ptree = new Pod::ParseTree($1 ? [$ptree] : $ptree);\r
+ }\r
+ $self->{'-ptree'} = $ptree;\r
+\r
+ ## Bless ourselves into the desired class and perform any initialization\r
+ bless $self, $class;\r
+ return $self;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<cmd_name()>\r
+\r
+ my $seq_cmd = $pod_seq->cmd_name();\r
+\r
+The name of the interior sequence command.\r
+\r
+=cut\r
+\r
+sub cmd_name {\r
+ (@_ > 1) and $_[0]->{'-name'} = $_[1];\r
+ return $_[0]->{'-name'};\r
+}\r
+\r
+## let name() be an alias for cmd_name()\r
+*name = \&cmd_name;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+## Private subroutine to set the parent pointer of all the given\r
+## children that are interior-sequences to be $self\r
+\r
+sub _set_child2parent_links {\r
+ my ($self, @children) = @_;\r
+ ## Make sure any sequences know who their parent is\r
+ for (@children) {\r
+ next unless (length and ref and ref ne 'SCALAR');\r
+ if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or\r
+ UNIVERSAL::can($_, 'nested'))\r
+ {\r
+ $_->nested($self);\r
+ }\r
+ }\r
+}\r
+\r
+## Private subroutine to unset child->parent links\r
+\r
+sub _unset_child2parent_links {\r
+ my $self = shift;\r
+ $self->{'-parent_sequence'} = undef;\r
+ my $ptree = $self->{'-ptree'};\r
+ for (@$ptree) {\r
+ next unless (length and ref and ref ne 'SCALAR');\r
+ $_->_unset_child2parent_links()\r
+ if UNIVERSAL::isa($_, 'Pod::InteriorSequence');\r
+ }\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<prepend()>\r
+\r
+ $pod_seq->prepend($text);\r
+ $pod_seq1->prepend($pod_seq2);\r
+\r
+Prepends the given string or parse-tree or sequence object to the parse-tree\r
+of this interior sequence.\r
+\r
+=cut\r
+\r
+sub prepend {\r
+ my $self = shift;\r
+ $self->{'-ptree'}->prepend(@_);\r
+ _set_child2parent_links($self, @_);\r
+ return $self;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<append()>\r
+\r
+ $pod_seq->append($text);\r
+ $pod_seq1->append($pod_seq2);\r
+\r
+Appends the given string or parse-tree or sequence object to the parse-tree\r
+of this interior sequence.\r
+\r
+=cut\r
+\r
+sub append {\r
+ my $self = shift;\r
+ $self->{'-ptree'}->append(@_);\r
+ _set_child2parent_links($self, @_);\r
+ return $self;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<nested()>\r
+\r
+ $outer_seq = $pod_seq->nested || print "not nested";\r
+\r
+If this interior sequence is nested inside of another interior\r
+sequence, then the outer/parent sequence that contains it is\r
+returned. Otherwise C<undef> is returned.\r
+\r
+=cut\r
+\r
+sub nested {\r
+ my $self = shift;\r
+ (@_ == 1) and $self->{'-parent_sequence'} = shift;\r
+ return $self->{'-parent_sequence'} || undef;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<raw_text()>\r
+\r
+ my $seq_raw_text = $pod_seq->raw_text();\r
+\r
+This method will return the I<raw> text of the POD interior sequence,\r
+exactly as it appeared in the input.\r
+\r
+=cut\r
+\r
+sub raw_text {\r
+ my $self = shift;\r
+ my $text = $self->{'-name'} . $self->{'-ldelim'};\r
+ for ( $self->{'-ptree'}->children ) {\r
+ $text .= (ref $_) ? $_->raw_text : $_;\r
+ }\r
+ $text .= $self->{'-rdelim'};\r
+ return $text;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<left_delimiter()>\r
+\r
+ my $ldelim = $pod_seq->left_delimiter();\r
+\r
+The leftmost delimiter beginning the argument text to the interior\r
+sequence (should be "<").\r
+\r
+=cut\r
+\r
+sub left_delimiter {\r
+ (@_ > 1) and $_[0]->{'-ldelim'} = $_[1];\r
+ return $_[0]->{'-ldelim'};\r
+}\r
+\r
+## let ldelim() be an alias for left_delimiter()\r
+*ldelim = \&left_delimiter;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<right_delimiter()>\r
+\r
+The rightmost delimiter beginning the argument text to the interior\r
+sequence (should be ">").\r
+\r
+=cut\r
+\r
+sub right_delimiter {\r
+ (@_ > 1) and $_[0]->{'-rdelim'} = $_[1];\r
+ return $_[0]->{'-rdelim'};\r
+}\r
+\r
+## let rdelim() be an alias for right_delimiter()\r
+*rdelim = \&right_delimiter;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<parse_tree()>\r
+\r
+ my $ptree = $pod_parser->parse_text($paragraph_text);\r
+ $pod_seq->parse_tree( $ptree );\r
+ $ptree = $pod_seq->parse_tree();\r
+\r
+This method will get/set the corresponding parse-tree of the interior\r
+sequence's text.\r
+\r
+=cut\r
+\r
+sub parse_tree {\r
+ (@_ > 1) and $_[0]->{'-ptree'} = $_[1];\r
+ return $_[0]->{'-ptree'};\r
+}\r
+\r
+## let ptree() be an alias for parse_tree()\r
+*ptree = \&parse_tree;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<file_line()>\r
+\r
+ my ($filename, $line_number) = $pod_seq->file_line();\r
+ my $position = $pod_seq->file_line();\r
+\r
+Returns the current filename and line number for the interior sequence\r
+object. If called in a list context, it returns a list of two\r
+elements: first the filename, then the line number. If called in\r
+a scalar context, it returns a string containing the filename, followed\r
+by a colon (':'), followed by the line number.\r
+\r
+=cut\r
+\r
+sub file_line {\r
+ my @loc = ($_[0]->{'-file'} || '<unknown-file>',\r
+ $_[0]->{'-line'} || 0);\r
+ return (wantarray) ? @loc : join(':', @loc);\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 Pod::InteriorSequence::B<DESTROY()>\r
+\r
+This method performs any necessary cleanup for the interior-sequence.\r
+If you override this method then it is B<imperative> that you invoke\r
+the parent method from within your own method, otherwise\r
+I<interior-sequence storage will not be reclaimed upon destruction!>\r
+\r
+=cut\r
+\r
+sub DESTROY {\r
+ ## We need to get rid of all child->parent pointers throughout the\r
+ ## tree so their reference counts will go to zero and they can be\r
+ ## garbage-collected\r
+ _unset_child2parent_links(@_);\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+#############################################################################\r
+\r
+package Pod::ParseTree;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<Pod::ParseTree>\r
+\r
+This object corresponds to a tree of parsed POD text. As POD text is\r
+scanned from left to right, it is parsed into an ordered list of\r
+text-strings and B<Pod::InteriorSequence> objects (in order of\r
+appearance). A B<Pod::ParseTree> object corresponds to this list of\r
+strings and sequences. Each interior sequence in the parse-tree may\r
+itself contain a parse-tree (since interior sequences may be nested).\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 Pod::ParseTree-E<gt>B<new()>\r
+\r
+ my $ptree1 = Pod::ParseTree->new;\r
+ my $ptree2 = new Pod::ParseTree;\r
+ my $ptree4 = Pod::ParseTree->new($array_ref);\r
+ my $ptree3 = new Pod::ParseTree($array_ref);\r
+\r
+This is a class method that constructs a C<Pod::Parse_tree> object and\r
+returns a reference to the new parse-tree. If a single-argument is given,\r
+it must be a reference to an array, and is used to initialize the root\r
+(top) of the parse tree.\r
+\r
+=cut\r
+\r
+sub new {\r
+ ## Determine if we were called via an object-ref or a classname\r
+ my $this = shift;\r
+ my $class = ref($this) || $this;\r
+\r
+ my $self = (@_ == 1 and ref $_[0]) ? $_[0] : [];\r
+\r
+ ## Bless ourselves into the desired class and perform any initialization\r
+ bless $self, $class;\r
+ return $self;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $ptree-E<gt>B<top()>\r
+\r
+ my $top_node = $ptree->top();\r
+ $ptree->top( $top_node );\r
+ $ptree->top( @children );\r
+\r
+This method gets/sets the top node of the parse-tree. If no arguments are\r
+given, it returns the topmost node in the tree (the root), which is also\r
+a B<Pod::ParseTree>. If it is given a single argument that is a reference,\r
+then the reference is assumed to a parse-tree and becomes the new top node.\r
+Otherwise, if arguments are given, they are treated as the new list of\r
+children for the top node.\r
+\r
+=cut\r
+\r
+sub top {\r
+ my $self = shift;\r
+ if (@_ > 0) {\r
+ @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_;\r
+ }\r
+ return $self;\r
+}\r
+\r
+## let parse_tree() & ptree() be aliases for the 'top' method\r
+*parse_tree = *ptree = \⊤\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $ptree-E<gt>B<children()>\r
+\r
+This method gets/sets the children of the top node in the parse-tree.\r
+If no arguments are given, it returns the list (array) of children\r
+(each of which should be either a string or a B<Pod::InteriorSequence>.\r
+Otherwise, if arguments are given, they are treated as the new list of\r
+children for the top node.\r
+\r
+=cut\r
+\r
+sub children {\r
+ my $self = shift;\r
+ if (@_ > 0) {\r
+ @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_;\r
+ }\r
+ return @{ $self };\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $ptree-E<gt>B<prepend()>\r
+\r
+This method prepends the given text or parse-tree to the current parse-tree.\r
+If the first item on the parse-tree is text and the argument is also text,\r
+then the text is prepended to the first item (not added as a separate string).\r
+Otherwise the argument is added as a new string or parse-tree I<before>\r
+the current one.\r
+\r
+=cut\r
+\r
+use vars qw(@ptree); ## an alias used for performance reasons\r
+\r
+sub prepend {\r
+ my $self = shift;\r
+ local *ptree = $self;\r
+ for (@_) {\r
+ next unless length;\r
+ if (@ptree && !(ref $ptree[0]) && !(ref $_)) {\r
+ $ptree[0] = $_ . $ptree[0];\r
+ }\r
+ else {\r
+ unshift @ptree, $_;\r
+ }\r
+ }\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $ptree-E<gt>B<append()>\r
+\r
+This method appends the given text or parse-tree to the current parse-tree.\r
+If the last item on the parse-tree is text and the argument is also text,\r
+then the text is appended to the last item (not added as a separate string).\r
+Otherwise the argument is added as a new string or parse-tree I<after>\r
+the current one.\r
+\r
+=cut\r
+\r
+sub append {\r
+ my $self = shift;\r
+ local *ptree = $self;\r
+ my $can_append = @ptree && !(ref $ptree[-1]);\r
+ for (@_) {\r
+ if (ref) {\r
+ push @ptree, $_;\r
+ }\r
+ elsif(!length) {\r
+ next;\r
+ }\r
+ elsif ($can_append) {\r
+ $ptree[-1] .= $_;\r
+ }\r
+ else {\r
+ push @ptree, $_;\r
+ }\r
+ }\r
+}\r
+\r
+=head2 $ptree-E<gt>B<raw_text()>\r
+\r
+ my $ptree_raw_text = $ptree->raw_text();\r
+\r
+This method will return the I<raw> text of the POD parse-tree\r
+exactly as it appeared in the input.\r
+\r
+=cut\r
+\r
+sub raw_text {\r
+ my $self = shift;\r
+ my $text = '';\r
+ for ( @$self ) {\r
+ $text .= (ref $_) ? $_->raw_text : $_;\r
+ }\r
+ return $text;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+## Private routines to set/unset child->parent links\r
+\r
+sub _unset_child2parent_links {\r
+ my $self = shift;\r
+ local *ptree = $self;\r
+ for (@ptree) {\r
+ next unless (defined and length and ref and ref ne 'SCALAR');\r
+ $_->_unset_child2parent_links()\r
+ if UNIVERSAL::isa($_, 'Pod::InteriorSequence');\r
+ }\r
+}\r
+\r
+sub _set_child2parent_links {\r
+ ## nothing to do, Pod::ParseTrees cant have parent pointers\r
+}\r
+\r
+=head2 Pod::ParseTree::B<DESTROY()>\r
+\r
+This method performs any necessary cleanup for the parse-tree.\r
+If you override this method then it is B<imperative>\r
+that you invoke the parent method from within your own method,\r
+otherwise I<parse-tree storage will not be reclaimed upon destruction!>\r
+\r
+=cut\r
+\r
+sub DESTROY {\r
+ ## We need to get rid of all child->parent pointers throughout the\r
+ ## tree so their reference counts will go to zero and they can be\r
+ ## garbage-collected\r
+ _unset_child2parent_links(@_);\r
+}\r
+\r
+#############################################################################\r
+\r
+=head1 SEE ALSO\r
+\r
+B<Pod::InputObjects> is part of the L<Pod::Parser> distribution.\r
+\r
+See L<Pod::Parser>, L<Pod::Select>\r
+\r
+=head1 AUTHOR\r
+\r
+Please report bugs using L<http://rt.cpan.org>.\r
+\r
+Brad Appleton E<lt>bradapp@enteract.comE<gt>\r
+\r
+=cut\r
+\r
+1;\r
--- /dev/null
+#############################################################################\r
+# Pod/Parser.pm -- package which defines a base class for parsing POD docs.\r
+#\r
+# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.\r
+# This file is part of "PodParser". PodParser is free software;\r
+# you can redistribute it and/or modify it under the same terms\r
+# as Perl itself.\r
+#############################################################################\r
+\r
+package Pod::Parser;\r
+use strict;\r
+\r
+## These "variables" are used as local "glob aliases" for performance\r
+use vars qw($VERSION @ISA %myData %myOpts @input_stack);\r
+$VERSION = '1.60'; ## Current version of this package\r
+require 5.005; ## requires this Perl version or later\r
+\r
+#############################################################################\r
+\r
+=head1 NAME\r
+\r
+Pod::Parser - base class for creating POD filters and translators\r
+\r
+=head1 SYNOPSIS\r
+\r
+ use Pod::Parser;\r
+\r
+ package MyParser;\r
+ @ISA = qw(Pod::Parser);\r
+\r
+ sub command { \r
+ my ($parser, $command, $paragraph, $line_num) = @_;\r
+ ## Interpret the command and its text; sample actions might be:\r
+ if ($command eq 'head1') { ... }\r
+ elsif ($command eq 'head2') { ... }\r
+ ## ... other commands and their actions\r
+ my $out_fh = $parser->output_handle();\r
+ my $expansion = $parser->interpolate($paragraph, $line_num);\r
+ print $out_fh $expansion;\r
+ }\r
+\r
+ sub verbatim { \r
+ my ($parser, $paragraph, $line_num) = @_;\r
+ ## Format verbatim paragraph; sample actions might be:\r
+ my $out_fh = $parser->output_handle();\r
+ print $out_fh $paragraph;\r
+ }\r
+\r
+ sub textblock { \r
+ my ($parser, $paragraph, $line_num) = @_;\r
+ ## Translate/Format this block of text; sample actions might be:\r
+ my $out_fh = $parser->output_handle();\r
+ my $expansion = $parser->interpolate($paragraph, $line_num);\r
+ print $out_fh $expansion;\r
+ }\r
+\r
+ sub interior_sequence { \r
+ my ($parser, $seq_command, $seq_argument) = @_;\r
+ ## Expand an interior sequence; sample actions might be:\r
+ return "*$seq_argument*" if ($seq_command eq 'B');\r
+ return "`$seq_argument'" if ($seq_command eq 'C');\r
+ return "_${seq_argument}_'" if ($seq_command eq 'I');\r
+ ## ... other sequence commands and their resulting text\r
+ }\r
+\r
+ package main;\r
+\r
+ ## Create a parser object and have it parse file whose name was\r
+ ## given on the command-line (use STDIN if no files were given).\r
+ $parser = new MyParser();\r
+ $parser->parse_from_filehandle(\*STDIN) if (@ARGV == 0);\r
+ for (@ARGV) { $parser->parse_from_file($_); }\r
+\r
+=head1 REQUIRES\r
+\r
+perl5.005, Pod::InputObjects, Exporter, Symbol, Carp\r
+\r
+=head1 EXPORTS\r
+\r
+Nothing.\r
+\r
+=head1 DESCRIPTION\r
+\r
+B<Pod::Parser> is a base class for creating POD filters and translators.\r
+It handles most of the effort involved with parsing the POD sections\r
+from an input stream, leaving subclasses free to be concerned only with\r
+performing the actual translation of text.\r
+\r
+B<Pod::Parser> parses PODs, and makes method calls to handle the various\r
+components of the POD. Subclasses of B<Pod::Parser> override these methods\r
+to translate the POD into whatever output format they desire.\r
+\r
+Note: This module is considered as legacy; modern Perl releases (5.18 and\r
+higher) are going to remove Pod::Parser from core and use L<Pod::Simple>\r
+for all things POD.\r
+\r
+=head1 QUICK OVERVIEW\r
+\r
+To create a POD filter for translating POD documentation into some other\r
+format, you create a subclass of B<Pod::Parser> which typically overrides\r
+just the base class implementation for the following methods:\r
+\r
+=over 2\r
+\r
+=item *\r
+\r
+B<command()>\r
+\r
+=item *\r
+\r
+B<verbatim()>\r
+\r
+=item *\r
+\r
+B<textblock()>\r
+\r
+=item *\r
+\r
+B<interior_sequence()>\r
+\r
+=back\r
+\r
+You may also want to override the B<begin_input()> and B<end_input()>\r
+methods for your subclass (to perform any needed per-file and/or\r
+per-document initialization or cleanup).\r
+\r
+If you need to perform any preprocessing of input before it is parsed\r
+you may want to override one or more of B<preprocess_line()> and/or\r
+B<preprocess_paragraph()>.\r
+\r
+Sometimes it may be necessary to make more than one pass over the input\r
+files. If this is the case you have several options. You can make the\r
+first pass using B<Pod::Parser> and override your methods to store the\r
+intermediate results in memory somewhere for the B<end_pod()> method to\r
+process. You could use B<Pod::Parser> for several passes with an\r
+appropriate state variable to control the operation for each pass. If\r
+your input source can't be reset to start at the beginning, you can\r
+store it in some other structure as a string or an array and have that\r
+structure implement a B<getline()> method (which is all that\r
+B<parse_from_filehandle()> uses to read input).\r
+\r
+Feel free to add any member data fields you need to keep track of things\r
+like current font, indentation, horizontal or vertical position, or\r
+whatever else you like. Be sure to read L<"PRIVATE METHODS AND DATA">\r
+to avoid name collisions.\r
+\r
+For the most part, the B<Pod::Parser> base class should be able to\r
+do most of the input parsing for you and leave you free to worry about\r
+how to interpret the commands and translate the result.\r
+\r
+Note that all we have described here in this quick overview is the\r
+simplest most straightforward use of B<Pod::Parser> to do stream-based\r
+parsing. It is also possible to use the B<Pod::Parser::parse_text> function\r
+to do more sophisticated tree-based parsing. See L<"TREE-BASED PARSING">.\r
+\r
+=head1 PARSING OPTIONS\r
+\r
+A I<parse-option> is simply a named option of B<Pod::Parser> with a\r
+value that corresponds to a certain specified behavior. These various\r
+behaviors of B<Pod::Parser> may be enabled/disabled by setting\r
+or unsetting one or more I<parse-options> using the B<parseopts()> method.\r
+The set of currently accepted parse-options is as follows:\r
+\r
+=over 3\r
+\r
+=item B<-want_nonPODs> (default: unset)\r
+\r
+Normally (by default) B<Pod::Parser> will only provide access to\r
+the POD sections of the input. Input paragraphs that are not part\r
+of the POD-format documentation are not made available to the caller\r
+(not even using B<preprocess_paragraph()>). Setting this option to a\r
+non-empty, non-zero value will allow B<preprocess_paragraph()> to see\r
+non-POD sections of the input as well as POD sections. The B<cutting()>\r
+method can be used to determine if the corresponding paragraph is a POD\r
+paragraph, or some other input paragraph.\r
+\r
+=item B<-process_cut_cmd> (default: unset)\r
+\r
+Normally (by default) B<Pod::Parser> handles the C<=cut> POD directive\r
+by itself and does not pass it on to the caller for processing. Setting\r
+this option to a non-empty, non-zero value will cause B<Pod::Parser> to\r
+pass the C<=cut> directive to the caller just like any other POD command\r
+(and hence it may be processed by the B<command()> method).\r
+\r
+B<Pod::Parser> will still interpret the C<=cut> directive to mean that\r
+"cutting mode" has been (re)entered, but the caller will get a chance\r
+to capture the actual C<=cut> paragraph itself for whatever purpose\r
+it desires.\r
+\r
+=item B<-warnings> (default: unset)\r
+\r
+Normally (by default) B<Pod::Parser> recognizes a bare minimum of\r
+pod syntax errors and warnings and issues diagnostic messages\r
+for errors, but not for warnings. (Use B<Pod::Checker> to do more\r
+thorough checking of POD syntax.) Setting this option to a non-empty,\r
+non-zero value will cause B<Pod::Parser> to issue diagnostics for\r
+the few warnings it recognizes as well as the errors.\r
+\r
+=back\r
+\r
+Please see L<"parseopts()"> for a complete description of the interface\r
+for the setting and unsetting of parse-options.\r
+\r
+=cut\r
+\r
+#############################################################################\r
+\r
+#use diagnostics;\r
+use Pod::InputObjects;\r
+use Carp;\r
+use Exporter;\r
+BEGIN {\r
+ if ($] < 5.006) {\r
+ require Symbol;\r
+ import Symbol;\r
+ }\r
+}\r
+@ISA = qw(Exporter);\r
+\r
+#############################################################################\r
+\r
+=head1 RECOMMENDED SUBROUTINE/METHOD OVERRIDES\r
+\r
+B<Pod::Parser> provides several methods which most subclasses will probably\r
+want to override. These methods are as follows:\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<command()>\r
+\r
+ $parser->command($cmd,$text,$line_num,$pod_para);\r
+\r
+This method should be overridden by subclasses to take the appropriate\r
+action when a POD command paragraph (denoted by a line beginning with\r
+"=") is encountered. When such a POD directive is seen in the input,\r
+this method is called and is passed:\r
+\r
+=over 3\r
+\r
+=item C<$cmd>\r
+\r
+the name of the command for this POD paragraph\r
+\r
+=item C<$text>\r
+\r
+the paragraph text for the given POD paragraph command.\r
+\r
+=item C<$line_num>\r
+\r
+the line-number of the beginning of the paragraph\r
+\r
+=item C<$pod_para>\r
+\r
+a reference to a C<Pod::Paragraph> object which contains further\r
+information about the paragraph command (see L<Pod::InputObjects>\r
+for details).\r
+\r
+=back\r
+\r
+B<Note> that this method I<is> called for C<=pod> paragraphs.\r
+\r
+The base class implementation of this method simply treats the raw POD\r
+command as normal block of paragraph text (invoking the B<textblock()>\r
+method with the command paragraph).\r
+\r
+=cut\r
+\r
+sub command {\r
+ my ($self, $cmd, $text, $line_num, $pod_para) = @_;\r
+ ## Just treat this like a textblock\r
+ $self->textblock($pod_para->raw_text(), $line_num, $pod_para);\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<verbatim()>\r
+\r
+ $parser->verbatim($text,$line_num,$pod_para);\r
+\r
+This method may be overridden by subclasses to take the appropriate\r
+action when a block of verbatim text is encountered. It is passed the\r
+following parameters:\r
+\r
+=over 3\r
+\r
+=item C<$text>\r
+\r
+the block of text for the verbatim paragraph\r
+\r
+=item C<$line_num>\r
+\r
+the line-number of the beginning of the paragraph\r
+\r
+=item C<$pod_para>\r
+\r
+a reference to a C<Pod::Paragraph> object which contains further\r
+information about the paragraph (see L<Pod::InputObjects>\r
+for details).\r
+\r
+=back\r
+\r
+The base class implementation of this method simply prints the textblock\r
+(unmodified) to the output filehandle.\r
+\r
+=cut\r
+\r
+sub verbatim {\r
+ my ($self, $text, $line_num, $pod_para) = @_;\r
+ my $out_fh = $self->{_OUTPUT};\r
+ print $out_fh $text;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<textblock()>\r
+\r
+ $parser->textblock($text,$line_num,$pod_para);\r
+\r
+This method may be overridden by subclasses to take the appropriate\r
+action when a normal block of POD text is encountered (although the base\r
+class method will usually do what you want). It is passed the following\r
+parameters:\r
+\r
+=over 3\r
+\r
+=item C<$text>\r
+\r
+the block of text for the a POD paragraph\r
+\r
+=item C<$line_num>\r
+\r
+the line-number of the beginning of the paragraph\r
+\r
+=item C<$pod_para>\r
+\r
+a reference to a C<Pod::Paragraph> object which contains further\r
+information about the paragraph (see L<Pod::InputObjects>\r
+for details).\r
+\r
+=back\r
+\r
+In order to process interior sequences, subclasses implementations of\r
+this method will probably want to invoke either B<interpolate()> or\r
+B<parse_text()>, passing it the text block C<$text>, and the corresponding\r
+line number in C<$line_num>, and then perform any desired processing upon\r
+the returned result.\r
+\r
+The base class implementation of this method simply prints the text block\r
+as it occurred in the input stream).\r
+\r
+=cut\r
+\r
+sub textblock {\r
+ my ($self, $text, $line_num, $pod_para) = @_;\r
+ my $out_fh = $self->{_OUTPUT};\r
+ print $out_fh $self->interpolate($text, $line_num);\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<interior_sequence()>\r
+\r
+ $parser->interior_sequence($seq_cmd,$seq_arg,$pod_seq);\r
+\r
+This method should be overridden by subclasses to take the appropriate\r
+action when an interior sequence is encountered. An interior sequence is\r
+an embedded command within a block of text which appears as a command\r
+name (usually a single uppercase character) followed immediately by a\r
+string of text which is enclosed in angle brackets. This method is\r
+passed the sequence command C<$seq_cmd> and the corresponding text\r
+C<$seq_arg>. It is invoked by the B<interpolate()> method for each interior\r
+sequence that occurs in the string that it is passed. It should return\r
+the desired text string to be used in place of the interior sequence.\r
+The C<$pod_seq> argument is a reference to a C<Pod::InteriorSequence>\r
+object which contains further information about the interior sequence.\r
+Please see L<Pod::InputObjects> for details if you need to access this\r
+additional information.\r
+\r
+Subclass implementations of this method may wish to invoke the \r
+B<nested()> method of C<$pod_seq> to see if it is nested inside\r
+some other interior-sequence (and if so, which kind).\r
+\r
+The base class implementation of the B<interior_sequence()> method\r
+simply returns the raw text of the interior sequence (as it occurred\r
+in the input) to the caller.\r
+\r
+=cut\r
+\r
+sub interior_sequence {\r
+ my ($self, $seq_cmd, $seq_arg, $pod_seq) = @_;\r
+ ## Just return the raw text of the interior sequence\r
+ return $pod_seq->raw_text();\r
+}\r
+\r
+#############################################################################\r
+\r
+=head1 OPTIONAL SUBROUTINE/METHOD OVERRIDES\r
+\r
+B<Pod::Parser> provides several methods which subclasses may want to override\r
+to perform any special pre/post-processing. These methods do I<not> have to\r
+be overridden, but it may be useful for subclasses to take advantage of them.\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<new()>\r
+\r
+ my $parser = Pod::Parser->new();\r
+\r
+This is the constructor for B<Pod::Parser> and its subclasses. You\r
+I<do not> need to override this method! It is capable of constructing\r
+subclass objects as well as base class objects, provided you use\r
+any of the following constructor invocation styles:\r
+\r
+ my $parser1 = MyParser->new();\r
+ my $parser2 = new MyParser();\r
+ my $parser3 = $parser2->new();\r
+\r
+where C<MyParser> is some subclass of B<Pod::Parser>.\r
+\r
+Using the syntax C<MyParser::new()> to invoke the constructor is I<not>\r
+recommended, but if you insist on being able to do this, then the\r
+subclass I<will> need to override the B<new()> constructor method. If\r
+you do override the constructor, you I<must> be sure to invoke the\r
+B<initialize()> method of the newly blessed object.\r
+\r
+Using any of the above invocations, the first argument to the\r
+constructor is always the corresponding package name (or object\r
+reference). No other arguments are required, but if desired, an\r
+associative array (or hash-table) my be passed to the B<new()>\r
+constructor, as in:\r
+\r
+ my $parser1 = MyParser->new( MYDATA => $value1, MOREDATA => $value2 );\r
+ my $parser2 = new MyParser( -myflag => 1 );\r
+\r
+All arguments passed to the B<new()> constructor will be treated as\r
+key/value pairs in a hash-table. The newly constructed object will be\r
+initialized by copying the contents of the given hash-table (which may\r
+have been empty). The B<new()> constructor for this class and all of its\r
+subclasses returns a blessed reference to the initialized object (hash-table).\r
+\r
+=cut\r
+\r
+sub new {\r
+ ## Determine if we were called via an object-ref or a classname\r
+ my ($this,%params) = @_;\r
+ my $class = ref($this) || $this;\r
+ ## Any remaining arguments are treated as initial values for the\r
+ ## hash that is used to represent this object.\r
+ my $self = { %params };\r
+ ## Bless ourselves into the desired class and perform any initialization\r
+ bless $self, $class;\r
+ $self->initialize();\r
+ return $self;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<initialize()>\r
+\r
+ $parser->initialize();\r
+\r
+This method performs any necessary object initialization. It takes no\r
+arguments (other than the object instance of course, which is typically\r
+copied to a local variable named C<$self>). If subclasses override this\r
+method then they I<must> be sure to invoke C<$self-E<gt>SUPER::initialize()>.\r
+\r
+=cut\r
+\r
+sub initialize {\r
+ #my $self = shift;\r
+ #return;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<begin_pod()>\r
+\r
+ $parser->begin_pod();\r
+\r
+This method is invoked at the beginning of processing for each POD\r
+document that is encountered in the input. Subclasses should override\r
+this method to perform any per-document initialization.\r
+\r
+=cut\r
+\r
+sub begin_pod {\r
+ #my $self = shift;\r
+ #return;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<begin_input()>\r
+\r
+ $parser->begin_input();\r
+\r
+This method is invoked by B<parse_from_filehandle()> immediately I<before>\r
+processing input from a filehandle. The base class implementation does\r
+nothing, however, subclasses may override it to perform any per-file\r
+initializations.\r
+\r
+Note that if multiple files are parsed for a single POD document\r
+(perhaps the result of some future C<=include> directive) this method\r
+is invoked for every file that is parsed. If you wish to perform certain\r
+initializations once per document, then you should use B<begin_pod()>.\r
+\r
+=cut\r
+\r
+sub begin_input {\r
+ #my $self = shift;\r
+ #return;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<end_input()>\r
+\r
+ $parser->end_input();\r
+\r
+This method is invoked by B<parse_from_filehandle()> immediately I<after>\r
+processing input from a filehandle. The base class implementation does\r
+nothing, however, subclasses may override it to perform any per-file\r
+cleanup actions.\r
+\r
+Please note that if multiple files are parsed for a single POD document\r
+(perhaps the result of some kind of C<=include> directive) this method\r
+is invoked for every file that is parsed. If you wish to perform certain\r
+cleanup actions once per document, then you should use B<end_pod()>.\r
+\r
+=cut\r
+\r
+sub end_input {\r
+ #my $self = shift;\r
+ #return;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<end_pod()>\r
+\r
+ $parser->end_pod();\r
+\r
+This method is invoked at the end of processing for each POD document\r
+that is encountered in the input. Subclasses should override this method\r
+to perform any per-document finalization.\r
+\r
+=cut\r
+\r
+sub end_pod {\r
+ #my $self = shift;\r
+ #return;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<preprocess_line()>\r
+\r
+ $textline = $parser->preprocess_line($text, $line_num);\r
+\r
+This method should be overridden by subclasses that wish to perform\r
+any kind of preprocessing for each I<line> of input (I<before> it has\r
+been determined whether or not it is part of a POD paragraph). The\r
+parameter C<$text> is the input line; and the parameter C<$line_num> is\r
+the line number of the corresponding text line.\r
+\r
+The value returned should correspond to the new text to use in its\r
+place. If the empty string or an undefined value is returned then no\r
+further processing will be performed for this line.\r
+\r
+Please note that the B<preprocess_line()> method is invoked I<before>\r
+the B<preprocess_paragraph()> method. After all (possibly preprocessed)\r
+lines in a paragraph have been assembled together and it has been\r
+determined that the paragraph is part of the POD documentation from one\r
+of the selected sections, then B<preprocess_paragraph()> is invoked.\r
+\r
+The base class implementation of this method returns the given text.\r
+\r
+=cut\r
+\r
+sub preprocess_line {\r
+ my ($self, $text, $line_num) = @_;\r
+ return $text;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<preprocess_paragraph()>\r
+\r
+ $textblock = $parser->preprocess_paragraph($text, $line_num);\r
+\r
+This method should be overridden by subclasses that wish to perform any\r
+kind of preprocessing for each block (paragraph) of POD documentation\r
+that appears in the input stream. The parameter C<$text> is the POD\r
+paragraph from the input file; and the parameter C<$line_num> is the\r
+line number for the beginning of the corresponding paragraph.\r
+\r
+The value returned should correspond to the new text to use in its\r
+place If the empty string is returned or an undefined value is\r
+returned, then the given C<$text> is ignored (not processed).\r
+\r
+This method is invoked after gathering up all the lines in a paragraph\r
+and after determining the cutting state of the paragraph,\r
+but before trying to further parse or interpret them. After\r
+B<preprocess_paragraph()> returns, the current cutting state (which\r
+is returned by C<$self-E<gt>cutting()>) is examined. If it evaluates\r
+to true then input text (including the given C<$text>) is cut (not\r
+processed) until the next POD directive is encountered.\r
+\r
+Please note that the B<preprocess_line()> method is invoked I<before>\r
+the B<preprocess_paragraph()> method. After all (possibly preprocessed)\r
+lines in a paragraph have been assembled together and either it has been\r
+determined that the paragraph is part of the POD documentation from one\r
+of the selected sections or the C<-want_nonPODs> option is true,\r
+then B<preprocess_paragraph()> is invoked.\r
+\r
+The base class implementation of this method returns the given text.\r
+\r
+=cut\r
+\r
+sub preprocess_paragraph {\r
+ my ($self, $text, $line_num) = @_;\r
+ return $text;\r
+}\r
+\r
+#############################################################################\r
+\r
+=head1 METHODS FOR PARSING AND PROCESSING\r
+\r
+B<Pod::Parser> provides several methods to process input text. These\r
+methods typically won't need to be overridden (and in some cases they\r
+can't be overridden), but subclasses may want to invoke them to exploit\r
+their functionality.\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<parse_text()>\r
+\r
+ $ptree1 = $parser->parse_text($text, $line_num);\r
+ $ptree2 = $parser->parse_text({%opts}, $text, $line_num);\r
+ $ptree3 = $parser->parse_text(\%opts, $text, $line_num);\r
+\r
+This method is useful if you need to perform your own interpolation \r
+of interior sequences and can't rely upon B<interpolate> to expand\r
+them in simple bottom-up order.\r
+\r
+The parameter C<$text> is a string or block of text to be parsed\r
+for interior sequences; and the parameter C<$line_num> is the\r
+line number corresponding to the beginning of C<$text>.\r
+\r
+B<parse_text()> will parse the given text into a parse-tree of "nodes."\r
+and interior-sequences. Each "node" in the parse tree is either a\r
+text-string, or a B<Pod::InteriorSequence>. The result returned is a\r
+parse-tree of type B<Pod::ParseTree>. Please see L<Pod::InputObjects>\r
+for more information about B<Pod::InteriorSequence> and B<Pod::ParseTree>.\r
+\r
+If desired, an optional hash-ref may be specified as the first argument\r
+to customize certain aspects of the parse-tree that is created and\r
+returned. The set of recognized option keywords are:\r
+\r
+=over 3\r
+\r
+=item B<-expand_seq> =E<gt> I<code-ref>|I<method-name>\r
+\r
+Normally, the parse-tree returned by B<parse_text()> will contain an\r
+unexpanded C<Pod::InteriorSequence> object for each interior-sequence\r
+encountered. Specifying B<-expand_seq> tells B<parse_text()> to "expand"\r
+every interior-sequence it sees by invoking the referenced function\r
+(or named method of the parser object) and using the return value as the\r
+expanded result.\r
+\r
+If a subroutine reference was given, it is invoked as:\r
+\r
+ &$code_ref( $parser, $sequence )\r
+\r
+and if a method-name was given, it is invoked as:\r
+\r
+ $parser->method_name( $sequence )\r
+\r
+where C<$parser> is a reference to the parser object, and C<$sequence>\r
+is a reference to the interior-sequence object.\r
+[I<NOTE>: If the B<interior_sequence()> method is specified, then it is\r
+invoked according to the interface specified in L<"interior_sequence()">].\r
+\r
+=item B<-expand_text> =E<gt> I<code-ref>|I<method-name>\r
+\r
+Normally, the parse-tree returned by B<parse_text()> will contain a\r
+text-string for each contiguous sequence of characters outside of an\r
+interior-sequence. Specifying B<-expand_text> tells B<parse_text()> to\r
+"preprocess" every such text-string it sees by invoking the referenced\r
+function (or named method of the parser object) and using the return value\r
+as the preprocessed (or "expanded") result. [Note that if the result is\r
+an interior-sequence, then it will I<not> be expanded as specified by the\r
+B<-expand_seq> option; Any such recursive expansion needs to be handled by\r
+the specified callback routine.]\r
+\r
+If a subroutine reference was given, it is invoked as:\r
+\r
+ &$code_ref( $parser, $text, $ptree_node )\r
+\r
+and if a method-name was given, it is invoked as:\r
+\r
+ $parser->method_name( $text, $ptree_node )\r
+\r
+where C<$parser> is a reference to the parser object, C<$text> is the\r
+text-string encountered, and C<$ptree_node> is a reference to the current\r
+node in the parse-tree (usually an interior-sequence object or else the\r
+top-level node of the parse-tree).\r
+\r
+=item B<-expand_ptree> =E<gt> I<code-ref>|I<method-name>\r
+\r
+Rather than returning a C<Pod::ParseTree>, pass the parse-tree as an\r
+argument to the referenced subroutine (or named method of the parser\r
+object) and return the result instead of the parse-tree object.\r
+\r
+If a subroutine reference was given, it is invoked as:\r
+\r
+ &$code_ref( $parser, $ptree )\r
+\r
+and if a method-name was given, it is invoked as:\r
+\r
+ $parser->method_name( $ptree )\r
+\r
+where C<$parser> is a reference to the parser object, and C<$ptree>\r
+is a reference to the parse-tree object.\r
+\r
+=back\r
+\r
+=cut\r
+\r
+sub parse_text {\r
+ my $self = shift;\r
+ local $_ = '';\r
+\r
+ ## Get options and set any defaults\r
+ my %opts = (ref $_[0]) ? %{ shift() } : ();\r
+ my $expand_seq = $opts{'-expand_seq'} || undef;\r
+ my $expand_text = $opts{'-expand_text'} || undef;\r
+ my $expand_ptree = $opts{'-expand_ptree'} || undef;\r
+\r
+ my $text = shift;\r
+ my $line = shift;\r
+ my $file = $self->input_file();\r
+ my $cmd = "";\r
+\r
+ ## Convert method calls into closures, for our convenience\r
+ my $xseq_sub = $expand_seq;\r
+ my $xtext_sub = $expand_text;\r
+ my $xptree_sub = $expand_ptree;\r
+ if (defined $expand_seq and $expand_seq eq 'interior_sequence') {\r
+ ## If 'interior_sequence' is the method to use, we have to pass\r
+ ## more than just the sequence object, we also need to pass the\r
+ ## sequence name and text.\r
+ $xseq_sub = sub {\r
+ my ($sself, $iseq) = @_;\r
+ my $args = join('', $iseq->parse_tree->children);\r
+ return $sself->interior_sequence($iseq->name, $args, $iseq);\r
+ };\r
+ }\r
+ ref $xseq_sub or $xseq_sub = sub { shift()->$expand_seq(@_) };\r
+ ref $xtext_sub or $xtext_sub = sub { shift()->$expand_text(@_) };\r
+ ref $xptree_sub or $xptree_sub = sub { shift()->$expand_ptree(@_) };\r
+\r
+ ## Keep track of the "current" interior sequence, and maintain a stack\r
+ ## of "in progress" sequences.\r
+ ##\r
+ ## NOTE that we push our own "accumulator" at the very beginning of the\r
+ ## stack. It's really a parse-tree, not a sequence; but it implements\r
+ ## the methods we need so we can use it to gather-up all the sequences\r
+ ## and strings we parse. Thus, by the end of our parsing, it should be\r
+ ## the only thing left on our stack and all we have to do is return it!\r
+ ##\r
+ my $seq = Pod::ParseTree->new();\r
+ my @seq_stack = ($seq);\r
+ my ($ldelim, $rdelim) = ('', '');\r
+\r
+ ## Iterate over all sequence starts text (NOTE: split with\r
+ ## capturing parens keeps the delimiters)\r
+ $_ = $text;\r
+ my @tokens = split /([A-Z]<(?:<+(?:\r?\n|[ \t]))?)/;\r
+ while ( @tokens ) {\r
+ $_ = shift @tokens;\r
+ ## Look for the beginning of a sequence\r
+ if ( /^([A-Z])(<(?:<+(?:\r?\n|[ \t]))?)$/ ) {\r
+ ## Push a new sequence onto the stack of those "in-progress"\r
+ my $ldelim_orig;\r
+ ($cmd, $ldelim_orig) = ($1, $2);\r
+ ($ldelim = $ldelim_orig) =~ s/\s+$//;\r
+ ($rdelim = $ldelim) =~ tr/</>/;\r
+ $seq = Pod::InteriorSequence->new(\r
+ -name => $cmd,\r
+ -ldelim => $ldelim_orig, -rdelim => $rdelim,\r
+ -file => $file, -line => $line\r
+ );\r
+ (@seq_stack > 1) and $seq->nested($seq_stack[-1]);\r
+ push @seq_stack, $seq;\r
+ }\r
+ ## Look for sequence ending\r
+ elsif ( @seq_stack > 1 ) {\r
+ ## Make sure we match the right kind of closing delimiter\r
+ my ($seq_end, $post_seq) = ('', '');\r
+ if ( ($ldelim eq '<' and /\A(.*?)(>)/s)\r
+ or /\A(.*?)(\s+$rdelim)/s )\r
+ {\r
+ ## Found end-of-sequence, capture the interior and the\r
+ ## closing the delimiter, and put the rest back on the\r
+ ## token-list\r
+ $post_seq = substr($_, length($1) + length($2));\r
+ ($_, $seq_end) = ($1, $2);\r
+ (length $post_seq) and unshift @tokens, $post_seq;\r
+ }\r
+ if (length) {\r
+ ## In the middle of a sequence, append this text to it, and\r
+ ## dont forget to "expand" it if that's what the caller wanted\r
+ $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_);\r
+ $_ .= $seq_end;\r
+ }\r
+ if (length $seq_end) {\r
+ ## End of current sequence, record terminating delimiter\r
+ $seq->rdelim($seq_end);\r
+ ## Pop it off the stack of "in progress" sequences\r
+ pop @seq_stack;\r
+ ## Append result to its parent in current parse tree\r
+ $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq)\r
+ : $seq);\r
+ ## Remember the current cmd-name and left-delimiter\r
+ if(@seq_stack > 1) {\r
+ $cmd = $seq_stack[-1]->name;\r
+ $ldelim = $seq_stack[-1]->ldelim;\r
+ $rdelim = $seq_stack[-1]->rdelim;\r
+ } else {\r
+ $cmd = $ldelim = $rdelim = '';\r
+ }\r
+ }\r
+ }\r
+ elsif (length) {\r
+ ## In the middle of a sequence, append this text to it, and\r
+ ## dont forget to "expand" it if that's what the caller wanted\r
+ $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_);\r
+ }\r
+ ## Keep track of line count\r
+ $line += /\n/;\r
+ ## Remember the "current" sequence\r
+ $seq = $seq_stack[-1];\r
+ }\r
+\r
+ ## Handle unterminated sequences\r
+ my $errorsub = (@seq_stack > 1) ? $self->errorsub() : undef;\r
+ while (@seq_stack > 1) {\r
+ ($cmd, $file, $line) = ($seq->name, $seq->file_line);\r
+ $ldelim = $seq->ldelim;\r
+ ($rdelim = $ldelim) =~ tr/</>/;\r
+ $rdelim =~ s/^(\S+)(\s*)$/$2$1/;\r
+ pop @seq_stack;\r
+ my $errmsg = "*** ERROR: unterminated ${cmd}${ldelim}...${rdelim}".\r
+ " at line $line in file $file\n";\r
+ (ref $errorsub) and &{$errorsub}($errmsg)\r
+ or (defined $errorsub) and $self->$errorsub($errmsg)\r
+ or carp($errmsg);\r
+ $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) : $seq);\r
+ $seq = $seq_stack[-1];\r
+ }\r
+\r
+ ## Return the resulting parse-tree\r
+ my $ptree = (pop @seq_stack)->parse_tree;\r
+ return $expand_ptree ? &$xptree_sub($self, $ptree) : $ptree;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<interpolate()>\r
+\r
+ $textblock = $parser->interpolate($text, $line_num);\r
+\r
+This method translates all text (including any embedded interior sequences)\r
+in the given text string C<$text> and returns the interpolated result. The\r
+parameter C<$line_num> is the line number corresponding to the beginning\r
+of C<$text>.\r
+\r
+B<interpolate()> merely invokes a private method to recursively expand\r
+nested interior sequences in bottom-up order (innermost sequences are\r
+expanded first). If there is a need to expand nested sequences in\r
+some alternate order, use B<parse_text> instead.\r
+\r
+=cut\r
+\r
+sub interpolate {\r
+ my($self, $text, $line_num) = @_;\r
+ my %parse_opts = ( -expand_seq => 'interior_sequence' );\r
+ my $ptree = $self->parse_text( \%parse_opts, $text, $line_num );\r
+ return join '', $ptree->children();\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin __PRIVATE__\r
+\r
+=head1 B<parse_paragraph()>\r
+\r
+ $parser->parse_paragraph($text, $line_num);\r
+\r
+This method takes the text of a POD paragraph to be processed, along\r
+with its corresponding line number, and invokes the appropriate method\r
+(one of B<command()>, B<verbatim()>, or B<textblock()>).\r
+\r
+For performance reasons, this method is invoked directly without any\r
+dynamic lookup; Hence subclasses may I<not> override it!\r
+\r
+=end __PRIVATE__\r
+\r
+=cut\r
+\r
+sub parse_paragraph {\r
+ my ($self, $text, $line_num) = @_;\r
+ local *myData = $self; ## alias to avoid deref-ing overhead\r
+ local *myOpts = ($myData{_PARSEOPTS} ||= {}); ## get parse-options\r
+ local $_;\r
+\r
+ ## See if we want to preprocess nonPOD paragraphs as well as POD ones.\r
+ my $wantNonPods = $myOpts{'-want_nonPODs'};\r
+\r
+ ## Update cutting status\r
+ $myData{_CUTTING} = 0 if $text =~ /^={1,2}\S/;\r
+\r
+ ## Perform any desired preprocessing if we wanted it this early\r
+ $wantNonPods and $text = $self->preprocess_paragraph($text, $line_num);\r
+\r
+ ## Ignore up until next POD directive if we are cutting\r
+ return if $myData{_CUTTING};\r
+\r
+ ## Now we know this is block of text in a POD section!\r
+\r
+ ##-----------------------------------------------------------------\r
+ ## This is a hook (hack ;-) for Pod::Select to do its thing without\r
+ ## having to override methods, but also without Pod::Parser assuming\r
+ ## $self is an instance of Pod::Select (if the _SELECTED_SECTIONS\r
+ ## field exists then we assume there is an is_selected() method for\r
+ ## us to invoke (calling $self->can('is_selected') could verify this\r
+ ## but that is more overhead than I want to incur)\r
+ ##-----------------------------------------------------------------\r
+\r
+ ## Ignore this block if it isnt in one of the selected sections\r
+ if (exists $myData{_SELECTED_SECTIONS}) {\r
+ $self->is_selected($text) or return ($myData{_CUTTING} = 1);\r
+ }\r
+\r
+ ## If we havent already, perform any desired preprocessing and\r
+ ## then re-check the "cutting" state\r
+ unless ($wantNonPods) {\r
+ $text = $self->preprocess_paragraph($text, $line_num);\r
+ return 1 unless ((defined $text) and (length $text));\r
+ return 1 if ($myData{_CUTTING});\r
+ }\r
+\r
+ ## Look for one of the three types of paragraphs\r
+ my ($pfx, $cmd, $arg, $sep) = ('', '', '', '');\r
+ my $pod_para = undef;\r
+ if ($text =~ /^(={1,2})(?=\S)/) {\r
+ ## Looks like a command paragraph. Capture the command prefix used\r
+ ## ("=" or "=="), as well as the command-name, its paragraph text,\r
+ ## and whatever sequence of characters was used to separate them\r
+ $pfx = $1;\r
+ $_ = substr($text, length $pfx);\r
+ ($cmd, $sep, $text) = split /(\s+)/, $_, 2;\r
+ $sep = '' unless defined $sep;\r
+ $text = '' unless defined $text;\r
+ ## If this is a "cut" directive then we dont need to do anything\r
+ ## except return to "cutting" mode.\r
+ if ($cmd eq 'cut') {\r
+ $myData{_CUTTING} = 1;\r
+ return unless $myOpts{'-process_cut_cmd'};\r
+ }\r
+ }\r
+ ## Save the attributes indicating how the command was specified.\r
+ $pod_para = new Pod::Paragraph(\r
+ -name => $cmd,\r
+ -text => $text,\r
+ -prefix => $pfx,\r
+ -separator => $sep,\r
+ -file => $myData{_INFILE},\r
+ -line => $line_num\r
+ );\r
+ # ## Invoke appropriate callbacks\r
+ # if (exists $myData{_CALLBACKS}) {\r
+ # ## Look through the callback list, invoke callbacks,\r
+ # ## then see if we need to do the default actions\r
+ # ## (invoke_callbacks will return true if we do).\r
+ # return 1 unless $self->invoke_callbacks($cmd, $text, $line_num, $pod_para);\r
+ # }\r
+\r
+ # If the last paragraph ended in whitespace, and we're not between verbatim blocks, carp\r
+ if ($myData{_WHITESPACE} and $myOpts{'-warnings'}\r
+ and not ($text =~ /^\s+/ and ($myData{_PREVIOUS}||"") eq "verbatim")) {\r
+ my $errorsub = $self->errorsub();\r
+ my $line = $line_num - 1;\r
+ my $errmsg = "*** WARNING: line containing nothing but whitespace".\r
+ " in paragraph at line $line in file $myData{_INFILE}\n";\r
+ (ref $errorsub) and &{$errorsub}($errmsg)\r
+ or (defined $errorsub) and $self->$errorsub($errmsg)\r
+ or carp($errmsg);\r
+ }\r
+\r
+ if (length $cmd) {\r
+ ## A command paragraph\r
+ $self->command($cmd, $text, $line_num, $pod_para);\r
+ $myData{_PREVIOUS} = $cmd;\r
+ }\r
+ elsif ($text =~ /^\s+/) {\r
+ ## Indented text - must be a verbatim paragraph\r
+ $self->verbatim($text, $line_num, $pod_para);\r
+ $myData{_PREVIOUS} = "verbatim";\r
+ }\r
+ else {\r
+ ## Looks like an ordinary block of text\r
+ $self->textblock($text, $line_num, $pod_para);\r
+ $myData{_PREVIOUS} = "textblock";\r
+ }\r
+\r
+ # Update the whitespace for the next time around\r
+ #$myData{_WHITESPACE} = $text =~ /^[^\S\r\n]+\Z/m ? 1 : 0;\r
+ $myData{_WHITESPACE} = $text =~ /^[^\S\r\n]+\r*\Z/m ? 1 : 0;\r
+\r
+ return 1;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<parse_from_filehandle()>\r
+\r
+ $parser->parse_from_filehandle($in_fh,$out_fh);\r
+\r
+This method takes an input filehandle (which is assumed to already be\r
+opened for reading) and reads the entire input stream looking for blocks\r
+(paragraphs) of POD documentation to be processed. If no first argument\r
+is given the default input filehandle C<STDIN> is used.\r
+\r
+The C<$in_fh> parameter may be any object that provides a B<getline()>\r
+method to retrieve a single line of input text (hence, an appropriate\r
+wrapper object could be used to parse PODs from a single string or an\r
+array of strings).\r
+\r
+Using C<$in_fh-E<gt>getline()>, input is read line-by-line and assembled\r
+into paragraphs or "blocks" (which are separated by lines containing\r
+nothing but whitespace). For each block of POD documentation\r
+encountered it will invoke a method to parse the given paragraph.\r
+\r
+If a second argument is given then it should correspond to a filehandle where\r
+output should be sent (otherwise the default output filehandle is\r
+C<STDOUT> if no output filehandle is currently in use).\r
+\r
+B<NOTE:> For performance reasons, this method caches the input stream at\r
+the top of the stack in a local variable. Any attempts by clients to\r
+change the stack contents during processing when in the midst executing\r
+of this method I<will not affect> the input stream used by the current\r
+invocation of this method.\r
+\r
+This method does I<not> usually need to be overridden by subclasses.\r
+\r
+=cut\r
+\r
+sub parse_from_filehandle {\r
+ my $self = shift;\r
+ my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();\r
+ my ($in_fh, $out_fh) = @_;\r
+ $in_fh = \*STDIN unless ($in_fh);\r
+ local *myData = $self; ## alias to avoid deref-ing overhead\r
+ local *myOpts = ($myData{_PARSEOPTS} ||= {}); ## get parse-options\r
+ local $_;\r
+\r
+ ## Put this stream at the top of the stack and do beginning-of-input\r
+ ## processing. NOTE that $in_fh might be reset during this process.\r
+ my $topstream = $self->_push_input_stream($in_fh, $out_fh);\r
+ (exists $opts{-cutting}) and $self->cutting( $opts{-cutting} );\r
+\r
+ ## Initialize line/paragraph\r
+ my ($textline, $paragraph) = ('', '');\r
+ my ($nlines, $plines) = (0, 0);\r
+\r
+ ## Use <$fh> instead of $fh->getline where possible (for speed)\r
+ $_ = ref $in_fh;\r
+ my $tied_fh = (/^(?:GLOB|FileHandle|IO::\w+)$/ or tied $in_fh);\r
+\r
+ ## Read paragraphs line-by-line\r
+ while (defined ($textline = $tied_fh ? <$in_fh> : $in_fh->getline)) {\r
+ $textline = $self->preprocess_line($textline, ++$nlines);\r
+ next unless ((defined $textline) && (length $textline));\r
+\r
+ if ((! length $paragraph) && ($textline =~ /^==/)) {\r
+ ## '==' denotes a one-line command paragraph\r
+ $paragraph = $textline;\r
+ $plines = 1;\r
+ $textline = '';\r
+ } else {\r
+ ## Append this line to the current paragraph\r
+ $paragraph .= $textline;\r
+ ++$plines;\r
+ }\r
+\r
+ ## See if this line is blank and ends the current paragraph.\r
+ ## If it isnt, then keep iterating until it is.\r
+ next unless (($textline =~ /^[^\S\r\n]*[\r\n]*$/)\r
+ && (length $paragraph));\r
+\r
+ ## Now process the paragraph\r
+ parse_paragraph($self, $paragraph, ($nlines - $plines) + 1);\r
+ $paragraph = '';\r
+ $plines = 0;\r
+ }\r
+ ## Dont forget about the last paragraph in the file\r
+ if (length $paragraph) {\r
+ parse_paragraph($self, $paragraph, ($nlines - $plines) + 1)\r
+ }\r
+\r
+ ## Now pop the input stream off the top of the input stack.\r
+ $self->_pop_input_stream();\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<parse_from_file()>\r
+\r
+ $parser->parse_from_file($filename,$outfile);\r
+\r
+This method takes a filename and does the following:\r
+\r
+=over 2\r
+\r
+=item *\r
+\r
+opens the input and output files for reading\r
+(creating the appropriate filehandles)\r
+\r
+=item *\r
+\r
+invokes the B<parse_from_filehandle()> method passing it the\r
+corresponding input and output filehandles.\r
+\r
+=item *\r
+\r
+closes the input and output files.\r
+\r
+=back\r
+\r
+If the special input filename "-" or "<&STDIN" is given then the STDIN\r
+filehandle is used for input (and no open or close is performed). If no\r
+input filename is specified then "-" is implied. Filehandle references,\r
+or objects that support the regular IO operations (like C<E<lt>$fhE<gt>>\r
+or C<$fh-<Egt>getline>) are also accepted; the handles must already be \r
+opened.\r
+\r
+If a second argument is given then it should be the name of the desired\r
+output file. If the special output filename "-" or ">&STDOUT" is given\r
+then the STDOUT filehandle is used for output (and no open or close is\r
+performed). If the special output filename ">&STDERR" is given then the\r
+STDERR filehandle is used for output (and no open or close is\r
+performed). If no output filehandle is currently in use and no output\r
+filename is specified, then "-" is implied.\r
+Alternatively, filehandle references or objects that support the regular\r
+IO operations (like C<print>, e.g. L<IO::String>) are also accepted;\r
+the object must already be opened.\r
+\r
+This method does I<not> usually need to be overridden by subclasses.\r
+\r
+=cut\r
+\r
+sub parse_from_file {\r
+ my $self = shift;\r
+ my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();\r
+ my ($infile, $outfile) = @_;\r
+ my ($in_fh, $out_fh);\r
+ if ($] < 5.006) {\r
+ ($in_fh, $out_fh) = (gensym(), gensym());\r
+ }\r
+ my ($close_input, $close_output) = (0, 0);\r
+ local *myData = $self;\r
+ local *_;\r
+\r
+ ## Is $infile a filename or a (possibly implied) filehandle\r
+ if (defined $infile && ref $infile) {\r
+ if (ref($infile) =~ /^(SCALAR|ARRAY|HASH|CODE|REF)$/) {\r
+ croak "Input from $1 reference not supported!\n";\r
+ }\r
+ ## Must be a filehandle-ref (or else assume its a ref to an object\r
+ ## that supports the common IO read operations).\r
+ $myData{_INFILE} = ${$infile};\r
+ $in_fh = $infile;\r
+ }\r
+ elsif (!defined($infile) || !length($infile) || ($infile eq '-')\r
+ || ($infile =~ /^<&(?:STDIN|0)$/i))\r
+ {\r
+ ## Not a filename, just a string implying STDIN\r
+ $infile ||= '-';\r
+ $myData{_INFILE} = '<standard input>';\r
+ $in_fh = \*STDIN;\r
+ }\r
+ else {\r
+ ## We have a filename, open it for reading\r
+ $myData{_INFILE} = $infile;\r
+ open($in_fh, "< $infile") or\r
+ croak "Can't open $infile for reading: $!\n";\r
+ $close_input = 1;\r
+ }\r
+\r
+ ## NOTE: we need to be *very* careful when "defaulting" the output\r
+ ## file. We only want to use a default if this is the beginning of\r
+ ## the entire document (but *not* if this is an included file). We\r
+ ## determine this by seeing if the input stream stack has been set-up\r
+ ## already\r
+\r
+ ## Is $outfile a filename, a (possibly implied) filehandle, maybe a ref?\r
+ if (ref $outfile) {\r
+ ## we need to check for ref() first, as other checks involve reading\r
+ if (ref($outfile) =~ /^(ARRAY|HASH|CODE)$/) {\r
+ croak "Output to $1 reference not supported!\n";\r
+ }\r
+ elsif (ref($outfile) eq 'SCALAR') {\r
+# # NOTE: IO::String isn't a part of the perl distribution,\r
+# # so probably we shouldn't support this case...\r
+# require IO::String;\r
+# $myData{_OUTFILE} = "$outfile";\r
+# $out_fh = IO::String->new($outfile);\r
+ croak "Output to SCALAR reference not supported!\n";\r
+ }\r
+ else {\r
+ ## Must be a filehandle-ref (or else assume its a ref to an\r
+ ## object that supports the common IO write operations).\r
+ $myData{_OUTFILE} = ${$outfile};\r
+ $out_fh = $outfile;\r
+ }\r
+ }\r
+ elsif (!defined($outfile) || !length($outfile) || ($outfile eq '-')\r
+ || ($outfile =~ /^>&?(?:STDOUT|1)$/i))\r
+ {\r
+ if (defined $myData{_TOP_STREAM}) {\r
+ $out_fh = $myData{_OUTPUT};\r
+ }\r
+ else {\r
+ ## Not a filename, just a string implying STDOUT\r
+ $outfile ||= '-';\r
+ $myData{_OUTFILE} = '<standard output>';\r
+ $out_fh = \*STDOUT;\r
+ }\r
+ }\r
+ elsif ($outfile =~ /^>&(STDERR|2)$/i) {\r
+ ## Not a filename, just a string implying STDERR\r
+ $myData{_OUTFILE} = '<standard error>';\r
+ $out_fh = \*STDERR;\r
+ }\r
+ else {\r
+ ## We have a filename, open it for writing\r
+ $myData{_OUTFILE} = $outfile;\r
+ (-d $outfile) and croak "$outfile is a directory, not POD input!\n";\r
+ open($out_fh, "> $outfile") or\r
+ croak "Can't open $outfile for writing: $!\n";\r
+ $close_output = 1;\r
+ }\r
+\r
+ ## Whew! That was a lot of work to set up reasonably/robust behavior\r
+ ## in the case of a non-filename for reading and writing. Now we just\r
+ ## have to parse the input and close the handles when we're finished.\r
+ $self->parse_from_filehandle(\%opts, $in_fh, $out_fh);\r
+\r
+ $close_input and\r
+ close($in_fh) || croak "Can't close $infile after reading: $!\n";\r
+ $close_output and\r
+ close($out_fh) || croak "Can't close $outfile after writing: $!\n";\r
+}\r
+\r
+#############################################################################\r
+\r
+=head1 ACCESSOR METHODS\r
+\r
+Clients of B<Pod::Parser> should use the following methods to access\r
+instance data fields:\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<errorsub()>\r
+\r
+ $parser->errorsub("method_name");\r
+ $parser->errorsub(\&warn_user);\r
+ $parser->errorsub(sub { print STDERR, @_ });\r
+\r
+Specifies the method or subroutine to use when printing error messages\r
+about POD syntax. The supplied method/subroutine I<must> return TRUE upon\r
+successful printing of the message. If C<undef> is given, then the B<carp>\r
+builtin is used to issue error messages (this is the default behavior).\r
+\r
+ my $errorsub = $parser->errorsub()\r
+ my $errmsg = "This is an error message!\n"\r
+ (ref $errorsub) and &{$errorsub}($errmsg)\r
+ or (defined $errorsub) and $parser->$errorsub($errmsg)\r
+ or carp($errmsg);\r
+\r
+Returns a method name, or else a reference to the user-supplied subroutine\r
+used to print error messages. Returns C<undef> if the B<carp> builtin\r
+is used to issue error messages (this is the default behavior).\r
+\r
+=cut\r
+\r
+sub errorsub {\r
+ return (@_ > 1) ? ($_[0]->{_ERRORSUB} = $_[1]) : $_[0]->{_ERRORSUB};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<cutting()>\r
+\r
+ $boolean = $parser->cutting();\r
+\r
+Returns the current C<cutting> state: a boolean-valued scalar which\r
+evaluates to true if text from the input file is currently being "cut"\r
+(meaning it is I<not> considered part of the POD document).\r
+\r
+ $parser->cutting($boolean);\r
+\r
+Sets the current C<cutting> state to the given value and returns the\r
+result.\r
+\r
+=cut\r
+\r
+sub cutting {\r
+ return (@_ > 1) ? ($_[0]->{_CUTTING} = $_[1]) : $_[0]->{_CUTTING};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<parseopts()>\r
+\r
+When invoked with no additional arguments, B<parseopts> returns a hashtable\r
+of all the current parsing options.\r
+\r
+ ## See if we are parsing non-POD sections as well as POD ones\r
+ my %opts = $parser->parseopts();\r
+ $opts{'-want_nonPODs}' and print "-want_nonPODs\n";\r
+\r
+When invoked using a single string, B<parseopts> treats the string as the\r
+name of a parse-option and returns its corresponding value if it exists\r
+(returns C<undef> if it doesn't).\r
+\r
+ ## Did we ask to see '=cut' paragraphs?\r
+ my $want_cut = $parser->parseopts('-process_cut_cmd');\r
+ $want_cut and print "-process_cut_cmd\n";\r
+\r
+When invoked with multiple arguments, B<parseopts> treats them as\r
+key/value pairs and the specified parse-option names are set to the\r
+given values. Any unspecified parse-options are unaffected.\r
+\r
+ ## Set them back to the default\r
+ $parser->parseopts(-warnings => 0);\r
+\r
+When passed a single hash-ref, B<parseopts> uses that hash to completely\r
+reset the existing parse-options, all previous parse-option values\r
+are lost.\r
+\r
+ ## Reset all options to default \r
+ $parser->parseopts( { } );\r
+\r
+See L<"PARSING OPTIONS"> for more information on the name and meaning of each\r
+parse-option currently recognized.\r
+\r
+=cut\r
+\r
+sub parseopts {\r
+ local *myData = shift;\r
+ local *myOpts = ($myData{_PARSEOPTS} ||= {});\r
+ return %myOpts if (@_ == 0);\r
+ if (@_ == 1) {\r
+ local $_ = shift;\r
+ return ref($_) ? $myData{_PARSEOPTS} = $_ : $myOpts{$_};\r
+ }\r
+ my @newOpts = (%myOpts, @_);\r
+ $myData{_PARSEOPTS} = { @newOpts };\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<output_file()>\r
+\r
+ $fname = $parser->output_file();\r
+\r
+Returns the name of the output file being written.\r
+\r
+=cut\r
+\r
+sub output_file {\r
+ return $_[0]->{_OUTFILE};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<output_handle()>\r
+\r
+ $fhandle = $parser->output_handle();\r
+\r
+Returns the output filehandle object.\r
+\r
+=cut\r
+\r
+sub output_handle {\r
+ return $_[0]->{_OUTPUT};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<input_file()>\r
+\r
+ $fname = $parser->input_file();\r
+\r
+Returns the name of the input file being read.\r
+\r
+=cut\r
+\r
+sub input_file {\r
+ return $_[0]->{_INFILE};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<input_handle()>\r
+\r
+ $fhandle = $parser->input_handle();\r
+\r
+Returns the current input filehandle object.\r
+\r
+=cut\r
+\r
+sub input_handle {\r
+ return $_[0]->{_INPUT};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin __PRIVATE__\r
+\r
+=head1 B<input_streams()>\r
+\r
+ $listref = $parser->input_streams();\r
+\r
+Returns a reference to an array which corresponds to the stack of all\r
+the input streams that are currently in the middle of being parsed.\r
+\r
+While parsing an input stream, it is possible to invoke\r
+B<parse_from_file()> or B<parse_from_filehandle()> to parse a new input\r
+stream and then return to parsing the previous input stream. Each input\r
+stream to be parsed is pushed onto the end of this input stack\r
+before any of its input is read. The input stream that is currently\r
+being parsed is always at the end (or top) of the input stack. When an\r
+input stream has been exhausted, it is popped off the end of the\r
+input stack.\r
+\r
+Each element on this input stack is a reference to C<Pod::InputSource>\r
+object. Please see L<Pod::InputObjects> for more details.\r
+\r
+This method might be invoked when printing diagnostic messages, for example,\r
+to obtain the name and line number of the all input files that are currently\r
+being processed.\r
+\r
+=end __PRIVATE__\r
+\r
+=cut\r
+\r
+sub input_streams {\r
+ return $_[0]->{_INPUT_STREAMS};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin __PRIVATE__\r
+\r
+=head1 B<top_stream()>\r
+\r
+ $hashref = $parser->top_stream();\r
+\r
+Returns a reference to the hash-table that represents the element\r
+that is currently at the top (end) of the input stream stack\r
+(see L<"input_streams()">). The return value will be the C<undef>\r
+if the input stack is empty.\r
+\r
+This method might be used when printing diagnostic messages, for example,\r
+to obtain the name and line number of the current input file.\r
+\r
+=end __PRIVATE__\r
+\r
+=cut\r
+\r
+sub top_stream {\r
+ return $_[0]->{_TOP_STREAM} || undef;\r
+}\r
+\r
+#############################################################################\r
+\r
+=head1 PRIVATE METHODS AND DATA\r
+\r
+B<Pod::Parser> makes use of several internal methods and data fields\r
+which clients should not need to see or use. For the sake of avoiding\r
+name collisions for client data and methods, these methods and fields\r
+are briefly discussed here. Determined hackers may obtain further\r
+information about them by reading the B<Pod::Parser> source code.\r
+\r
+Private data fields are stored in the hash-object whose reference is\r
+returned by the B<new()> constructor for this class. The names of all\r
+private methods and data-fields used by B<Pod::Parser> begin with a\r
+prefix of "_" and match the regular expression C</^_\w+$/>.\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin _PRIVATE_\r
+\r
+=head1 B<_push_input_stream()>\r
+\r
+ $hashref = $parser->_push_input_stream($in_fh,$out_fh);\r
+\r
+This method will push the given input stream on the input stack and\r
+perform any necessary beginning-of-document or beginning-of-file\r
+processing. The argument C<$in_fh> is the input stream filehandle to\r
+push, and C<$out_fh> is the corresponding output filehandle to use (if\r
+it is not given or is undefined, then the current output stream is used,\r
+which defaults to standard output if it doesnt exist yet).\r
+\r
+The value returned will be reference to the hash-table that represents\r
+the new top of the input stream stack. I<Please Note> that it is\r
+possible for this method to use default values for the input and output\r
+file handles. If this happens, you will need to look at the C<INPUT>\r
+and C<OUTPUT> instance data members to determine their new values.\r
+\r
+=end _PRIVATE_\r
+\r
+=cut\r
+\r
+sub _push_input_stream {\r
+ my ($self, $in_fh, $out_fh) = @_;\r
+ local *myData = $self;\r
+\r
+ ## Initialize stuff for the entire document if this is *not*\r
+ ## an included file.\r
+ ##\r
+ ## NOTE: we need to be *very* careful when "defaulting" the output\r
+ ## filehandle. We only want to use a default value if this is the\r
+ ## beginning of the entire document (but *not* if this is an included\r
+ ## file).\r
+ unless (defined $myData{_TOP_STREAM}) {\r
+ $out_fh = \*STDOUT unless (defined $out_fh);\r
+ $myData{_CUTTING} = 1; ## current "cutting" state\r
+ $myData{_INPUT_STREAMS} = []; ## stack of all input streams\r
+ }\r
+\r
+ ## Initialize input indicators\r
+ $myData{_OUTFILE} = '(unknown)' unless (defined $myData{_OUTFILE});\r
+ $myData{_OUTPUT} = $out_fh if (defined $out_fh);\r
+ $in_fh = \*STDIN unless (defined $in_fh);\r
+ $myData{_INFILE} = '(unknown)' unless (defined $myData{_INFILE});\r
+ $myData{_INPUT} = $in_fh;\r
+ my $input_top = $myData{_TOP_STREAM}\r
+ = new Pod::InputSource(\r
+ -name => $myData{_INFILE},\r
+ -handle => $in_fh,\r
+ -was_cutting => $myData{_CUTTING}\r
+ );\r
+ local *input_stack = $myData{_INPUT_STREAMS};\r
+ push(@input_stack, $input_top);\r
+\r
+ ## Perform beginning-of-document and/or beginning-of-input processing\r
+ $self->begin_pod() if (@input_stack == 1);\r
+ $self->begin_input();\r
+\r
+ return $input_top;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin _PRIVATE_\r
+\r
+=head1 B<_pop_input_stream()>\r
+\r
+ $hashref = $parser->_pop_input_stream();\r
+\r
+This takes no arguments. It will perform any necessary end-of-file or\r
+end-of-document processing and then pop the current input stream from\r
+the top of the input stack.\r
+\r
+The value returned will be reference to the hash-table that represents\r
+the new top of the input stream stack.\r
+\r
+=end _PRIVATE_\r
+\r
+=cut\r
+\r
+sub _pop_input_stream {\r
+ my ($self) = @_;\r
+ local *myData = $self;\r
+ local *input_stack = $myData{_INPUT_STREAMS};\r
+\r
+ ## Perform end-of-input and/or end-of-document processing\r
+ $self->end_input() if (@input_stack > 0);\r
+ $self->end_pod() if (@input_stack == 1);\r
+\r
+ ## Restore cutting state to whatever it was before we started\r
+ ## parsing this file.\r
+ my $old_top = pop(@input_stack);\r
+ $myData{_CUTTING} = $old_top->was_cutting();\r
+\r
+ ## Dont forget to reset the input indicators\r
+ my $input_top = undef;\r
+ if (@input_stack > 0) {\r
+ $input_top = $myData{_TOP_STREAM} = $input_stack[-1];\r
+ $myData{_INFILE} = $input_top->name();\r
+ $myData{_INPUT} = $input_top->handle();\r
+ } else {\r
+ delete $myData{_TOP_STREAM};\r
+ delete $myData{_INPUT_STREAMS};\r
+ }\r
+\r
+ return $input_top;\r
+}\r
+\r
+#############################################################################\r
+\r
+=head1 TREE-BASED PARSING\r
+\r
+If straightforward stream-based parsing wont meet your needs (as is\r
+likely the case for tasks such as translating PODs into structured\r
+markup languages like HTML and XML) then you may need to take the\r
+tree-based approach. Rather than doing everything in one pass and\r
+calling the B<interpolate()> method to expand sequences into text, it\r
+may be desirable to instead create a parse-tree using the B<parse_text()>\r
+method to return a tree-like structure which may contain an ordered\r
+list of children (each of which may be a text-string, or a similar\r
+tree-like structure).\r
+\r
+Pay special attention to L<"METHODS FOR PARSING AND PROCESSING"> and\r
+to the objects described in L<Pod::InputObjects>. The former describes\r
+the gory details and parameters for how to customize and extend the\r
+parsing behavior of B<Pod::Parser>. B<Pod::InputObjects> provides\r
+several objects that may all be used interchangeably as parse-trees. The\r
+most obvious one is the B<Pod::ParseTree> object. It defines the basic\r
+interface and functionality that all things trying to be a POD parse-tree\r
+should do. A B<Pod::ParseTree> is defined such that each "node" may be a\r
+text-string, or a reference to another parse-tree. Each B<Pod::Paragraph>\r
+object and each B<Pod::InteriorSequence> object also supports the basic\r
+parse-tree interface.\r
+\r
+The B<parse_text()> method takes a given paragraph of text, and\r
+returns a parse-tree that contains one or more children, each of which\r
+may be a text-string, or an InteriorSequence object. There are also\r
+callback-options that may be passed to B<parse_text()> to customize\r
+the way it expands or transforms interior-sequences, as well as the\r
+returned result. These callbacks can be used to create a parse-tree\r
+with custom-made objects (which may or may not support the parse-tree\r
+interface, depending on how you choose to do it).\r
+\r
+If you wish to turn an entire POD document into a parse-tree, that process\r
+is fairly straightforward. The B<parse_text()> method is the key to doing\r
+this successfully. Every paragraph-callback (i.e. the polymorphic methods\r
+for B<command()>, B<verbatim()>, and B<textblock()> paragraphs) takes\r
+a B<Pod::Paragraph> object as an argument. Each paragraph object has a\r
+B<parse_tree()> method that can be used to get or set a corresponding\r
+parse-tree. So for each of those paragraph-callback methods, simply call\r
+B<parse_text()> with the options you desire, and then use the returned\r
+parse-tree to assign to the given paragraph object.\r
+\r
+That gives you a parse-tree for each paragraph - so now all you need is\r
+an ordered list of paragraphs. You can maintain that yourself as a data\r
+element in the object/hash. The most straightforward way would be simply\r
+to use an array-ref, with the desired set of custom "options" for each\r
+invocation of B<parse_text>. Let's assume the desired option-set is\r
+given by the hash C<%options>. Then we might do something like the\r
+following:\r
+\r
+ package MyPodParserTree;\r
+\r
+ @ISA = qw( Pod::Parser );\r
+\r
+ ...\r
+\r
+ sub begin_pod {\r
+ my $self = shift;\r
+ $self->{'-paragraphs'} = []; ## initialize paragraph list\r
+ }\r
+\r
+ sub command { \r
+ my ($parser, $command, $paragraph, $line_num, $pod_para) = @_;\r
+ my $ptree = $parser->parse_text({%options}, $paragraph, ...);\r
+ $pod_para->parse_tree( $ptree );\r
+ push @{ $self->{'-paragraphs'} }, $pod_para;\r
+ }\r
+\r
+ sub verbatim { \r
+ my ($parser, $paragraph, $line_num, $pod_para) = @_;\r
+ push @{ $self->{'-paragraphs'} }, $pod_para;\r
+ }\r
+\r
+ sub textblock { \r
+ my ($parser, $paragraph, $line_num, $pod_para) = @_;\r
+ my $ptree = $parser->parse_text({%options}, $paragraph, ...);\r
+ $pod_para->parse_tree( $ptree );\r
+ push @{ $self->{'-paragraphs'} }, $pod_para;\r
+ }\r
+\r
+ ...\r
+\r
+ package main;\r
+ ...\r
+ my $parser = new MyPodParserTree(...);\r
+ $parser->parse_from_file(...);\r
+ my $paragraphs_ref = $parser->{'-paragraphs'};\r
+\r
+Of course, in this module-author's humble opinion, I'd be more inclined to\r
+use the existing B<Pod::ParseTree> object than a simple array. That way\r
+everything in it, paragraphs and sequences, all respond to the same core\r
+interface for all parse-tree nodes. The result would look something like:\r
+\r
+ package MyPodParserTree2;\r
+\r
+ ...\r
+\r
+ sub begin_pod {\r
+ my $self = shift;\r
+ $self->{'-ptree'} = new Pod::ParseTree; ## initialize parse-tree\r
+ }\r
+\r
+ sub parse_tree {\r
+ ## convenience method to get/set the parse-tree for the entire POD\r
+ (@_ > 1) and $_[0]->{'-ptree'} = $_[1];\r
+ return $_[0]->{'-ptree'};\r
+ }\r
+\r
+ sub command { \r
+ my ($parser, $command, $paragraph, $line_num, $pod_para) = @_;\r
+ my $ptree = $parser->parse_text({<<options>>}, $paragraph, ...);\r
+ $pod_para->parse_tree( $ptree );\r
+ $parser->parse_tree()->append( $pod_para );\r
+ }\r
+\r
+ sub verbatim { \r
+ my ($parser, $paragraph, $line_num, $pod_para) = @_;\r
+ $parser->parse_tree()->append( $pod_para );\r
+ }\r
+\r
+ sub textblock { \r
+ my ($parser, $paragraph, $line_num, $pod_para) = @_;\r
+ my $ptree = $parser->parse_text({<<options>>}, $paragraph, ...);\r
+ $pod_para->parse_tree( $ptree );\r
+ $parser->parse_tree()->append( $pod_para );\r
+ }\r
+\r
+ ...\r
+\r
+ package main;\r
+ ...\r
+ my $parser = new MyPodParserTree2(...);\r
+ $parser->parse_from_file(...);\r
+ my $ptree = $parser->parse_tree;\r
+ ...\r
+\r
+Now you have the entire POD document as one great big parse-tree. You\r
+can even use the B<-expand_seq> option to B<parse_text> to insert\r
+whole different kinds of objects. Just don't expect B<Pod::Parser>\r
+to know what to do with them after that. That will need to be in your\r
+code. Or, alternatively, you can insert any object you like so long as\r
+it conforms to the B<Pod::ParseTree> interface.\r
+\r
+One could use this to create subclasses of B<Pod::Paragraphs> and\r
+B<Pod::InteriorSequences> for specific commands (or to create your own\r
+custom node-types in the parse-tree) and add some kind of B<emit()>\r
+method to each custom node/subclass object in the tree. Then all you'd\r
+need to do is recursively walk the tree in the desired order, processing\r
+the children (most likely from left to right) by formatting them if\r
+they are text-strings, or by calling their B<emit()> method if they\r
+are objects/references.\r
+\r
+=head1 CAVEATS\r
+\r
+Please note that POD has the notion of "paragraphs": this is something\r
+starting I<after> a blank (read: empty) line, with the single exception\r
+of the file start, which is also starting a paragraph. That means that\r
+especially a command (e.g. C<=head1>) I<must> be preceded with a blank\r
+line; C<__END__> is I<not> a blank line.\r
+\r
+=head1 SEE ALSO\r
+\r
+L<Pod::InputObjects>, L<Pod::Select>\r
+\r
+B<Pod::InputObjects> defines POD input objects corresponding to\r
+command paragraphs, parse-trees, and interior-sequences.\r
+\r
+B<Pod::Select> is a subclass of B<Pod::Parser> which provides the ability\r
+to selectively include and/or exclude sections of a POD document from being\r
+translated based upon the current heading, subheading, subsubheading, etc.\r
+\r
+=for __PRIVATE__\r
+B<Pod::Callbacks> is a subclass of B<Pod::Parser> which gives its users\r
+the ability the employ I<callback functions> instead of, or in addition\r
+to, overriding methods of the base class.\r
+\r
+=for __PRIVATE__\r
+B<Pod::Select> and B<Pod::Callbacks> do not override any\r
+methods nor do they define any new methods with the same name. Because\r
+of this, they may I<both> be used (in combination) as a base class of\r
+the same subclass in order to combine their functionality without\r
+causing any namespace clashes due to multiple inheritance.\r
+\r
+=head1 AUTHOR\r
+\r
+Please report bugs using L<http://rt.cpan.org>.\r
+\r
+Brad Appleton E<lt>bradapp@enteract.comE<gt>\r
+\r
+Based on code for B<Pod::Text> written by\r
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>\r
+\r
+=head1 LICENSE\r
+\r
+Pod-Parser is free software; you can redistribute it and/or modify it\r
+under the terms of the Artistic License distributed with Perl version\r
+5.000 or (at your option) any later version. Please refer to the\r
+Artistic License that came with your Perl distribution for more\r
+details. If your version of Perl was not distributed under the\r
+terms of the Artistic License, than you may distribute PodParser\r
+under the same terms as Perl itself.\r
+\r
+=cut\r
+\r
+1;\r
+# vim: ts=4 sw=4 et\r
--- /dev/null
+# Pod::PlainText -- Convert POD data to formatted ASCII text.\r
+# $Id: Text.pm,v 2.1 1999/09/20 11:53:33 eagle Exp $\r
+#\r
+# Copyright 1999-2000 by Russ Allbery <rra@stanford.edu>\r
+#\r
+# This program is free software; you can redistribute it and/or modify it\r
+# under the same terms as Perl itself.\r
+#\r
+# This module is intended to be a replacement for Pod::Text, and attempts to\r
+# match its output except for some specific circumstances where other\r
+# decisions seemed to produce better output. It uses Pod::Parser and is\r
+# designed to be very easy to subclass.\r
+\r
+############################################################################\r
+# Modules and declarations\r
+############################################################################\r
+\r
+package Pod::PlainText;\r
+use strict;\r
+\r
+require 5.005;\r
+\r
+use Carp qw(carp croak);\r
+use Pod::Select ();\r
+\r
+use vars qw(@ISA %ESCAPES $VERSION);\r
+\r
+# We inherit from Pod::Select instead of Pod::Parser so that we can be used\r
+# by Pod::Usage.\r
+@ISA = qw(Pod::Select);\r
+\r
+$VERSION = '2.06';\r
+\r
+BEGIN {\r
+ if ($] < 5.006) {\r
+ require Symbol;\r
+ import Symbol;\r
+ }\r
+}\r
+\r
+############################################################################\r
+# Table of supported E<> escapes\r
+############################################################################\r
+\r
+# This table is taken near verbatim from Pod::PlainText in Pod::Parser,\r
+# which got it near verbatim from the original Pod::Text. It is therefore\r
+# credited to Tom Christiansen, and I'm glad I didn't have to write it. :)\r
+%ESCAPES = (\r
+ 'amp' => '&', # ampersand\r
+ 'lt' => '<', # left chevron, less-than\r
+ 'gt' => '>', # right chevron, greater-than\r
+ 'quot' => '"', # double quote\r
+\r
+ "Aacute" => "\xC1", # capital A, acute accent\r
+ "aacute" => "\xE1", # small a, acute accent\r
+ "Acirc" => "\xC2", # capital A, circumflex accent\r
+ "acirc" => "\xE2", # small a, circumflex accent\r
+ "AElig" => "\xC6", # capital AE diphthong (ligature)\r
+ "aelig" => "\xE6", # small ae diphthong (ligature)\r
+ "Agrave" => "\xC0", # capital A, grave accent\r
+ "agrave" => "\xE0", # small a, grave accent\r
+ "Aring" => "\xC5", # capital A, ring\r
+ "aring" => "\xE5", # small a, ring\r
+ "Atilde" => "\xC3", # capital A, tilde\r
+ "atilde" => "\xE3", # small a, tilde\r
+ "Auml" => "\xC4", # capital A, dieresis or umlaut mark\r
+ "auml" => "\xE4", # small a, dieresis or umlaut mark\r
+ "Ccedil" => "\xC7", # capital C, cedilla\r
+ "ccedil" => "\xE7", # small c, cedilla\r
+ "Eacute" => "\xC9", # capital E, acute accent\r
+ "eacute" => "\xE9", # small e, acute accent\r
+ "Ecirc" => "\xCA", # capital E, circumflex accent\r
+ "ecirc" => "\xEA", # small e, circumflex accent\r
+ "Egrave" => "\xC8", # capital E, grave accent\r
+ "egrave" => "\xE8", # small e, grave accent\r
+ "ETH" => "\xD0", # capital Eth, Icelandic\r
+ "eth" => "\xF0", # small eth, Icelandic\r
+ "Euml" => "\xCB", # capital E, dieresis or umlaut mark\r
+ "euml" => "\xEB", # small e, dieresis or umlaut mark\r
+ "Iacute" => "\xCD", # capital I, acute accent\r
+ "iacute" => "\xED", # small i, acute accent\r
+ "Icirc" => "\xCE", # capital I, circumflex accent\r
+ "icirc" => "\xEE", # small i, circumflex accent\r
+ "Igrave" => "\xCD", # capital I, grave accent\r
+ "igrave" => "\xED", # small i, grave accent\r
+ "Iuml" => "\xCF", # capital I, dieresis or umlaut mark\r
+ "iuml" => "\xEF", # small i, dieresis or umlaut mark\r
+ "Ntilde" => "\xD1", # capital N, tilde\r
+ "ntilde" => "\xF1", # small n, tilde\r
+ "Oacute" => "\xD3", # capital O, acute accent\r
+ "oacute" => "\xF3", # small o, acute accent\r
+ "Ocirc" => "\xD4", # capital O, circumflex accent\r
+ "ocirc" => "\xF4", # small o, circumflex accent\r
+ "Ograve" => "\xD2", # capital O, grave accent\r
+ "ograve" => "\xF2", # small o, grave accent\r
+ "Oslash" => "\xD8", # capital O, slash\r
+ "oslash" => "\xF8", # small o, slash\r
+ "Otilde" => "\xD5", # capital O, tilde\r
+ "otilde" => "\xF5", # small o, tilde\r
+ "Ouml" => "\xD6", # capital O, dieresis or umlaut mark\r
+ "ouml" => "\xF6", # small o, dieresis or umlaut mark\r
+ "szlig" => "\xDF", # small sharp s, German (sz ligature)\r
+ "THORN" => "\xDE", # capital THORN, Icelandic\r
+ "thorn" => "\xFE", # small thorn, Icelandic\r
+ "Uacute" => "\xDA", # capital U, acute accent\r
+ "uacute" => "\xFA", # small u, acute accent\r
+ "Ucirc" => "\xDB", # capital U, circumflex accent\r
+ "ucirc" => "\xFB", # small u, circumflex accent\r
+ "Ugrave" => "\xD9", # capital U, grave accent\r
+ "ugrave" => "\xF9", # small u, grave accent\r
+ "Uuml" => "\xDC", # capital U, dieresis or umlaut mark\r
+ "uuml" => "\xFC", # small u, dieresis or umlaut mark\r
+ "Yacute" => "\xDD", # capital Y, acute accent\r
+ "yacute" => "\xFD", # small y, acute accent\r
+ "yuml" => "\xFF", # small y, dieresis or umlaut mark\r
+\r
+ "lchevron" => "\xAB", # left chevron (double less than)\r
+ "rchevron" => "\xBB", # right chevron (double greater than)\r
+);\r
+\r
+\r
+############################################################################\r
+# Initialization\r
+############################################################################\r
+\r
+# Initialize the object. Must be sure to call our parent initializer.\r
+sub initialize {\r
+ my $self = shift;\r
+\r
+ $$self{alt} = 0 unless defined $$self{alt};\r
+ $$self{indent} = 4 unless defined $$self{indent};\r
+ $$self{loose} = 0 unless defined $$self{loose};\r
+ $$self{sentence} = 0 unless defined $$self{sentence};\r
+ $$self{width} = 76 unless defined $$self{width};\r
+\r
+ $$self{INDENTS} = []; # Stack of indentations.\r
+ $$self{MARGIN} = $$self{indent}; # Current left margin in spaces.\r
+\r
+ return $self->SUPER::initialize;\r
+}\r
+\r
+\r
+############################################################################\r
+# Core overrides\r
+############################################################################\r
+\r
+# Called for each command paragraph. Gets the command, the associated\r
+# paragraph, the line number, and a Pod::Paragraph object. Just dispatches\r
+# the command to a method named the same as the command. =cut is handled\r
+# internally by Pod::Parser.\r
+sub command {\r
+ my $self = shift;\r
+ my $command = shift;\r
+ return if $command eq 'pod';\r
+ return if ($$self{EXCLUDE} && $command ne 'end');\r
+ if (defined $$self{ITEM}) {\r
+ $self->item ("\n");\r
+ local $_ = "\n";\r
+ $self->output($_) if($command eq 'back');\r
+ }\r
+ $command = 'cmd_' . $command;\r
+ return $self->$command (@_);\r
+}\r
+\r
+# Called for a verbatim paragraph. Gets the paragraph, the line number, and\r
+# a Pod::Paragraph object. Just output it verbatim, but with tabs converted\r
+# to spaces.\r
+sub verbatim {\r
+ my $self = shift;\r
+ return if $$self{EXCLUDE};\r
+ $self->item if defined $$self{ITEM};\r
+ local $_ = shift;\r
+ return if /^\s*$/;\r
+ s/^(\s*\S+)/(' ' x $$self{MARGIN}) . $1/gme;\r
+ return $self->output($_);\r
+}\r
+\r
+# Called for a regular text block. Gets the paragraph, the line number, and\r
+# a Pod::Paragraph object. Perform interpolation and output the results.\r
+sub textblock {\r
+ my $self = shift;\r
+ return if $$self{EXCLUDE};\r
+ if($$self{VERBATIM}) {\r
+ $self->output($_[0]);\r
+ return;\r
+ }\r
+ local $_ = shift;\r
+ my $line = shift;\r
+\r
+ # Perform a little magic to collapse multiple L<> references. This is\r
+ # here mostly for backwards-compatibility. We'll just rewrite the whole\r
+ # thing into actual text at this part, bypassing the whole internal\r
+ # sequence parsing thing.\r
+ s{\r
+ (\r
+ L< # A link of the form L</something>.\r
+ /\r
+ (\r
+ [:\w]+ # The item has to be a simple word...\r
+ (\(\))? # ...or simple function.\r
+ )\r
+ >\r
+ (\r
+ ,?\s+(and\s+)? # Allow lots of them, conjuncted.\r
+ L< \r
+ /\r
+ (\r
+ [:\w]+\r
+ (\(\))?\r
+ )\r
+ >\r
+ )+\r
+ )\r
+ } {\r
+ local $_ = $1;\r
+ s%L</([^>]+)>%$1%g;\r
+ my @items = split /(?:,?\s+(?:and\s+)?)/;\r
+ my $string = "the ";\r
+ my $i;\r
+ for ($i = 0; $i < @items; $i++) {\r
+ $string .= $items[$i];\r
+ $string .= ", " if @items > 2 && $i != $#items;\r
+ $string .= " and " if ($i == $#items - 1);\r
+ }\r
+ $string .= " entries elsewhere in this document";\r
+ $string;\r
+ }gex;\r
+\r
+ # Now actually interpolate and output the paragraph.\r
+ $_ = $self->interpolate ($_, $line);\r
+ s/\s*$/\n/s;\r
+ if (defined $$self{ITEM}) {\r
+ $self->item ($_ . "\n");\r
+ } else {\r
+ $self->output ($self->reformat ($_ . "\n"));\r
+ }\r
+}\r
+\r
+# Called for an interior sequence. Gets the command, argument, and a\r
+# Pod::InteriorSequence object and is expected to return the resulting text.\r
+# Calls code, bold, italic, file, and link to handle those types of\r
+# sequences, and handles S<>, E<>, X<>, and Z<> directly.\r
+sub interior_sequence {\r
+ my $self = shift;\r
+ my $command = shift;\r
+ local $_ = shift;\r
+ return '' if ($command eq 'X' || $command eq 'Z');\r
+\r
+ # Expand escapes into the actual character now, carping if invalid.\r
+ if ($command eq 'E') {\r
+ return $ESCAPES{$_} if defined $ESCAPES{$_};\r
+ carp "Unknown escape: E<$_>";\r
+ return "E<$_>";\r
+ }\r
+\r
+ # For all the other sequences, empty content produces no output.\r
+ return if $_ eq '';\r
+\r
+ # For S<>, compress all internal whitespace and then map spaces to \01.\r
+ # When we output the text, we'll map this back.\r
+ if ($command eq 'S') {\r
+ s/\s{2,}/ /g;\r
+ tr/ /\01/;\r
+ return $_;\r
+ }\r
+\r
+ # Anything else needs to get dispatched to another method.\r
+ if ($command eq 'B') { return $self->seq_b ($_) }\r
+ elsif ($command eq 'C') { return $self->seq_c ($_) }\r
+ elsif ($command eq 'F') { return $self->seq_f ($_) }\r
+ elsif ($command eq 'I') { return $self->seq_i ($_) }\r
+ elsif ($command eq 'L') { return $self->seq_l ($_) }\r
+ else { carp "Unknown sequence $command<$_>" }\r
+}\r
+\r
+# Called for each paragraph that's actually part of the POD. We take\r
+# advantage of this opportunity to untabify the input.\r
+sub preprocess_paragraph {\r
+ my $self = shift;\r
+ local $_ = shift;\r
+ 1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;\r
+ return $_;\r
+}\r
+\r
+\r
+############################################################################\r
+# Command paragraphs\r
+############################################################################\r
+\r
+# All command paragraphs take the paragraph and the line number.\r
+\r
+# First level heading.\r
+sub cmd_head1 {\r
+ my $self = shift;\r
+ local $_ = shift;\r
+ s/\s+$//s;\r
+ $_ = $self->interpolate ($_, shift);\r
+ if ($$self{alt}) {\r
+ $self->output ("\n==== $_ ====\n\n");\r
+ } else {\r
+ $_ .= "\n" if $$self{loose};\r
+ $self->output ($_ . "\n");\r
+ }\r
+}\r
+\r
+# Second level heading.\r
+sub cmd_head2 {\r
+ my $self = shift;\r
+ local $_ = shift;\r
+ s/\s+$//s;\r
+ $_ = $self->interpolate ($_, shift);\r
+ if ($$self{alt}) {\r
+ $self->output ("\n== $_ ==\n\n");\r
+ } else {\r
+ $_ .= "\n" if $$self{loose};\r
+ $self->output (' ' x ($$self{indent} / 2) . $_ . "\n");\r
+ }\r
+}\r
+\r
+# third level heading - not strictly perlpodspec compliant\r
+sub cmd_head3 {\r
+ my $self = shift;\r
+ local $_ = shift;\r
+ s/\s+$//s;\r
+ $_ = $self->interpolate ($_, shift);\r
+ if ($$self{alt}) {\r
+ $self->output ("\n= $_ =\n");\r
+ } else {\r
+ $_ .= "\n" if $$self{loose};\r
+ $self->output (' ' x ($$self{indent}) . $_ . "\n");\r
+ }\r
+}\r
+\r
+# fourth level heading - not strictly perlpodspec compliant\r
+# just like head3\r
+*cmd_head4 = \&cmd_head3;\r
+\r
+# Start a list.\r
+sub cmd_over {\r
+ my $self = shift;\r
+ local $_ = shift;\r
+ unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }\r
+ push (@{ $$self{INDENTS} }, $$self{MARGIN});\r
+ $$self{MARGIN} += ($_ + 0);\r
+}\r
+\r
+# End a list.\r
+sub cmd_back {\r
+ my $self = shift;\r
+ $$self{MARGIN} = pop @{ $$self{INDENTS} };\r
+ unless (defined $$self{MARGIN}) {\r
+ carp 'Unmatched =back';\r
+ $$self{MARGIN} = $$self{indent};\r
+ }\r
+}\r
+\r
+# An individual list item.\r
+sub cmd_item {\r
+ my $self = shift;\r
+ if (defined $$self{ITEM}) { $self->item }\r
+ local $_ = shift;\r
+ s/\s+$//s;\r
+ $$self{ITEM} = $self->interpolate ($_);\r
+}\r
+\r
+# Begin a block for a particular translator. Setting VERBATIM triggers\r
+# special handling in textblock().\r
+sub cmd_begin {\r
+ my $self = shift;\r
+ local $_ = shift;\r
+ my ($kind) = /^(\S+)/ or return;\r
+ if ($kind eq 'text') {\r
+ $$self{VERBATIM} = 1;\r
+ } else {\r
+ $$self{EXCLUDE} = 1;\r
+ }\r
+}\r
+\r
+# End a block for a particular translator. We assume that all =begin/=end\r
+# pairs are properly closed.\r
+sub cmd_end {\r
+ my $self = shift;\r
+ $$self{EXCLUDE} = 0;\r
+ $$self{VERBATIM} = 0;\r
+}\r
+\r
+# One paragraph for a particular translator. Ignore it unless it's intended\r
+# for text, in which case we treat it as a verbatim text block.\r
+sub cmd_for {\r
+ my $self = shift;\r
+ local $_ = shift;\r
+ my $line = shift;\r
+ return unless s/^text\b[ \t]*\r?\n?//;\r
+ $self->verbatim ($_, $line);\r
+}\r
+\r
+# just a dummy method for the time being\r
+sub cmd_encoding {\r
+ return;\r
+}\r
+\r
+############################################################################\r
+# Interior sequences\r
+############################################################################\r
+\r
+# The simple formatting ones. These are here mostly so that subclasses can\r
+# override them and do more complicated things.\r
+sub seq_b { return $_[0]{alt} ? "``$_[1]''" : $_[1] }\r
+sub seq_c { return $_[0]{alt} ? "``$_[1]''" : "`$_[1]'" }\r
+sub seq_f { return $_[0]{alt} ? "\"$_[1]\"" : $_[1] }\r
+sub seq_i { return '*' . $_[1] . '*' }\r
+\r
+# The complicated one. Handle links. Since this is plain text, we can't\r
+# actually make any real links, so this is all to figure out what text we\r
+# print out.\r
+sub seq_l {\r
+ my $self = shift;\r
+ local $_ = shift;\r
+\r
+ # Smash whitespace in case we were split across multiple lines.\r
+ s/\s+/ /g;\r
+\r
+ # If we were given any explicit text, just output it.\r
+ if (/^([^|]+)\|/) { return $1 }\r
+\r
+ # Okay, leading and trailing whitespace isn't important; get rid of it.\r
+ s/^\s+//;\r
+ s/\s+$//;\r
+\r
+ # Default to using the whole content of the link entry as a section\r
+ # name. Note that L<manpage/> forces a manpage interpretation, as does\r
+ # something looking like L<manpage(section)>. The latter is an\r
+ # enhancement over the original Pod::Text.\r
+ my ($manpage, $section) = ('', $_);\r
+ if (/^(?:https?|ftp|news):/) {\r
+ # a URL\r
+ return $_;\r
+ } elsif (/^"\s*(.*?)\s*"$/) {\r
+ $section = '"' . $1 . '"';\r
+ } elsif (m/^[-:.\w]+(?:\(\S+\))?$/) {\r
+ ($manpage, $section) = ($_, '');\r
+ } elsif (m{/}) {\r
+ ($manpage, $section) = split (/\s*\/\s*/, $_, 2);\r
+ }\r
+\r
+ my $text = '';\r
+ # Now build the actual output text.\r
+ if (!length $section) {\r
+ $text = "the $manpage manpage" if length $manpage;\r
+ } elsif ($section =~ /^[:\w]+(?:\(\))?/) {\r
+ $text .= 'the ' . $section . ' entry';\r
+ $text .= (length $manpage) ? " in the $manpage manpage"\r
+ : ' elsewhere in this document';\r
+ } else {\r
+ $section =~ s/^\"\s*//;\r
+ $section =~ s/\s*\"$//;\r
+ $text .= 'the section on "' . $section . '"';\r
+ $text .= " in the $manpage manpage" if length $manpage;\r
+ }\r
+ return $text;\r
+}\r
+\r
+\r
+############################################################################\r
+# List handling\r
+############################################################################\r
+\r
+# This method is called whenever an =item command is complete (in other\r
+# words, we've seen its associated paragraph or know for certain that it\r
+# doesn't have one). It gets the paragraph associated with the item as an\r
+# argument. If that argument is empty, just output the item tag; if it\r
+# contains a newline, output the item tag followed by the newline.\r
+# Otherwise, see if there's enough room for us to output the item tag in the\r
+# margin of the text or if we have to put it on a separate line.\r
+sub item {\r
+ my $self = shift;\r
+ local $_ = shift;\r
+ my $tag = $$self{ITEM};\r
+ unless (defined $tag) {\r
+ carp 'item called without tag';\r
+ return;\r
+ }\r
+ undef $$self{ITEM};\r
+ my $indent = $$self{INDENTS}[-1];\r
+ unless (defined $indent) { $indent = $$self{indent} }\r
+ my $space = ' ' x $indent;\r
+ $space =~ s/^ /:/ if $$self{alt};\r
+ if (!$_ || /^\s+$/ || ($$self{MARGIN} - $indent < length ($tag) + 1)) {\r
+ my $margin = $$self{MARGIN};\r
+ $$self{MARGIN} = $indent;\r
+ my $output = $self->reformat ($tag);\r
+ $output =~ s/[\r\n]*$/\n/;\r
+ $self->output ($output);\r
+ $$self{MARGIN} = $margin;\r
+ $self->output ($self->reformat ($_)) if /\S/;\r
+ } else {\r
+ $_ = $self->reformat ($_);\r
+ s/^ /:/ if ($$self{alt} && $indent > 0);\r
+ my $tagspace = ' ' x length $tag;\r
+ s/^($space)$tagspace/$1$tag/ or carp 'Bizarre space in item';\r
+ $self->output ($_);\r
+ }\r
+}\r
+\r
+\r
+############################################################################\r
+# Output formatting\r
+############################################################################\r
+\r
+# Wrap a line, indenting by the current left margin. We can't use\r
+# Text::Wrap because it plays games with tabs. We can't use formline, even\r
+# though we'd really like to, because it screws up non-printing characters.\r
+# So we have to do the wrapping ourselves.\r
+sub wrap {\r
+ my $self = shift;\r
+ local $_ = shift;\r
+ my $output = '';\r
+ my $spaces = ' ' x $$self{MARGIN};\r
+ my $width = $$self{width} - $$self{MARGIN};\r
+ while (length > $width) {\r
+ if (s/^([^\r\n]{0,$width})\s+// || s/^([^\r\n]{$width})//) {\r
+ $output .= $spaces . $1 . "\n";\r
+ } else {\r
+ last;\r
+ }\r
+ }\r
+ $output .= $spaces . $_;\r
+ $output =~ s/\s+$/\n\n/;\r
+ return $output;\r
+}\r
+\r
+# Reformat a paragraph of text for the current margin. Takes the text to\r
+# reformat and returns the formatted text.\r
+sub reformat {\r
+ my $self = shift;\r
+ local $_ = shift;\r
+\r
+ # If we're trying to preserve two spaces after sentences, do some\r
+ # munging to support that. Otherwise, smash all repeated whitespace.\r
+ if ($$self{sentence}) {\r
+ s/ +$//mg;\r
+ s/\.\r?\n/. \n/g;\r
+ s/[\r\n]+/ /g;\r
+ s/ +/ /g;\r
+ } else {\r
+ s/\s+/ /g;\r
+ }\r
+ return $self->wrap($_);\r
+}\r
+\r
+# Output text to the output device.\r
+sub output { $_[1] =~ tr/\01/ /; print { $_[0]->output_handle } $_[1] }\r
+\r
+\r
+############################################################################\r
+# Backwards compatibility\r
+############################################################################\r
+\r
+# The old Pod::Text module did everything in a pod2text() function. This\r
+# tries to provide the same interface for legacy applications.\r
+sub pod2text {\r
+ my @args;\r
+\r
+ # This is really ugly; I hate doing option parsing in the middle of a\r
+ # module. But the old Pod::Text module supported passing flags to its\r
+ # entry function, so handle -a and -<number>.\r
+ while ($_[0] =~ /^-/) {\r
+ my $flag = shift;\r
+ if ($flag eq '-a') { push (@args, alt => 1) }\r
+ elsif ($flag =~ /^-(\d+)$/) { push (@args, width => $1) }\r
+ else {\r
+ unshift (@_, $flag);\r
+ last;\r
+ }\r
+ }\r
+\r
+ # Now that we know what arguments we're using, create the parser.\r
+ my $parser = Pod::PlainText->new (@args);\r
+\r
+ # If two arguments were given, the second argument is going to be a file\r
+ # handle. That means we want to call parse_from_filehandle(), which\r
+ # means we need to turn the first argument into a file handle. Magic\r
+ # open will handle the <&STDIN case automagically.\r
+ if (defined $_[1]) {\r
+ my $infh;\r
+ if ($] < 5.006) {\r
+ $infh = gensym();\r
+ }\r
+ unless (open ($infh, $_[0])) {\r
+ croak ("Can't open $_[0] for reading: $!\n");\r
+ }\r
+ $_[0] = $infh;\r
+ return $parser->parse_from_filehandle (@_);\r
+ } else {\r
+ return $parser->parse_from_file (@_);\r
+ }\r
+}\r
+\r
+\r
+############################################################################\r
+# Module return value and documentation\r
+############################################################################\r
+\r
+1;\r
+__END__\r
+\r
+=head1 NAME\r
+\r
+Pod::PlainText - Convert POD data to formatted ASCII text\r
+\r
+=head1 SYNOPSIS\r
+\r
+ use Pod::PlainText;\r
+ my $parser = Pod::PlainText->new (sentence => 0, width => 78);\r
+\r
+ # Read POD from STDIN and write to STDOUT.\r
+ $parser->parse_from_filehandle;\r
+\r
+ # Read POD from file.pod and write to file.txt.\r
+ $parser->parse_from_file ('file.pod', 'file.txt');\r
+\r
+=head1 DESCRIPTION\r
+\r
+Pod::PlainText is a module that can convert documentation in the POD format (the\r
+preferred language for documenting Perl) into formatted ASCII. It uses no\r
+special formatting controls or codes whatsoever, and its output is therefore\r
+suitable for nearly any device.\r
+\r
+As a derived class from Pod::Parser, Pod::PlainText supports the same methods and\r
+interfaces. See L<Pod::Parser> for all the details; briefly, one creates a\r
+new parser with C<Pod::PlainText-E<gt>new()> and then calls either\r
+parse_from_filehandle() or parse_from_file().\r
+\r
+new() can take options, in the form of key/value pairs, that control the\r
+behavior of the parser. The currently recognized options are:\r
+\r
+=over 4\r
+\r
+=item alt\r
+\r
+If set to a true value, selects an alternate output format that, among other\r
+things, uses a different heading style and marks C<=item> entries with a\r
+colon in the left margin. Defaults to false.\r
+\r
+=item indent\r
+\r
+The number of spaces to indent regular text, and the default indentation for\r
+C<=over> blocks. Defaults to 4.\r
+\r
+=item loose\r
+\r
+If set to a true value, a blank line is printed after a C<=headN> headings.\r
+If set to false (the default), no blank line is printed after C<=headN>.\r
+This is the default because it's the expected formatting for manual pages;\r
+if you're formatting arbitrary text documents, setting this to true may\r
+result in more pleasing output.\r
+\r
+=item sentence\r
+\r
+If set to a true value, Pod::PlainText will assume that each sentence ends in two\r
+spaces, and will try to preserve that spacing. If set to false, all\r
+consecutive whitespace in non-verbatim paragraphs is compressed into a\r
+single space. Defaults to true.\r
+\r
+=item width\r
+\r
+The column at which to wrap text on the right-hand side. Defaults to 76.\r
+\r
+=back\r
+\r
+The standard Pod::Parser method parse_from_filehandle() takes up to two\r
+arguments, the first being the file handle to read POD from and the second\r
+being the file handle to write the formatted output to. The first defaults\r
+to STDIN if not given, and the second defaults to STDOUT. The method\r
+parse_from_file() is almost identical, except that its two arguments are the\r
+input and output disk files instead. See L<Pod::Parser> for the specific\r
+details.\r
+\r
+=head1 DIAGNOSTICS\r
+\r
+=over 4\r
+\r
+=item Bizarre space in item\r
+\r
+(W) Something has gone wrong in internal C<=item> processing. This message\r
+indicates a bug in Pod::PlainText; you should never see it.\r
+\r
+=item Can't open %s for reading: %s\r
+\r
+(F) Pod::PlainText was invoked via the compatibility mode pod2text() interface\r
+and the input file it was given could not be opened.\r
+\r
+=item Unknown escape: %s\r
+\r
+(W) The POD source contained an C<EE<lt>E<gt>> escape that Pod::PlainText didn't\r
+know about.\r
+\r
+=item Unknown sequence: %s\r
+\r
+(W) The POD source contained a non-standard internal sequence (something of\r
+the form C<XE<lt>E<gt>>) that Pod::PlainText didn't know about.\r
+\r
+=item Unmatched =back\r
+\r
+(W) Pod::PlainText encountered a C<=back> command that didn't correspond to an\r
+C<=over> command.\r
+\r
+=back\r
+\r
+=head1 RESTRICTIONS\r
+\r
+Embedded Ctrl-As (octal 001) in the input will be mapped to spaces on\r
+output, due to an internal implementation detail.\r
+\r
+=head1 NOTES\r
+\r
+This is a replacement for an earlier Pod::Text module written by Tom\r
+Christiansen. It has a revamped interface, since it now uses Pod::Parser,\r
+but an interface roughly compatible with the old Pod::Text::pod2text()\r
+function is still available. Please change to the new calling convention,\r
+though.\r
+\r
+The original Pod::Text contained code to do formatting via termcap\r
+sequences, although it wasn't turned on by default and it was problematic to\r
+get it to work at all. This rewrite doesn't even try to do that, but a\r
+subclass of it does. Look for L<Pod::Text::Termcap|Pod::Text::Termcap>.\r
+\r
+=head1 SEE ALSO\r
+\r
+B<Pod::PlainText> is part of the L<Pod::Parser> distribution.\r
+\r
+L<Pod::Parser|Pod::Parser>, L<Pod::Text::Termcap|Pod::Text::Termcap>,\r
+pod2text(1)\r
+\r
+=head1 AUTHOR\r
+\r
+Please report bugs using L<http://rt.cpan.org>.\r
+\r
+Russ Allbery E<lt>rra@stanford.eduE<gt>, based I<very> heavily on the\r
+original Pod::Text by Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> and\r
+its conversion to Pod::Parser by Brad Appleton\r
+E<lt>bradapp@enteract.comE<gt>.\r
+\r
+=cut\r
--- /dev/null
+#############################################################################\r
+# Pod/Select.pm -- function to select portions of POD docs\r
+#\r
+# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.\r
+# This file is part of "PodParser". PodParser is free software;\r
+# you can redistribute it and/or modify it under the same terms\r
+# as Perl itself.\r
+#############################################################################\r
+\r
+package Pod::Select;\r
+use strict;\r
+\r
+use vars qw($VERSION @ISA @EXPORT $MAX_HEADING_LEVEL %myData @section_headings @selected_sections);\r
+$VERSION = '1.60'; ## Current version of this package\r
+require 5.005; ## requires this Perl version or later\r
+\r
+#############################################################################\r
+\r
+=head1 NAME\r
+\r
+Pod::Select, podselect() - extract selected sections of POD from input\r
+\r
+=head1 SYNOPSIS\r
+\r
+ use Pod::Select;\r
+\r
+ ## Select all the POD sections for each file in @filelist\r
+ ## and print the result on standard output.\r
+ podselect(@filelist);\r
+\r
+ ## Same as above, but write to tmp.out\r
+ podselect({-output => "tmp.out"}, @filelist):\r
+\r
+ ## Select from the given filelist, only those POD sections that are\r
+ ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.\r
+ podselect({-sections => ["NAME|SYNOPSIS", "OPTIONS"]}, @filelist):\r
+\r
+ ## Select the "DESCRIPTION" section of the PODs from STDIN and write\r
+ ## the result to STDERR.\r
+ podselect({-output => ">&STDERR", -sections => ["DESCRIPTION"]}, \*STDIN);\r
+\r
+or\r
+\r
+ use Pod::Select;\r
+\r
+ ## Create a parser object for selecting POD sections from the input\r
+ $parser = new Pod::Select();\r
+\r
+ ## Select all the POD sections for each file in @filelist\r
+ ## and print the result to tmp.out.\r
+ $parser->parse_from_file("<&STDIN", "tmp.out");\r
+\r
+ ## Select from the given filelist, only those POD sections that are\r
+ ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.\r
+ $parser->select("NAME|SYNOPSIS", "OPTIONS");\r
+ for (@filelist) { $parser->parse_from_file($_); }\r
+\r
+ ## Select the "DESCRIPTION" and "SEE ALSO" sections of the PODs from\r
+ ## STDIN and write the result to STDERR.\r
+ $parser->select("DESCRIPTION");\r
+ $parser->add_selection("SEE ALSO");\r
+ $parser->parse_from_filehandle(\*STDIN, \*STDERR);\r
+\r
+=head1 REQUIRES\r
+\r
+perl5.005, Pod::Parser, Exporter, Carp\r
+\r
+=head1 EXPORTS\r
+\r
+podselect()\r
+\r
+=head1 DESCRIPTION\r
+\r
+B<podselect()> is a function which will extract specified sections of\r
+pod documentation from an input stream. This ability is provided by the\r
+B<Pod::Select> module which is a subclass of B<Pod::Parser>.\r
+B<Pod::Select> provides a method named B<select()> to specify the set of\r
+POD sections to select for processing/printing. B<podselect()> merely\r
+creates a B<Pod::Select> object and then invokes the B<podselect()>\r
+followed by B<parse_from_file()>.\r
+\r
+=head1 SECTION SPECIFICATIONS\r
+\r
+B<podselect()> and B<Pod::Select::select()> may be given one or more\r
+"section specifications" to restrict the text processed to only the\r
+desired set of sections and their corresponding subsections. A section\r
+specification is a string containing one or more Perl-style regular\r
+expressions separated by forward slashes ("/"). If you need to use a\r
+forward slash literally within a section title you can escape it with a\r
+backslash ("\/").\r
+\r
+The formal syntax of a section specification is:\r
+\r
+=over 4\r
+\r
+=item *\r
+\r
+I<head1-title-regex>/I<head2-title-regex>/...\r
+\r
+=back\r
+\r
+Any omitted or empty regular expressions will default to ".*".\r
+Please note that each regular expression given is implicitly\r
+anchored by adding "^" and "$" to the beginning and end. Also, if a\r
+given regular expression starts with a "!" character, then the\r
+expression is I<negated> (so C<!foo> would match anything I<except>\r
+C<foo>).\r
+\r
+Some example section specifications follow.\r
+\r
+=over 4\r
+\r
+=item *\r
+\r
+Match the C<NAME> and C<SYNOPSIS> sections and all of their subsections:\r
+\r
+C<NAME|SYNOPSIS>\r
+\r
+=item *\r
+\r
+Match only the C<Question> and C<Answer> subsections of the C<DESCRIPTION>\r
+section:\r
+\r
+C<DESCRIPTION/Question|Answer>\r
+\r
+=item *\r
+\r
+Match the C<Comments> subsection of I<all> sections:\r
+\r
+C</Comments>\r
+\r
+=item *\r
+\r
+Match all subsections of C<DESCRIPTION> I<except> for C<Comments>:\r
+\r
+C<DESCRIPTION/!Comments>\r
+\r
+=item *\r
+\r
+Match the C<DESCRIPTION> section but do I<not> match any of its subsections:\r
+\r
+C<DESCRIPTION/!.+>\r
+\r
+=item *\r
+\r
+Match all top level sections but none of their subsections:\r
+\r
+C</!.+>\r
+\r
+=back \r
+\r
+=begin _NOT_IMPLEMENTED_\r
+\r
+=head1 RANGE SPECIFICATIONS\r
+\r
+B<podselect()> and B<Pod::Select::select()> may be given one or more\r
+"range specifications" to restrict the text processed to only the\r
+desired ranges of paragraphs in the desired set of sections. A range\r
+specification is a string containing a single Perl-style regular\r
+expression (a regex), or else two Perl-style regular expressions\r
+(regexs) separated by a ".." (Perl's "range" operator is "..").\r
+The regexs in a range specification are delimited by forward slashes\r
+("/"). If you need to use a forward slash literally within a regex you\r
+can escape it with a backslash ("\/").\r
+\r
+The formal syntax of a range specification is:\r
+\r
+=over 4\r
+\r
+=item *\r
+\r
+/I<start-range-regex>/[../I<end-range-regex>/]\r
+\r
+=back\r
+\r
+Where each the item inside square brackets (the ".." followed by the\r
+end-range-regex) is optional. Each "range-regex" is of the form:\r
+\r
+ =cmd-expr text-expr\r
+\r
+Where I<cmd-expr> is intended to match the name of one or more POD\r
+commands, and I<text-expr> is intended to match the paragraph text for\r
+the command. If a range-regex is supposed to match a POD command, then\r
+the first character of the regex (the one after the initial '/')\r
+absolutely I<must> be a single '=' character; it may not be anything\r
+else (not even a regex meta-character) if it is supposed to match\r
+against the name of a POD command.\r
+\r
+If no I<=cmd-expr> is given then the text-expr will be matched against\r
+plain textblocks unless it is preceded by a space, in which case it is\r
+matched against verbatim text-blocks. If no I<text-expr> is given then\r
+only the command-portion of the paragraph is matched against.\r
+\r
+Note that these two expressions are each implicitly anchored. This\r
+means that when matching against the command-name, there will be an\r
+implicit '^' and '$' around the given I<=cmd-expr>; and when matching\r
+against the paragraph text there will be an implicit '\A' and '\Z'\r
+around the given I<text-expr>.\r
+\r
+Unlike with section-specs, the '!' character does I<not> have any special\r
+meaning (negation or otherwise) at the beginning of a range-spec!\r
+\r
+Some example range specifications follow.\r
+\r
+=over 4\r
+\r
+=item\r
+Match all C<=for html> paragraphs:\r
+\r
+C</=for html/>\r
+\r
+=item\r
+Match all paragraphs between C<=begin html> and C<=end html>\r
+(note that this will I<not> work correctly if such sections\r
+are nested):\r
+\r
+C</=begin html/../=end html/>\r
+\r
+=item\r
+Match all paragraphs between the given C<=item> name until the end of the\r
+current section:\r
+\r
+C</=item mine/../=head\d/>\r
+\r
+=item\r
+Match all paragraphs between the given C<=item> until the next item, or\r
+until the end of the itemized list (note that this will I<not> work as\r
+desired if the item contains an itemized list nested within it):\r
+\r
+C</=item mine/../=(item|back)/>\r
+\r
+=back \r
+\r
+=end _NOT_IMPLEMENTED_\r
+\r
+=cut\r
+\r
+#############################################################################\r
+\r
+#use diagnostics;\r
+use Carp;\r
+use Pod::Parser 1.04;\r
+\r
+@ISA = qw(Pod::Parser);\r
+@EXPORT = qw(&podselect);\r
+\r
+## Maximum number of heading levels supported for '=headN' directives\r
+*MAX_HEADING_LEVEL = \3;\r
+\r
+#############################################################################\r
+\r
+=head1 OBJECT METHODS\r
+\r
+The following methods are provided in this module. Each one takes a\r
+reference to the object itself as an implicit first parameter.\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+## =begin _PRIVATE_\r
+## \r
+## =head1 B<_init_headings()>\r
+## \r
+## Initialize the current set of active section headings.\r
+## \r
+## =cut\r
+## \r
+## =end _PRIVATE_\r
+\r
+sub _init_headings {\r
+ my $self = shift;\r
+ local *myData = $self;\r
+\r
+ ## Initialize current section heading titles if necessary\r
+ unless (defined $myData{_SECTION_HEADINGS}) {\r
+ local *section_headings = $myData{_SECTION_HEADINGS} = [];\r
+ for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {\r
+ $section_headings[$i] = '';\r
+ }\r
+ }\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<curr_headings()>\r
+\r
+ ($head1, $head2, $head3, ...) = $parser->curr_headings();\r
+ $head1 = $parser->curr_headings(1);\r
+\r
+This method returns a list of the currently active section headings and\r
+subheadings in the document being parsed. The list of headings returned\r
+corresponds to the most recently parsed paragraph of the input.\r
+\r
+If an argument is given, it must correspond to the desired section\r
+heading number, in which case only the specified section heading is\r
+returned. If there is no current section heading at the specified\r
+level, then C<undef> is returned.\r
+\r
+=cut\r
+\r
+sub curr_headings {\r
+ my $self = shift;\r
+ $self->_init_headings() unless (defined $self->{_SECTION_HEADINGS});\r
+ my @headings = @{ $self->{_SECTION_HEADINGS} };\r
+ return (@_ > 0 and $_[0] =~ /^\d+$/) ? $headings[$_[0] - 1] : @headings;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<select()>\r
+\r
+ $parser->select($section_spec1,$section_spec2,...);\r
+\r
+This method is used to select the particular sections and subsections of\r
+POD documentation that are to be printed and/or processed. The existing\r
+set of selected sections is I<replaced> with the given set of sections.\r
+See B<add_selection()> for adding to the current set of selected\r
+sections.\r
+\r
+Each of the C<$section_spec> arguments should be a section specification\r
+as described in L<"SECTION SPECIFICATIONS">. The section specifications\r
+are parsed by this method and the resulting regular expressions are\r
+stored in the invoking object.\r
+\r
+If no C<$section_spec> arguments are given, then the existing set of\r
+selected sections is cleared out (which means C<all> sections will be\r
+processed).\r
+\r
+This method should I<not> normally be overridden by subclasses.\r
+\r
+=cut\r
+\r
+sub select {\r
+ my ($self, @sections) = @_;\r
+ local *myData = $self;\r
+ local $_;\r
+\r
+### NEED TO DISCERN A SECTION-SPEC FROM A RANGE-SPEC (look for m{^/.+/$}?)\r
+\r
+ ##---------------------------------------------------------------------\r
+ ## The following is a blatant hack for backward compatibility, and for\r
+ ## implementing add_selection(). If the *first* *argument* is the\r
+ ## string "+", then the remaining section specifications are *added*\r
+ ## to the current set of selections; otherwise the given section\r
+ ## specifications will *replace* the current set of selections.\r
+ ##\r
+ ## This should probably be fixed someday, but for the present time,\r
+ ## it seems incredibly unlikely that "+" would ever correspond to\r
+ ## a legitimate section heading\r
+ ##---------------------------------------------------------------------\r
+ my $add = ($sections[0] eq '+') ? shift(@sections) : '';\r
+\r
+ ## Reset the set of sections to use\r
+ unless (@sections) {\r
+ delete $myData{_SELECTED_SECTIONS} unless ($add);\r
+ return;\r
+ }\r
+ $myData{_SELECTED_SECTIONS} = []\r
+ unless ($add && exists $myData{_SELECTED_SECTIONS});\r
+ local *selected_sections = $myData{_SELECTED_SECTIONS};\r
+\r
+ ## Compile each spec\r
+ for my $spec (@sections) {\r
+ if ( defined($_ = _compile_section_spec($spec)) ) {\r
+ ## Store them in our sections array\r
+ push(@selected_sections, $_);\r
+ }\r
+ else {\r
+ carp qq{Ignoring section spec "$spec"!\n};\r
+ }\r
+ }\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<add_selection()>\r
+\r
+ $parser->add_selection($section_spec1,$section_spec2,...);\r
+\r
+This method is used to add to the currently selected sections and\r
+subsections of POD documentation that are to be printed and/or\r
+processed. See <select()> for replacing the currently selected sections.\r
+\r
+Each of the C<$section_spec> arguments should be a section specification\r
+as described in L<"SECTION SPECIFICATIONS">. The section specifications\r
+are parsed by this method and the resulting regular expressions are\r
+stored in the invoking object.\r
+\r
+This method should I<not> normally be overridden by subclasses.\r
+\r
+=cut\r
+\r
+sub add_selection {\r
+ my $self = shift;\r
+ return $self->select('+', @_);\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<clear_selections()>\r
+\r
+ $parser->clear_selections();\r
+\r
+This method takes no arguments, it has the exact same effect as invoking\r
+<select()> with no arguments.\r
+\r
+=cut\r
+\r
+sub clear_selections {\r
+ my $self = shift;\r
+ return $self->select();\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<match_section()>\r
+\r
+ $boolean = $parser->match_section($heading1,$heading2,...);\r
+\r
+Returns a value of true if the given section and subsection heading\r
+titles match any of the currently selected section specifications in\r
+effect from prior calls to B<select()> and B<add_selection()> (or if\r
+there are no explicitly selected/deselected sections).\r
+\r
+The arguments C<$heading1>, C<$heading2>, etc. are the heading titles of\r
+the corresponding sections, subsections, etc. to try and match. If\r
+C<$headingN> is omitted then it defaults to the current corresponding\r
+section heading title in the input.\r
+\r
+This method should I<not> normally be overridden by subclasses.\r
+\r
+=cut\r
+\r
+sub match_section {\r
+ my $self = shift;\r
+ my (@headings) = @_;\r
+ local *myData = $self;\r
+\r
+ ## Return true if no restrictions were explicitly specified\r
+ my $selections = (exists $myData{_SELECTED_SECTIONS})\r
+ ? $myData{_SELECTED_SECTIONS} : undef;\r
+ return 1 unless ((defined $selections) && @{$selections});\r
+\r
+ ## Default any unspecified sections to the current one\r
+ my @current_headings = $self->curr_headings();\r
+ for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {\r
+ (defined $headings[$i]) or $headings[$i] = $current_headings[$i];\r
+ }\r
+\r
+ ## Look for a match against the specified section expressions\r
+ for my $section_spec ( @{$selections} ) {\r
+ ##------------------------------------------------------\r
+ ## Each portion of this spec must match in order for\r
+ ## the spec to be matched. So we will start with a \r
+ ## match-value of 'true' and logically 'and' it with\r
+ ## the results of matching a given element of the spec.\r
+ ##------------------------------------------------------\r
+ my $match = 1;\r
+ for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {\r
+ my $regex = $section_spec->[$i];\r
+ my $negated = ($regex =~ s/^\!//);\r
+ $match &= ($negated ? ($headings[$i] !~ /${regex}/)\r
+ : ($headings[$i] =~ /${regex}/));\r
+ last unless ($match);\r
+ }\r
+ return 1 if ($match);\r
+ }\r
+ return 0; ## no match\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<is_selected()>\r
+\r
+ $boolean = $parser->is_selected($paragraph);\r
+\r
+This method is used to determine if the block of text given in\r
+C<$paragraph> falls within the currently selected set of POD sections\r
+and subsections to be printed or processed. This method is also\r
+responsible for keeping track of the current input section and\r
+subsections. It is assumed that C<$paragraph> is the most recently read\r
+(but not yet processed) input paragraph.\r
+\r
+The value returned will be true if the C<$paragraph> and the rest of the\r
+text in the same section as C<$paragraph> should be selected (included)\r
+for processing; otherwise a false value is returned.\r
+\r
+=cut\r
+\r
+sub is_selected {\r
+ my ($self, $paragraph) = @_;\r
+ local $_;\r
+ local *myData = $self;\r
+\r
+ $self->_init_headings() unless (defined $myData{_SECTION_HEADINGS});\r
+\r
+ ## Keep track of current sections levels and headings\r
+ $_ = $paragraph;\r
+ if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*?)\s*$/)\r
+ {\r
+ ## This is a section heading command\r
+ my ($level, $heading) = ($2, $3);\r
+ $level = 1 + (length($1) / 3) if ((! length $level) || (length $1));\r
+ ## Reset the current section heading at this level\r
+ $myData{_SECTION_HEADINGS}->[$level - 1] = $heading;\r
+ ## Reset subsection headings of this one to empty\r
+ for (my $i = $level; $i < $MAX_HEADING_LEVEL; ++$i) {\r
+ $myData{_SECTION_HEADINGS}->[$i] = '';\r
+ }\r
+ }\r
+\r
+ return $self->match_section();\r
+}\r
+\r
+#############################################################################\r
+\r
+=head1 EXPORTED FUNCTIONS\r
+\r
+The following functions are exported by this module. Please note that\r
+these are functions (not methods) and therefore C<do not> take an\r
+implicit first argument.\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<podselect()>\r
+\r
+ podselect(\%options,@filelist);\r
+\r
+B<podselect> will print the raw (untranslated) POD paragraphs of all\r
+POD sections in the given input files specified by C<@filelist>\r
+according to the given options.\r
+\r
+If any argument to B<podselect> is a reference to a hash\r
+(associative array) then the values with the following keys are\r
+processed as follows:\r
+\r
+=over 4\r
+\r
+=item B<-output>\r
+\r
+A string corresponding to the desired output file (or ">&STDOUT"\r
+or ">&STDERR"). The default is to use standard output.\r
+\r
+=item B<-sections>\r
+\r
+A reference to an array of sections specifications (as described in\r
+L<"SECTION SPECIFICATIONS">) which indicate the desired set of POD\r
+sections and subsections to be selected from input. If no section\r
+specifications are given, then all sections of the PODs are used.\r
+\r
+=begin _NOT_IMPLEMENTED_\r
+\r
+=item B<-ranges>\r
+\r
+A reference to an array of range specifications (as described in\r
+L<"RANGE SPECIFICATIONS">) which indicate the desired range of POD\r
+paragraphs to be selected from the desired input sections. If no range\r
+specifications are given, then all paragraphs of the desired sections\r
+are used.\r
+\r
+=end _NOT_IMPLEMENTED_\r
+\r
+=back\r
+\r
+All other arguments should correspond to the names of input files\r
+containing POD sections. A file name of "-" or "<&STDIN" will\r
+be interpreted to mean standard input (which is the default if no\r
+filenames are given).\r
+\r
+=cut \r
+\r
+sub podselect {\r
+ my(@argv) = @_;\r
+ my %defaults = ();\r
+ my $pod_parser = new Pod::Select(%defaults);\r
+ my $num_inputs = 0;\r
+ my $output = '>&STDOUT';\r
+ my %opts;\r
+ local $_;\r
+ for (@argv) {\r
+ if (ref($_)) {\r
+ next unless (ref($_) eq 'HASH');\r
+ %opts = (%defaults, %{$_});\r
+\r
+ ##-------------------------------------------------------------\r
+ ## Need this for backward compatibility since we formerly used\r
+ ## options that were all uppercase words rather than ones that\r
+ ## looked like Unix command-line options.\r
+ ## to be uppercase keywords)\r
+ ##-------------------------------------------------------------\r
+ %opts = map {\r
+ my ($key, $val) = (lc $_, $opts{$_});\r
+ $key =~ s/^(?=\w)/-/;\r
+ $key =~ /^-se[cl]/ and $key = '-sections';\r
+ #! $key eq '-range' and $key .= 's';\r
+ ($key => $val);\r
+ } (keys %opts);\r
+\r
+ ## Process the options\r
+ (exists $opts{'-output'}) and $output = $opts{'-output'};\r
+\r
+ ## Select the desired sections\r
+ $pod_parser->select(@{ $opts{'-sections'} })\r
+ if ( (defined $opts{'-sections'})\r
+ && ((ref $opts{'-sections'}) eq 'ARRAY') );\r
+\r
+ #! ## Select the desired paragraph ranges\r
+ #! $pod_parser->select(@{ $opts{'-ranges'} })\r
+ #! if ( (defined $opts{'-ranges'})\r
+ #! && ((ref $opts{'-ranges'}) eq 'ARRAY') );\r
+ }\r
+ else {\r
+ $pod_parser->parse_from_file($_, $output);\r
+ ++$num_inputs;\r
+ }\r
+ }\r
+ $pod_parser->parse_from_file('-') unless ($num_inputs > 0);\r
+}\r
+\r
+#############################################################################\r
+\r
+=head1 PRIVATE METHODS AND DATA\r
+\r
+B<Pod::Select> makes uses a number of internal methods and data fields\r
+which clients should not need to see or use. For the sake of avoiding\r
+name collisions with client data and methods, these methods and fields\r
+are briefly discussed here. Determined hackers may obtain further\r
+information about them by reading the B<Pod::Select> source code.\r
+\r
+Private data fields are stored in the hash-object whose reference is\r
+returned by the B<new()> constructor for this class. The names of all\r
+private methods and data-fields used by B<Pod::Select> begin with a\r
+prefix of "_" and match the regular expression C</^_\w+$/>.\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin _PRIVATE_\r
+\r
+=head1 B<_compile_section_spec()>\r
+\r
+ $listref = $parser->_compile_section_spec($section_spec);\r
+\r
+This function (note it is a function and I<not> a method) takes a\r
+section specification (as described in L<"SECTION SPECIFICATIONS">)\r
+given in C<$section_sepc>, and compiles it into a list of regular\r
+expressions. If C<$section_spec> has no syntax errors, then a reference\r
+to the list (array) of corresponding regular expressions is returned;\r
+otherwise C<undef> is returned and an error message is printed (using\r
+B<carp>) for each invalid regex.\r
+\r
+=end _PRIVATE_\r
+\r
+=cut\r
+\r
+sub _compile_section_spec {\r
+ my ($section_spec) = @_;\r
+ my (@regexs, $negated);\r
+\r
+ ## Compile the spec into a list of regexs\r
+ local $_ = $section_spec;\r
+ s{\\\\}{\001}g; ## handle escaped backward slashes\r
+ s{\\/}{\002}g; ## handle escaped forward slashes\r
+\r
+ ## Parse the regexs for the heading titles\r
+ @regexs = split(/\//, $_, $MAX_HEADING_LEVEL);\r
+\r
+ ## Set default regex for ommitted levels\r
+ for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {\r
+ $regexs[$i] = '.*' unless ((defined $regexs[$i])\r
+ && (length $regexs[$i]));\r
+ }\r
+ ## Modify the regexs as needed and validate their syntax\r
+ my $bad_regexs = 0;\r
+ for (@regexs) {\r
+ $_ .= '.+' if ($_ eq '!');\r
+ s{\001}{\\\\}g; ## restore escaped backward slashes\r
+ s{\002}{\\/}g; ## restore escaped forward slashes\r
+ $negated = s/^\!//; ## check for negation\r
+ eval "m{$_}"; ## check regex syntax\r
+ if ($@) {\r
+ ++$bad_regexs;\r
+ carp qq{Bad regular expression /$_/ in "$section_spec": $@\n};\r
+ }\r
+ else {\r
+ ## Add the forward and rear anchors (and put the negator back)\r
+ $_ = '^' . $_ unless (/^\^/);\r
+ $_ = $_ . '$' unless (/\$$/);\r
+ $_ = '!' . $_ if ($negated);\r
+ }\r
+ }\r
+ return (! $bad_regexs) ? [ @regexs ] : undef;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin _PRIVATE_\r
+\r
+=head2 $self->{_SECTION_HEADINGS}\r
+\r
+A reference to an array of the current section heading titles for each\r
+heading level (note that the first heading level title is at index 0).\r
+\r
+=end _PRIVATE_\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin _PRIVATE_\r
+\r
+=head2 $self->{_SELECTED_SECTIONS}\r
+\r
+A reference to an array of references to arrays. Each subarray is a list\r
+of anchored regular expressions (preceded by a "!" if the expression is to\r
+be negated). The index of the expression in the subarray should correspond\r
+to the index of the heading title in C<$self-E<gt>{_SECTION_HEADINGS}>\r
+that it is to be matched against.\r
+\r
+=end _PRIVATE_\r
+\r
+=cut\r
+\r
+#############################################################################\r
+\r
+=head1 SEE ALSO\r
+\r
+L<Pod::Parser>\r
+\r
+=head1 AUTHOR\r
+\r
+Please report bugs using L<http://rt.cpan.org>.\r
+\r
+Brad Appleton E<lt>bradapp@enteract.comE<gt>\r
+\r
+Based on code for B<pod2text> written by\r
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>\r
+\r
+B<Pod::Select> is part of the L<Pod::Parser> distribution.\r
+\r
+=cut\r
+\r
+1;\r
+# vim: ts=4 sw=4 et\r
plan skip_all => "Not portable on Win32 or VMS\n";
}
else {
- plan tests => 34;
+ plan tests => 33;
}
use_ok ("Pod::Usage");
}
#
EOT
-# test with pod_where
-use_ok('Pod::Find', qw(pod_where));
+# test with self
-($exit, $text) = getoutput( sub { pod2usage( -input => pod_where({-inc => 1}, 'Pod::Usage'),
+my $src = File::Spec->catfile(qw(lib Pod Usage.pm));
+($exit, $text) = getoutput( sub { pod2usage( -input => $src,
-exitval => 0, -verbose => 0) } );
$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
-is ($exit, 0, "Exit status pod2usage with Pod::Find");
-ok (compare ($text, <<'EOT'), "Output test pod2usage with Pod::Find") or diag "Got:\n$text\n";
+is ($exit, 0, "Exit status pod2usage with self");
+ok (compare ($text, <<'EOT'), "Output test pod2usage with self") or diag "Got:\n$text\n";
#Usage:
# use Pod::Usage
#
package TestPodIncPlainText;
+my $PARENTDIR;
+
BEGIN {
use File::Basename;
use File::Spec;
unshift @INC, $THISDIR;
require "testcmp.pl";
import TestCompare;
- my $PARENTDIR = dirname $THISDIR;
+ $PARENTDIR = dirname $THISDIR;
push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR);
}
$MYPKG = eval { (caller)[0] };
@EXPORT = qw(&testpodplaintext);
BEGIN {
+ # we want this for testing only
+ unshift(@INC, File::Spec->catfile($PARENTDIR, 'inc'));
+print "INC=@INC\n";
+
require Pod::PlainText;
@ISA = qw( Pod::PlainText );
require VMS::Filespec if $^O eq 'VMS';
https://perl5.git.perl.org / perl5.git / commitdiff