summaryrefslogtreecommitdiff
path: root/lib/Pod
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2009-09-13 15:20:13 +0100
committerNicholas Clark <nick@ccl4.org>2009-09-13 15:20:13 +0100
commit6d1e6673d7386f4f9139111a6e44d555b8252741 (patch)
tree19c27e332ca80894cfe4ab407bf0da42fdd6893f /lib/Pod
parent764e6bc7b1d0feb0638e9cb218f559fd7e81e593 (diff)
downloadperl-6d1e6673d7386f4f9139111a6e44d555b8252741.tar.gz
Move Pod::Parser from lib (and t/pod) to ext.
Diffstat (limited to 'lib/Pod')
-rw-r--r--lib/Pod/Checker.pm1268
-rw-r--r--lib/Pod/Find.pm535
-rw-r--r--lib/Pod/InputObjects.pm936
-rw-r--r--lib/Pod/ParseUtils.pm855
-rw-r--r--lib/Pod/Parser.pm1829
-rw-r--r--lib/Pod/PlainText.pm738
-rw-r--r--lib/Pod/Select.pm746
-rw-r--r--lib/Pod/Usage.pm730
-rw-r--r--lib/Pod/t/contains_pod.t27
9 files changed, 0 insertions, 7664 deletions
diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm
deleted file mode 100644
index a2305423b2..0000000000
--- a/lib/Pod/Checker.pm
+++ /dev/null
@@ -1,1268 +0,0 @@
-#############################################################################
-# Pod/Checker.pm -- check pod documents for syntax errors
-#
-# Copyright (C) 1994-2000 by Bradford Appleton. All rights reserved.
-# This file is part of "PodParser". PodParser is free software;
-# you can redistribute it and/or modify it under the same terms
-# as Perl itself.
-#############################################################################
-
-package Pod::Checker;
-use strict;
-
-use vars qw($VERSION @ISA @EXPORT %VALID_COMMANDS %VALID_SEQUENCES);
-$VERSION = '1.45'; ## Current version of this package
-require 5.005; ## requires this Perl version or later
-
-use Pod::ParseUtils; ## for hyperlinks and lists
-
-=head1 NAME
-
-Pod::Checker, podchecker() - check pod documents for syntax errors
-
-=head1 SYNOPSIS
-
- use Pod::Checker;
-
- $syntax_okay = podchecker($filepath, $outputpath, %options);
-
- my $checker = new Pod::Checker %options;
- $checker->parse_from_file($filepath, \*STDERR);
-
-=head1 OPTIONS/ARGUMENTS
-
-C<$filepath> is the input POD to read and C<$outputpath> is
-where to write POD syntax error messages. Either argument may be a scalar
-indicating a file-path, or else a reference to an open filehandle.
-If unspecified, the input-file it defaults to C<\*STDIN>, and
-the output-file defaults to C<\*STDERR>.
-
-=head2 podchecker()
-
-This function can take a hash of options:
-
-=over 4
-
-=item B<-warnings> =E<gt> I<val>
-
-Turn warnings on/off. I<val> is usually 1 for on, but higher values
-trigger additional warnings. See L<"Warnings">.
-
-=back
-
-=head1 DESCRIPTION
-
-B<podchecker> will perform syntax checking of Perl5 POD format documentation.
-
-Curious/ambitious users are welcome to propose additional features they wish
-to see in B<Pod::Checker> and B<podchecker> and verify that the checks are
-consistent with L<perlpod>.
-
-The following checks are currently performed:
-
-=over 4
-
-=item *
-
-Unknown '=xxxx' commands, unknown 'XE<lt>...E<gt>' interior-sequences,
-and unterminated interior sequences.
-
-=item *
-
-Check for proper balancing of C<=begin> and C<=end>. The contents of such
-a block are generally ignored, i.e. no syntax checks are performed.
-
-=item *
-
-Check for proper nesting and balancing of C<=over>, C<=item> and C<=back>.
-
-=item *
-
-Check for same nested interior-sequences (e.g.
-C<LE<lt>...LE<lt>...E<gt>...E<gt>>).
-
-=item *
-
-Check for malformed or non-existing entities C<EE<lt>...E<gt>>.
-
-=item *
-
-Check for correct syntax of hyperlinks C<LE<lt>...E<gt>>. See L<perlpod>
-for details.
-
-=item *
-
-Check for unresolved document-internal links. This check may also reveal
-misspelled links that seem to be internal links but should be links
-to something else.
-
-=back
-
-=head1 DIAGNOSTICS
-
-=head2 Errors
-
-=over 4
-
-=item * empty =headn
-
-A heading (C<=head1> or C<=head2>) without any text? That ain't no
-heading!
-
-=item * =over on line I<N> without closing =back
-
-The C<=over> command does not have a corresponding C<=back> before the
-next heading (C<=head1> or C<=head2>) or the end of the file.
-
-=item * =item without previous =over
-
-=item * =back without previous =over
-
-An C<=item> or C<=back> command has been found outside a
-C<=over>/C<=back> block.
-
-=item * No argument for =begin
-
-A C<=begin> command was found that is not followed by the formatter
-specification.
-
-=item * =end without =begin
-
-A standalone C<=end> command was found.
-
-=item * Nested =begin's
-
-There were at least two consecutive C<=begin> commands without
-the corresponding C<=end>. Only one C<=begin> may be active at
-a time.
-
-=item * =for without formatter specification
-
-There is no specification of the formatter after the C<=for> command.
-
-=item * unresolved internal link I<NAME>
-
-The given link to I<NAME> does not have a matching node in the current
-POD. This also happened when a single word node name is not enclosed in
-C<"">.
-
-=item * Unknown command "I<CMD>"
-
-An invalid POD command has been found. Valid are C<=head1>, C<=head2>,
-C<=head3>, C<=head4>, C<=over>, C<=item>, C<=back>, C<=begin>, C<=end>,
-C<=for>, C<=pod>, C<=cut>
-
-=item * Unknown interior-sequence "I<SEQ>"
-
-An invalid markup command has been encountered. Valid are:
-C<BE<lt>E<gt>>, C<CE<lt>E<gt>>, C<EE<lt>E<gt>>, C<FE<lt>E<gt>>,
-C<IE<lt>E<gt>>, C<LE<lt>E<gt>>, C<SE<lt>E<gt>>, C<XE<lt>E<gt>>,
-C<ZE<lt>E<gt>>
-
-=item * nested commands I<CMD>E<lt>...I<CMD>E<lt>...E<gt>...E<gt>
-
-Two nested identical markup commands have been found. Generally this
-does not make sense.
-
-=item * garbled entity I<STRING>
-
-The I<STRING> found cannot be interpreted as a character entity.
-
-=item * Entity number out of range
-
-An entity specified by number (dec, hex, oct) is out of range (1-255).
-
-=item * malformed link LE<lt>E<gt>
-
-The link found cannot be parsed because it does not conform to the
-syntax described in L<perlpod>.
-
-=item * nonempty ZE<lt>E<gt>
-
-The C<ZE<lt>E<gt>> sequence is supposed to be empty.
-
-=item * empty XE<lt>E<gt>
-
-The index entry specified contains nothing but whitespace.
-
-=item * Spurious text after =pod / =cut
-
-The commands C<=pod> and C<=cut> do not take any arguments.
-
-=item * Spurious character(s) after =back
-
-The C<=back> command does not take any arguments.
-
-=back
-
-=head2 Warnings
-
-These may not necessarily cause trouble, but indicate mediocre style.
-
-=over 4
-
-=item * multiple occurrence of link target I<name>
-
-The POD file has some C<=item> and/or C<=head> commands that have
-the same text. Potential hyperlinks to such a text cannot be unique then.
-This warning is printed only with warning level greater than one.
-
-=item * line containing nothing but whitespace in paragraph
-
-There is some whitespace on a seemingly empty line. POD is very sensitive
-to such things, so this is flagged. B<vi> users switch on the B<list>
-option to avoid this problem.
-
-=begin _disabled_
-
-=item * file does not start with =head
-
-The file starts with a different POD directive than head.
-This is most probably something you do not want.
-
-=end _disabled_
-
-=item * previous =item has no contents
-
-There is a list C<=item> right above the flagged line that has no
-text contents. You probably want to delete empty items.
-
-=item * preceding non-item paragraph(s)
-
-A list introduced by C<=over> starts with a text or verbatim paragraph,
-but continues with C<=item>s. Move the non-item paragraph out of the
-C<=over>/C<=back> block.
-
-=item * =item type mismatch (I<one> vs. I<two>)
-
-A list started with e.g. a bullet-like C<=item> and continued with a
-numbered one. This is obviously inconsistent. For most translators the
-type of the I<first> C<=item> determines the type of the list.
-
-=item * I<N> unescaped C<E<lt>E<gt>> in paragraph
-
-Angle brackets not written as C<E<lt>ltE<gt>> and C<E<lt>gtE<gt>>
-can potentially cause errors as they could be misinterpreted as
-markup commands. This is only printed when the -warnings level is
-greater than 1.
-
-=item * Unknown entity
-
-A character entity was found that does not belong to the standard
-ISO set or the POD specials C<verbar> and C<sol>.
-
-=item * No items in =over
-
-The list opened with C<=over> does not contain any items.
-
-=item * No argument for =item
-
-C<=item> without any parameters is deprecated. It should either be followed
-by C<*> to indicate an unordered list, by a number (optionally followed
-by a dot) to indicate an ordered (numbered) list or simple text for a
-definition list.
-
-=item * empty section in previous paragraph
-
-The previous section (introduced by a C<=head> command) does not contain
-any text. This usually indicates that something is missing. Note: A
-C<=head1> followed immediately by C<=head2> does not trigger this warning.
-
-=item * Verbatim paragraph in NAME section
-
-The NAME section (C<=head1 NAME>) should consist of a single paragraph
-with the script/module name, followed by a dash `-' and a very short
-description of what the thing is good for.
-
-=item * =headI<n> without preceding higher level
-
-For example if there is a C<=head2> in the POD file prior to a
-C<=head1>.
-
-=back
-
-=head2 Hyperlinks
-
-There are some warnings with respect to malformed hyperlinks:
-
-=over 4
-
-=item * ignoring leading/trailing whitespace in link
-
-There is whitespace at the beginning or the end of the contents of
-LE<lt>...E<gt>.
-
-=item * (section) in '$page' deprecated
-
-There is a section detected in the page name of LE<lt>...E<gt>, e.g.
-C<LE<lt>passwd(2)E<gt>>. POD hyperlinks may point to POD documents only.
-Please write C<CE<lt>passwd(2)E<gt>> instead. Some formatters are able
-to expand this to appropriate code. For links to (builtin) functions,
-please say C<LE<lt>perlfunc/mkdirE<gt>>, without ().
-
-=item * alternative text/node '%s' contains non-escaped | or /
-
-The characters C<|> and C</> are special in the LE<lt>...E<gt> context.
-Although the hyperlink parser does its best to determine which "/" is
-text and which is a delimiter in case of doubt, one ought to escape
-these literal characters like this:
-
- / E<sol>
- | E<verbar>
-
-=back
-
-=head1 RETURN VALUE
-
-B<podchecker> returns the number of POD syntax errors found or -1 if
-there were no POD commands at all found in the file.
-
-=head1 EXAMPLES
-
-See L</SYNOPSIS>
-
-=head1 INTERFACE
-
-While checking, this module collects document properties, e.g. the nodes
-for hyperlinks (C<=headX>, C<=item>) and index entries (C<XE<lt>E<gt>>).
-POD translators can use this feature to syntax-check and get the nodes in
-a first pass before actually starting to convert. This is expensive in terms
-of execution time, but allows for very robust conversions.
-
-Since PodParser-1.24 the B<Pod::Checker> module uses only the B<poderror>
-method to print errors and warnings. The summary output (e.g.
-"Pod syntax OK") has been dropped from the module and has been included in
-B<podchecker> (the script). This allows users of B<Pod::Checker> to
-control completely the output behavior. Users of B<podchecker> (the script)
-get the well-known behavior.
-
-=cut
-
-#############################################################################
-
-#use diagnostics;
-use Carp qw(croak);
-use Exporter;
-use Pod::Parser;
-
-@ISA = qw(Pod::Parser);
-@EXPORT = qw(&podchecker);
-
-my %VALID_COMMANDS = (
- 'pod' => 1,
- 'cut' => 1,
- 'head1' => 1,
- 'head2' => 1,
- 'head3' => 1,
- 'head4' => 1,
- 'over' => 1,
- 'back' => 1,
- 'item' => 1,
- 'for' => 1,
- 'begin' => 1,
- 'end' => 1,
- 'encoding' => 1,
-);
-
-my %VALID_SEQUENCES = (
- 'I' => 1,
- 'B' => 1,
- 'S' => 1,
- 'C' => 1,
- 'L' => 1,
- 'F' => 1,
- 'X' => 1,
- 'Z' => 1,
- 'E' => 1,
-);
-
-# stolen from HTML::Entities
-my %ENTITIES = (
- # Some normal chars that have special meaning in SGML context
- amp => '&', # ampersand
-'gt' => '>', # greater than
-'lt' => '<', # less than
- quot => '"', # double quote
-
- # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML
- AElig => 'Æ', # capital AE diphthong (ligature)
- Aacute => 'Á', # capital A, acute accent
- Acirc => 'Â', # capital A, circumflex accent
- Agrave => 'À', # capital A, grave accent
- Aring => 'Å', # capital A, ring
- Atilde => 'Ã', # capital A, tilde
- Auml => 'Ä', # capital A, dieresis or umlaut mark
- Ccedil => 'Ç', # capital C, cedilla
- ETH => 'Ð', # capital Eth, Icelandic
- Eacute => 'É', # capital E, acute accent
- Ecirc => 'Ê', # capital E, circumflex accent
- Egrave => 'È', # capital E, grave accent
- Euml => 'Ë', # capital E, dieresis or umlaut mark
- Iacute => 'Í', # capital I, acute accent
- Icirc => 'Î', # capital I, circumflex accent
- Igrave => 'Ì', # capital I, grave accent
- Iuml => 'Ï', # capital I, dieresis or umlaut mark
- Ntilde => 'Ñ', # capital N, tilde
- Oacute => 'Ó', # capital O, acute accent
- Ocirc => 'Ô', # capital O, circumflex accent
- Ograve => 'Ò', # capital O, grave accent
- Oslash => 'Ø', # capital O, slash
- Otilde => 'Õ', # capital O, tilde
- Ouml => 'Ö', # capital O, dieresis or umlaut mark
- THORN => 'Þ', # capital THORN, Icelandic
- Uacute => 'Ú', # capital U, acute accent
- Ucirc => 'Û', # capital U, circumflex accent
- Ugrave => 'Ù', # capital U, grave accent
- Uuml => 'Ü', # capital U, dieresis or umlaut mark
- Yacute => 'Ý', # capital Y, acute accent
- aacute => 'á', # small a, acute accent
- acirc => 'â', # small a, circumflex accent
- aelig => 'æ', # small ae diphthong (ligature)
- agrave => 'à', # small a, grave accent
- aring => 'å', # small a, ring
- atilde => 'ã', # small a, tilde
- auml => 'ä', # small a, dieresis or umlaut mark
- ccedil => 'ç', # small c, cedilla
- eacute => 'é', # small e, acute accent
- ecirc => 'ê', # small e, circumflex accent
- egrave => 'è', # small e, grave accent
- eth => 'ð', # small eth, Icelandic
- euml => 'ë', # small e, dieresis or umlaut mark
- iacute => 'í', # small i, acute accent
- icirc => 'î', # small i, circumflex accent
- igrave => 'ì', # small i, grave accent
- iuml => 'ï', # small i, dieresis or umlaut mark
- ntilde => 'ñ', # small n, tilde
- oacute => 'ó', # small o, acute accent
- ocirc => 'ô', # small o, circumflex accent
- ograve => 'ò', # small o, grave accent
- oslash => 'ø', # small o, slash
- otilde => 'õ', # small o, tilde
- ouml => 'ö', # small o, dieresis or umlaut mark
- szlig => 'ß', # small sharp s, German (sz ligature)
- thorn => 'þ', # small thorn, Icelandic
- uacute => 'ú', # small u, acute accent
- ucirc => 'û', # small u, circumflex accent
- ugrave => 'ù', # small u, grave accent
- uuml => 'ü', # small u, dieresis or umlaut mark
- yacute => 'ý', # small y, acute accent
- yuml => 'ÿ', # small y, dieresis or umlaut mark
-
- # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96)
- copy => '©', # copyright sign
- reg => '®', # registered sign
- nbsp => "\240", # non breaking space
-
- # Additional ISO-8859/1 entities listed in rfc1866 (section 14)
- iexcl => '¡',
- cent => '¢',
- pound => '£',
- curren => '¤',
- yen => '¥',
- brvbar => '¦',
- sect => '§',
- uml => '¨',
- ordf => 'ª',
- laquo => '«',
-'not' => '¬', # not is a keyword in perl
- shy => '­',
- macr => '¯',
- deg => '°',
- plusmn => '±',
- sup1 => '¹',
- sup2 => '²',
- sup3 => '³',
- acute => '´',
- micro => 'µ',
- para => '¶',
- middot => '·',
- cedil => '¸',
- ordm => 'º',
- raquo => '»',
- frac14 => '¼',
- frac12 => '½',
- frac34 => '¾',
- iquest => '¿',
-'times' => '×', # times is a keyword in perl
- divide => '÷',
-
-# some POD special entities
- verbar => '|',
- sol => '/'
-);
-
-##---------------------------------------------------------------------------
-
-##---------------------------------
-## Function definitions begin here
-##---------------------------------
-
-sub podchecker {
- my ($infile, $outfile, %options) = @_;
- local $_;
-
- ## Set defaults
- $infile ||= \*STDIN;
- $outfile ||= \*STDERR;
-
- ## Now create a pod checker
- my $checker = new Pod::Checker(%options);
-
- ## Now check the pod document for errors
- $checker->parse_from_file($infile, $outfile);
-
- ## Return the number of errors found
- return $checker->num_errors();
-}
-
-##---------------------------------------------------------------------------
-
-##-------------------------------
-## Method definitions begin here
-##-------------------------------
-
-##################################
-
-=over 4
-
-=item C<Pod::Checker-E<gt>new( %options )>
-
-Return a reference to a new Pod::Checker object that inherits from
-Pod::Parser and is used for calling the required methods later. The
-following options are recognized:
-
-C<-warnings =E<gt> num>
- Print warnings if C<num> is true. The higher the value of C<num>,
-the more warnings are printed. Currently there are only levels 1 and 2.
-
-C<-quiet =E<gt> num>
- If C<num> is true, do not print any errors/warnings. This is useful
-when Pod::Checker is used to munge POD code into plain text from within
-POD formatters.
-
-=cut
-
-## sub new {
-## my $this = shift;
-## my $class = ref($this) || $this;
-## my %params = @_;
-## my $self = {%params};
-## bless $self, $class;
-## $self->initialize();
-## return $self;
-## }
-
-sub initialize {
- my $self = shift;
- ## Initialize number of errors, and setup an error function to
- ## increment this number and then print to the designated output.
- $self->{_NUM_ERRORS} = 0;
- $self->{_NUM_WARNINGS} = 0;
- $self->{-quiet} ||= 0;
- # set the error handling subroutine
- $self->errorsub($self->{-quiet} ? sub { 1; } : 'poderror');
- $self->{_commands} = 0; # total number of POD commands encountered
- $self->{_list_stack} = []; # stack for nested lists
- $self->{_have_begin} = ''; # stores =begin
- $self->{_links} = []; # stack for internal hyperlinks
- $self->{_nodes} = []; # stack for =head/=item nodes
- $self->{_index} = []; # text in X<>
- # print warnings?
- $self->{-warnings} = 1 unless(defined $self->{-warnings});
- $self->{_current_head1} = ''; # the current =head1 block
- $self->parseopts(-process_cut_cmd => 1, -warnings => $self->{-warnings});
-}
-
-##################################
-
-=item C<$checker-E<gt>poderror( @args )>
-
-=item C<$checker-E<gt>poderror( {%opts}, @args )>
-
-Internal method for printing errors and warnings. If no options are
-given, simply prints "@_". The following options are recognized and used
-to form the output:
-
- -msg
-
-A message to print prior to C<@args>.
-
- -line
-
-The line number the error occurred in.
-
- -file
-
-The file (name) the error occurred in.
-
- -severity
-
-The error level, should be 'WARNING' or 'ERROR'.
-
-=cut
-
-# Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args )
-sub poderror {
- my $self = shift;
- my %opts = (ref $_[0]) ? %{shift()} : ();
-
- ## Retrieve options
- chomp( my $msg = ($opts{-msg} || '')."@_" );
- my $line = (exists $opts{-line}) ? " at line $opts{-line}" : '';
- my $file = (exists $opts{-file}) ? " in file $opts{-file}" : '';
- unless (exists $opts{-severity}) {
- ## See if can find severity in message prefix
- $opts{-severity} = $1 if ( $msg =~ s/^\**\s*([A-Z]{3,}):\s+// );
- }
- my $severity = (exists $opts{-severity}) ? "*** $opts{-severity}: " : '';
-
- ## Increment error count and print message "
- ++($self->{_NUM_ERRORS})
- if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR'));
- ++($self->{_NUM_WARNINGS})
- if(!%opts || ($opts{-severity} && $opts{-severity} eq 'WARNING'));
- unless($self->{-quiet}) {
- my $out_fh = $self->output_handle() || \*STDERR;
- print $out_fh ($severity, $msg, $line, $file, "\n")
- if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING');
- }
-}
-
-##################################
-
-=item C<$checker-E<gt>num_errors()>
-
-Set (if argument specified) and retrieve the number of errors found.
-
-=cut
-
-sub num_errors {
- return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS};
-}
-
-##################################
-
-=item C<$checker-E<gt>num_warnings()>
-
-Set (if argument specified) and retrieve the number of warnings found.
-
-=cut
-
-sub num_warnings {
- return (@_ > 1) ? ($_[0]->{_NUM_WARNINGS} = $_[1]) : $_[0]->{_NUM_WARNINGS};
-}
-
-##################################
-
-=item C<$checker-E<gt>name()>
-
-Set (if argument specified) and retrieve the canonical name of POD as
-found in the C<=head1 NAME> section.
-
-=cut
-
-sub name {
- return (@_ > 1 && $_[1]) ?
- ($_[0]->{-name} = $_[1]) : $_[0]->{-name};
-}
-
-##################################
-
-=item C<$checker-E<gt>node()>
-
-Add (if argument specified) and retrieve the nodes (as defined by C<=headX>
-and C<=item>) of the current POD. The nodes are returned in the order of
-their occurrence. They consist of plain text, each piece of whitespace is
-collapsed to a single blank.
-
-=cut
-
-sub node {
- my ($self,$text) = @_;
- if(defined $text) {
- $text =~ s/\s+$//s; # strip trailing whitespace
- $text =~ s/\s+/ /gs; # collapse whitespace
- # add node, order important!
- push(@{$self->{_nodes}}, $text);
- # keep also a uniqueness counter
- $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s);
- return $text;
- }
- @{$self->{_nodes}};
-}
-
-##################################
-
-=item C<$checker-E<gt>idx()>
-
-Add (if argument specified) and retrieve the index entries (as defined by
-C<XE<lt>E<gt>>) of the current POD. They consist of plain text, each piece
-of whitespace is collapsed to a single blank.
-
-=cut
-
-# set/return index entries of current POD
-sub idx {
- my ($self,$text) = @_;
- if(defined $text) {
- $text =~ s/\s+$//s; # strip trailing whitespace
- $text =~ s/\s+/ /gs; # collapse whitespace
- # add node, order important!
- push(@{$self->{_index}}, $text);
- # keep also a uniqueness counter
- $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s);
- return $text;
- }
- @{$self->{_index}};
-}
-
-##################################
-
-=item C<$checker-E<gt>hyperlink()>
-
-Add (if argument specified) and retrieve the hyperlinks (as defined by
-C<LE<lt>E<gt>>) of the current POD. They consist of a 2-item array: line
-number and C<Pod::Hyperlink> object.
-
-=back
-
-=cut
-
-# set/return hyperlinks of the current POD
-sub hyperlink {
- my $self = shift;
- if($_[0]) {
- push(@{$self->{_links}}, $_[0]);
- return $_[0];
- }
- @{$self->{_links}};
-}
-
-## overrides for Pod::Parser
-
-sub end_pod {
- ## Do some final checks and
- ## print the number of errors found
- my $self = shift;
- my $infile = $self->input_file();
-
- if(@{$self->{_list_stack}}) {
- my $list;
- while(($list = $self->_close_list('EOF',$infile)) &&
- $list->indent() ne 'auto') {
- $self->poderror({ -line => 'EOF', -file => $infile,
- -severity => 'ERROR', -msg => '=over on line ' .
- $list->start() . ' without closing =back' });
- }
- }
-
- # check validity of document internal hyperlinks
- # first build the node names from the paragraph text
- my %nodes;
- foreach($self->node()) {
- $nodes{$_} = 1;
- if(/^(\S+)\s+\S/) {
- # we have more than one word. Use the first as a node, too.
- # This is used heavily in perlfunc.pod
- $nodes{$1} ||= 2; # derived node
- }
- }
- foreach($self->idx()) {
- $nodes{$_} = 3; # index node
- }
- foreach($self->hyperlink()) {
- my ($line,$link) = @$_;
- # _TODO_ what if there is a link to the page itself by the name,
- # e.g. in Tk::Pod : L<Tk::Pod/"DESCRIPTION">
- if($link->node() && !$link->page() && $link->type() ne 'hyperlink') {
- my $node = $self->_check_ptree($self->parse_text($link->node(),
- $line), $line, $infile, 'L');
- if($node && !$nodes{$node}) {
- $self->poderror({ -line => $line || '', -file => $infile,
- -severity => 'ERROR',
- -msg => "unresolved internal link '$node'"});
- }
- }
- }
-
- # check the internal nodes for uniqueness. This pertains to
- # =headX, =item and X<...>
- if($self->{-warnings} && $self->{-warnings}>1) {
- foreach(grep($self->{_unique_nodes}->{$_} > 1,
- keys %{$self->{_unique_nodes}})) {
- $self->poderror({ -line => '-', -file => $infile,
- -severity => 'WARNING',
- -msg => "multiple occurrence of link target '$_'"});
- }
- }
-
- # no POD found here
- $self->num_errors(-1) if($self->{_commands} == 0);
-}
-
-# check a POD command directive
-sub command {
- my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_;
- my ($file, $line) = $pod_para->file_line;
- ## Check the command syntax
- my $arg; # this will hold the command argument
- if (! $VALID_COMMANDS{$cmd}) {
- $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR',
- -msg => "Unknown command '$cmd'" });
- }
- else { # found a valid command
- $self->{_commands}++; # delete this line if below is enabled again
-
- ##### following check disabled due to strong request
- #if(!$self->{_commands}++ && $cmd !~ /^head/) {
- # $self->poderror({ -line => $line, -file => $file,
- # -severity => 'WARNING',
- # -msg => "file does not start with =head" });
- #}
-
- # check syntax of particular command
- if($cmd eq 'over') {
- # check for argument
- $arg = $self->interpolate_and_check($paragraph, $line,$file);
- my $indent = 4; # default
- if($arg && $arg =~ /^\s*(\d+)\s*$/) {
- $indent = $1;
- }
- # start a new list
- $self->_open_list($indent,$line,$file);
- }
- elsif($cmd eq 'item') {
- # are we in a list?
- unless(@{$self->{_list_stack}}) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => '=item without previous =over' });
- # auto-open in case we encounter many more
- $self->_open_list('auto',$line,$file);
- }
- my $list = $self->{_list_stack}->[0];
- # check whether the previous item had some contents
- if(defined $self->{_list_item_contents} &&
- $self->{_list_item_contents} == 0) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => 'previous =item has no contents' });
- }
- if($list->{_has_par}) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => 'preceding non-item paragraph(s)' });
- delete $list->{_has_par};
- }
- # check for argument
- $arg = $self->interpolate_and_check($paragraph, $line, $file);
- if($arg && $arg =~ /(\S+)/) {
- $arg =~ s/[\s\n]+$//;
- my $type;
- if($arg =~ /^[*]\s*(\S*.*)/) {
- $type = 'bullet';
- $self->{_list_item_contents} = $1 ? 1 : 0;
- $arg = $1;
- }
- elsif($arg =~ /^\d+\.?\s+(\S*)/) {
- $type = 'number';
- $self->{_list_item_contents} = $1 ? 1 : 0;
- $arg = $1;
- }
- else {
- $type = 'definition';
- $self->{_list_item_contents} = 1;
- }
- my $first = $list->type();
- if($first && $first ne $type) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => "=item type mismatch ('$first' vs. '$type')"});
- }
- else { # first item
- $list->type($type);
- }
- }
- else {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => 'No argument for =item' });
- $arg = ' '; # empty
- $self->{_list_item_contents} = 0;
- }
- # add this item
- $list->item($arg);
- # remember this node
- $self->node($arg);
- }
- elsif($cmd eq 'back') {
- # check if we have an open list
- unless(@{$self->{_list_stack}}) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => '=back without previous =over' });
- }
- else {
- # check for spurious characters
- $arg = $self->interpolate_and_check($paragraph, $line,$file);
- if($arg && $arg =~ /\S/) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => 'Spurious character(s) after =back' });
- }
- # close list
- my $list = $self->_close_list($line,$file);
- # check for empty lists
- if(!$list->item() && $self->{-warnings}) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => 'No items in =over (at line ' .
- $list->start() . ') / =back list'});
- }
- }
- }
- elsif($cmd =~ /^head(\d+)/) {
- my $hnum = $1;
- $self->{"_have_head_$hnum"}++; # count head types
- if($hnum > 1 && !$self->{'_have_head_'.($hnum -1)}) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => "=head$hnum without preceding higher level"});
- }
- # check whether the previous =head section had some contents
- if(defined $self->{_commands_in_head} &&
- $self->{_commands_in_head} == 0 &&
- defined $self->{_last_head} &&
- $self->{_last_head} >= $hnum) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => 'empty section in previous paragraph'});
- }
- $self->{_commands_in_head} = -1;
- $self->{_last_head} = $hnum;
- # check if there is an open list
- if(@{$self->{_list_stack}}) {
- my $list;
- while(($list = $self->_close_list($line,$file)) &&
- $list->indent() ne 'auto') {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => '=over on line '. $list->start() .
- " without closing =back (at $cmd)" });
- }
- }
- # remember this node
- $arg = $self->interpolate_and_check($paragraph, $line,$file);
- $arg =~ s/[\s\n]+$//s;
- $self->node($arg);
- unless(length($arg)) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => "empty =$cmd"});
- }
- if($cmd eq 'head1') {
- $self->{_current_head1} = $arg;
- } else {
- $self->{_current_head1} = '';
- }
- }
- elsif($cmd eq 'begin') {
- if($self->{_have_begin}) {
- # already have a begin
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => q{Nested =begin's (first at line } .
- $self->{_have_begin} . ')'});
- }
- else {
- # check for argument
- $arg = $self->interpolate_and_check($paragraph, $line,$file);
- unless($arg && $arg =~ /(\S+)/) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => 'No argument for =begin'});
- }
- # remember the =begin
- $self->{_have_begin} = "$line:$1";
- }
- }
- elsif($cmd eq 'end') {
- if($self->{_have_begin}) {
- # close the existing =begin
- $self->{_have_begin} = '';
- # check for spurious characters
- $arg = $self->interpolate_and_check($paragraph, $line,$file);
- # the closing argument is optional
- #if($arg && $arg =~ /\S/) {
- # $self->poderror({ -line => $line, -file => $file,
- # -severity => 'WARNING',
- # -msg => "Spurious character(s) after =end" });
- #}
- }
- else {
- # don't have a matching =begin
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => '=end without =begin' });
- }
- }
- elsif($cmd eq 'for') {
- unless($paragraph =~ /\s*(\S+)\s*/) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => '=for without formatter specification' });
- }
- $arg = ''; # do not expand paragraph below
- }
- elsif($cmd =~ /^(pod|cut)$/) {
- # check for argument
- $arg = $self->interpolate_and_check($paragraph, $line,$file);
- if($arg && $arg =~ /(\S+)/) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => "Spurious text after =$cmd"});
- }
- }
- $self->{_commands_in_head}++;
- ## Check the interior sequences in the command-text
- $self->interpolate_and_check($paragraph, $line,$file)
- unless(defined $arg);
- }
-}
-
-sub _open_list
-{
- my ($self,$indent,$line,$file) = @_;
- my $list = Pod::List->new(
- -indent => $indent,
- -start => $line,
- -file => $file);
- unshift(@{$self->{_list_stack}}, $list);
- undef $self->{_list_item_contents};
- $list;
-}
-
-sub _close_list
-{
- my ($self,$line,$file) = @_;
- my $list = shift(@{$self->{_list_stack}});
- if(defined $self->{_list_item_contents} &&
- $self->{_list_item_contents} == 0) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => 'previous =item has no contents' });
- }
- undef $self->{_list_item_contents};
- $list;
-}
-
-# process a block of some text
-sub interpolate_and_check {
- my ($self, $paragraph, $line, $file) = @_;
- ## Check the interior sequences in the command-text
- # and return the text
- $self->_check_ptree(
- $self->parse_text($paragraph,$line), $line, $file, '');
-}
-
-sub _check_ptree {
- my ($self,$ptree,$line,$file,$nestlist) = @_;
- local($_);
- my $text = '';
- # process each node in the parse tree
- foreach(@$ptree) {
- # regular text chunk
- unless(ref) {
- # count the unescaped angle brackets
- # complain only when warning level is greater than 1
- if($self->{-warnings} && $self->{-warnings}>1) {
- my $count;
- if($count = tr/<>/<>/) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => "$count unescaped <> in paragraph" });
- }
- }
- $text .= $_;
- next;
- }
- # have an interior sequence
- my $cmd = $_->cmd_name();
- my $contents = $_->parse_tree();
- ($file,$line) = $_->file_line();
- # check for valid tag
- if (! $VALID_SEQUENCES{$cmd}) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => qq(Unknown interior-sequence '$cmd')});
- # expand it anyway
- $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
- next;
- }
- if($nestlist =~ /$cmd/) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => "nested commands $cmd<...$cmd<...>...>"});
- # _TODO_ should we add the contents anyway?
- # expand it anyway, see below
- }
- if($cmd eq 'E') {
- # preserve entities
- if(@$contents > 1 || ref $$contents[0] || $$contents[0] !~ /^\w+$/) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => 'garbled entity ' . $_->raw_text()});
- next;
- }
- my $ent = $$contents[0];
- my $val;
- if($ent =~ /^0x[0-9a-f]+$/i) {
- # hexadec entity
- $val = hex($ent);
- }
- elsif($ent =~ /^0\d+$/) {
- # octal
- $val = oct($ent);
- }
- elsif($ent =~ /^\d+$/) {
- # numeric entity
- $val = $ent;
- }
- if(defined $val) {
- if($val>0 && $val<256) {
- $text .= chr($val);
- }
- else {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => 'Entity number out of range ' . $_->raw_text()});
- }
- }
- elsif($ENTITIES{$ent}) {
- # known ISO entity
- $text .= $ENTITIES{$ent};
- }
- else {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => 'Unknown entity ' . $_->raw_text()});
- $text .= "E<$ent>";
- }
- }
- elsif($cmd eq 'L') {
- # try to parse the hyperlink
- my $link = Pod::Hyperlink->new($contents->raw_text());
- unless(defined $link) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => 'malformed link ' . $_->raw_text() ." : $@"});
- next;
- }
- $link->line($line); # remember line
- if($self->{-warnings}) {
- foreach my $w ($link->warning()) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => $w });
- }
- }
- # check the link text
- $text .= $self->_check_ptree($self->parse_text($link->text(),
- $line), $line, $file, "$nestlist$cmd");
- # remember link
- $self->hyperlink([$line,$link]);
- }
- elsif($cmd =~ /[BCFIS]/) {
- # add the guts
- $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
- }
- elsif($cmd eq 'Z') {
- if(length($contents->raw_text())) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => 'Nonempty Z<>'});
- }
- }
- elsif($cmd eq 'X') {
- my $idx = $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
- if($idx =~ /^\s*$/s) {
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
- -msg => 'Empty X<>'});
- }
- else {
- # remember this node
- $self->idx($idx);
- }
- }
- else {
- # not reached
- croak 'internal error';
- }
- }
- $text;
-}
-
-# process a block of verbatim text
-sub verbatim {
- ## Nothing particular to check
- my ($self, $paragraph, $line_num, $pod_para) = @_;
-
- $self->_preproc_par($paragraph);
-
- if($self->{_current_head1} eq 'NAME') {
- my ($file, $line) = $pod_para->file_line;
- $self->poderror({ -line => $line, -file => $file,
- -severity => 'WARNING',
- -msg => 'Verbatim paragraph in NAME section' });
- }
-}
-
-# process a block of regular text
-sub textblock {
- my ($self, $paragraph, $line_num, $pod_para) = @_;
- my ($file, $line) = $pod_para->file_line;
-
- $self->_preproc_par($paragraph);
-
- # skip this paragraph if in a =begin block
- unless($self->{_have_begin}) {
- my $block = $self->interpolate_and_check($paragraph, $line,$file);
- if($self->{_current_head1} eq 'NAME') {
- if($block =~ /^\s*(\S+?)\s*[,-]/) {
- # this is the canonical name
- $self->{-name} = $1 unless(defined $self->{-name});
- }
- }
- }
-}
-
-sub _preproc_par
-{
- my $self = shift;
- $_[0] =~ s/[\s\n]+$//;
- if($_[0]) {
- $self->{_commands_in_head}++;
- $self->{_list_item_contents}++ if(defined $self->{_list_item_contents});
- if(@{$self->{_list_stack}} && !$self->{_list_stack}->[0]->item()) {
- $self->{_list_stack}->[0]->{_has_par} = 1;
- }
- }
-}
-
-1;
-
-__END__
-
-=head1 AUTHOR
-
-Please report bugs using L<http://rt.cpan.org>.
-
-Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version),
-Marek Rouchal E<lt>marekr@cpan.orgE<gt>
-
-Based on code for B<Pod::Text::pod2text()> written by
-Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
-
-=cut
-
diff --git a/lib/Pod/Find.pm b/lib/Pod/Find.pm
deleted file mode 100644
index 8d1103b6a1..0000000000
--- a/lib/Pod/Find.pm
+++ /dev/null
@@ -1,535 +0,0 @@
-#############################################################################
-# Pod/Find.pm -- finds files containing POD documentation
-#
-# Author: Marek Rouchal <marekr@cpan.org>
-#
-# Copyright (C) 1999-2000 by Marek Rouchal (and borrowing code
-# from Nick Ing-Simmon's PodToHtml). All rights reserved.
-# This file is part of "PodParser". Pod::Find is free software;
-# you can redistribute it and/or modify it under the same terms
-# as Perl itself.
-#############################################################################
-
-package Pod::Find;
-use strict;
-
-use vars qw($VERSION);
-$VERSION = '1.35'; ## Current version of this package
-require 5.005; ## requires this Perl version or later
-use Carp;
-
-BEGIN {
- if ($] < 5.006) {
- require Symbol;
- import Symbol;
- }
-}
-
-#############################################################################
-
-=head1 NAME
-
-Pod::Find - find POD documents in directory trees
-
-=head1 SYNOPSIS
-
- use Pod::Find qw(pod_find simplify_name);
- my %pods = pod_find({ -verbose => 1, -inc => 1 });
- foreach(keys %pods) {
- print "found library POD `$pods{$_}' in $_\n";
- }
-
- print "podname=",simplify_name('a/b/c/mymodule.pod'),"\n";
-
- $location = pod_where( { -inc => 1 }, "Pod::Find" );
-
-=head1 DESCRIPTION
-
-B<Pod::Find> provides a set of functions to locate POD files. Note that
-no function is exported by default to avoid pollution of your namespace,
-so be sure to specify them in the B<use> statement if you need them:
-
- use Pod::Find qw(pod_find);
-
-From this version on the typical SCM (software configuration management)
-files/directories like RCS, CVS, SCCS, .svn are ignored.
-
-=cut
-
-#use diagnostics;
-use Exporter;
-use File::Spec;
-use File::Find;
-use Cwd;
-
-use vars qw(@ISA @EXPORT_OK $VERSION);
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(&pod_find &simplify_name &pod_where &contains_pod);
-
-# package global variables
-my $SIMPLIFY_RX;
-
-=head2 C<pod_find( { %opts } , @directories )>
-
-The function B<pod_find> searches for POD documents in a given set of
-files and/or directories. It returns a hash with the file names as keys
-and the POD name as value. The POD name is derived from the file name
-and its position in the directory tree.
-
-E.g. when searching in F<$HOME/perl5lib>, the file
-F<$HOME/perl5lib/MyModule.pm> would get the POD name I<MyModule>,
-whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be
-I<Myclass::Subclass>. The name information can be used for POD
-translators.
-
-Only text files containing at least one valid POD command are found.
-
-A warning is printed if more than one POD file with the same POD name
-is found, e.g. F<CPAN.pm> in different directories. This usually
-indicates duplicate occurrences of modules in the I<@INC> search path.
-
-B<OPTIONS> The first argument for B<pod_find> may be a hash reference
-with options. The rest are either directories that are searched
-recursively or files. The POD names of files are the plain basenames
-with any Perl-like extension (.pm, .pl, .pod) stripped.
-
-=over 4
-
-=item C<-verbose =E<gt> 1>
-
-Print progress information while scanning.
-
-=item C<-perl =E<gt> 1>
-
-Apply Perl-specific heuristics to find the correct PODs. This includes
-stripping Perl-like extensions, omitting subdirectories that are numeric
-but do I<not> match the current Perl interpreter's version id, suppressing
-F<site_perl> as a module hierarchy name etc.
-
-=item C<-script =E<gt> 1>
-
-Search for PODs in the current Perl interpreter's installation
-B<scriptdir>. This is taken from the local L<Config|Config> module.
-
-=item C<-inc =E<gt> 1>
-
-Search for PODs in the current Perl interpreter's I<@INC> paths. This
-automatically considers paths specified in the C<PERL5LIB> environment
-as this is included in I<@INC> by the Perl interpreter itself.
-
-=back
-
-=cut
-
-# return a hash of the POD files found
-# first argument may be a hashref (options),
-# rest is a list of directories to search recursively
-sub pod_find
-{
- my %opts;
- if(ref $_[0]) {
- %opts = %{shift()};
- }
-
- $opts{-verbose} ||= 0;
- $opts{-perl} ||= 0;
-
- my (@search) = @_;
-
- if($opts{-script}) {
- require Config;
- push(@search, $Config::Config{scriptdir})
- if -d $Config::Config{scriptdir};
- $opts{-perl} = 1;
- }
-
- if($opts{-inc}) {
- if ($^O eq 'MacOS') {
- # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
- my @new_INC = @INC;
- for (@new_INC) {
- if ( $_ eq '.' ) {
- $_ = ':';
- } elsif ( $_ =~ s{^((?:\.\./)+)}{':' x (length($1)/3)}e ) {
- $_ = ':'. $_;
- } else {
- $_ =~ s{^\./}{:};
- }
- }
- push(@search, grep($_ ne File::Spec->curdir, @new_INC));
- } else {
- push(@search, grep($_ ne File::Spec->curdir, @INC));
- }
-
- $opts{-perl} = 1;
- }
-
- if($opts{-perl}) {
- require Config;
- # this code simplifies the POD name for Perl modules:
- # * remove "site_perl"
- # * remove e.g. "i586-linux" (from 'archname')
- # * remove e.g. 5.00503
- # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod)
-
- # Mac OS:
- # * remove ":?site_perl:"
- # * remove :?pod: if followed by *.pod (e.g. in :pod:perlfunc.pod)
-
- if ($^O eq 'MacOS') {
- $SIMPLIFY_RX =
- qq!^(?i:\:?site_perl\:|\:?pod\:(?=.*?\\.pod\\z))*!;
- } else {
- $SIMPLIFY_RX =
- qq!^(?i:site(_perl)?/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!;
- }
- }
-
- my %dirs_visited;
- my %pods;
- my %names;
- my $pwd = cwd();
-
- foreach my $try (@search) {
- unless(File::Spec->file_name_is_absolute($try)) {
- # make path absolute
- $try = File::Spec->catfile($pwd,$try);
- }
- # simplify path
- # on VMS canonpath will vmsify:[the.path], but File::Find::find
- # wants /unixy/paths
- $try = File::Spec->canonpath($try) if ($^O ne 'VMS');
- $try = VMS::Filespec::unixify($try) if ($^O eq 'VMS');
- my $name;
- if(-f $try) {
- if($name = _check_and_extract_name($try, $opts{-verbose})) {
- _check_for_duplicates($try, $name, \%names, \%pods);
- }
- next;
- }
- my $root_rx = $^O eq 'MacOS' ? qq!^\Q$try\E! : qq!^\Q$try\E/!;
- File::Find::find( sub {
- my $item = $File::Find::name;
- if(-d) {
- if($item =~ m{/(?:RCS|CVS|SCCS|\.svn)$}) {
- $File::Find::prune = 1;
- return;
- }
- elsif($dirs_visited{$item}) {
- warn "Directory '$item' already seen, skipping.\n"
- if($opts{-verbose});
- $File::Find::prune = 1;
- return;
- }
- else {
- $dirs_visited{$item} = 1;
- }
- if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) {
- $File::Find::prune = 1;
- warn "Perl $] version mismatch on $_, skipping.\n"
- if($opts{-verbose});
- }
- return;
- }
- if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) {
- _check_for_duplicates($item, $name, \%names, \%pods);
- }
- }, $try); # end of File::Find::find
- }
- chdir $pwd;
- return %pods;
-}
-
-sub _check_for_duplicates {
- my ($file, $name, $names_ref, $pods_ref) = @_;
- if($$names_ref{$name}) {
- warn "Duplicate POD found (shadowing?): $name ($file)\n";
- warn ' Already seen in ',
- join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n";
- }
- else {
- $$names_ref{$name} = 1;
- }
- return $$pods_ref{$file} = $name;
-}
-
-sub _check_and_extract_name {
- my ($file, $verbose, $root_rx) = @_;
-
- # check extension or executable flag
- # this involves testing the .bat extension on Win32!
- unless(-f $file && -T $file && ($file =~ /\.(pod|pm|plx?)\z/i || -x $file )) {
- return;
- }
-
- return unless contains_pod($file,$verbose);
-
- # strip non-significant path components
- # TODO what happens on e.g. Win32?
- my $name = $file;
- if(defined $root_rx) {
- $name =~ s/$root_rx//s;
- $name =~ s/$SIMPLIFY_RX//s if(defined $SIMPLIFY_RX);
- }
- else {
- if ($^O eq 'MacOS') {
- $name =~ s/^.*://s;
- } else {
- $name =~ s{^.*/}{}s;
- }
- }
- _simplify($name);
- $name =~ s{/+}{::}g;
- if ($^O eq 'MacOS') {
- $name =~ s{:+}{::}g; # : -> ::
- } else {
- $name =~ s{/+}{::}g; # / -> ::
- }
- return $name;
-}
-
-=head2 C<simplify_name( $str )>
-
-The function B<simplify_name> is equivalent to B<basename>, but also
-strips Perl-like extensions (.pm, .pl, .pod) and extensions like
-F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively.
-
-=cut
-
-# basic simplification of the POD name:
-# basename & strip extension
-sub simplify_name {
- my ($str) = @_;
- # remove all path components
- if ($^O eq 'MacOS') {
- $str =~ s/^.*://s;
- } else {
- $str =~ s{^.*/}{}s;
- }
- _simplify($str);
- return $str;
-}
-
-# internal sub only
-sub _simplify {
- # strip Perl's own extensions
- $_[0] =~ s/\.(pod|pm|plx?)\z//i;
- # strip meaningless extensions on Win32 and OS/2
- $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /mswin|os2/i);
- # strip meaningless extensions on VMS
- $_[0] =~ s/\.(com)\z//i if($^O eq 'VMS');
-}
-
-# contribution from Tim Jenness <t.jenness@jach.hawaii.edu>
-
-=head2 C<pod_where( { %opts }, $pod )>
-
-Returns the location of a pod document given a search directory
-and a module (e.g. C<File::Find>) or script (e.g. C<perldoc>) name.
-
-Options:
-
-=over 4
-
-=item C<-inc =E<gt> 1>
-
-Search @INC for the pod and also the C<scriptdir> defined in the
-L<Config|Config> module.
-
-=item C<-dirs =E<gt> [ $dir1, $dir2, ... ]>
-
-Reference to an array of search directories. These are searched in order
-before looking in C<@INC> (if B<-inc>). Current directory is used if
-none are specified.
-
-=item C<-verbose =E<gt> 1>
-
-List directories as they are searched
-
-=back
-
-Returns the full path of the first occurrence to the file.
-Package names (eg 'A::B') are automatically converted to directory
-names in the selected directory. (eg on unix 'A::B' is converted to
-'A/B'). Additionally, '.pm', '.pl' and '.pod' are appended to the
-search automatically if required.
-
-A subdirectory F<pod/> is also checked if it exists in any of the given
-search directories. This ensures that e.g. L<perlfunc|perlfunc> is
-found.
-
-It is assumed that if a module name is supplied, that that name
-matches the file name. Pods are not opened to check for the 'NAME'
-entry.
-
-A check is made to make sure that the file that is found does
-contain some pod documentation.
-
-=cut
-
-sub pod_where {
-
- # default options
- my %options = (
- '-inc' => 0,
- '-verbose' => 0,
- '-dirs' => [ File::Spec->curdir ],
- );
-
- # Check for an options hash as first argument
- if (defined $_[0] && ref($_[0]) eq 'HASH') {
- my $opt = shift;
-
- # Merge default options with supplied options
- %options = (%options, %$opt);
- }
-
- # Check usage
- carp 'Usage: pod_where({options}, $pod)' unless (scalar(@_));
-
- # Read argument
- my $pod = shift;
-
- # Split on :: and then join the name together using File::Spec
- my @parts = split (/::/, $pod);
-
- # Get full directory list
- my @search_dirs = @{ $options{'-dirs'} };
-
- if ($options{'-inc'}) {
-
- require Config;
-
- # Add @INC
- if ($^O eq 'MacOS' && $options{'-inc'}) {
- # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
- my @new_INC = @INC;
- for (@new_INC) {
- if ( $_ eq '.' ) {
- $_ = ':';
- } elsif ( $_ =~ s{^((?:\.\./)+)}{':' x (length($1)/3)}e ) {
- $_ = ':'. $_;
- } else {
- $_ =~ s{^\./}{:};
- }
- }
- push (@search_dirs, @new_INC);
- } elsif ($options{'-inc'}) {
- push (@search_dirs, @INC);
- }
-
- # Add location of pod documentation for perl man pages (eg perlfunc)
- # This is a pod directory in the private install tree
- #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'},
- # 'pod');
- #push (@search_dirs, $perlpoddir)
- # if -d $perlpoddir;
-
- # Add location of binaries such as pod2text
- push (@search_dirs, $Config::Config{'scriptdir'})
- if -d $Config::Config{'scriptdir'};
- }
-
- warn 'Search path is: '.join(' ', @search_dirs)."\n"
- if $options{'-verbose'};
-
- # Loop over directories
- Dir: foreach my $dir ( @search_dirs ) {
-
- # Don't bother if can't find the directory
- if (-d $dir) {
- warn "Looking in directory $dir\n"
- if $options{'-verbose'};
-
- # Now concatenate this directory with the pod we are searching for
- my $fullname = File::Spec->catfile($dir, @parts);
- warn "Filename is now $fullname\n"
- if $options{'-verbose'};
-
- # Loop over possible extensions
- foreach my $ext ('', '.pod', '.pm', '.pl') {
- my $fullext = $fullname . $ext;
- if (-f $fullext &&
- contains_pod($fullext, $options{'-verbose'}) ) {
- warn "FOUND: $fullext\n" if $options{'-verbose'};
- return $fullext;
- }
- }
- } else {
- warn "Directory $dir does not exist\n"
- if $options{'-verbose'};
- next Dir;
- }
- # for some strange reason the path on MacOS/darwin/cygwin is
- # 'pods' not 'pod'
- # this could be the case also for other systems that
- # have a case-tolerant file system, but File::Spec
- # does not recognize 'darwin' yet. And cygwin also has "pods",
- # but is not case tolerant. Oh well...
- if((File::Spec->case_tolerant || $^O =~ /macos|darwin|cygwin/i)
- && -d File::Spec->catdir($dir,'pods')) {
- $dir = File::Spec->catdir($dir,'pods');
- redo Dir;
- }
- if(-d File::Spec->catdir($dir,'pod')) {
- $dir = File::Spec->catdir($dir,'pod');
- redo Dir;
- }
- }
- # No match;
- return;
-}
-
-=head2 C<contains_pod( $file , $verbose )>
-
-Returns true if the supplied filename (not POD module) contains some pod
-information.
-
-=cut
-
-sub contains_pod {
- my $file = shift;
- my $verbose = 0;
- $verbose = shift if @_;
-
- # check for one line of POD
- my $podfh;
- if ($] < 5.006) {
- $podfh = gensym();
- }
-
- unless(open($podfh,"<$file")) {
- warn "Error: $file is unreadable: $!\n";
- return;
- }
-
- local $/ = undef;
- my $pod = <$podfh>;
- close($podfh) || die "Error closing $file: $!\n";
- unless($pod =~ /^=(head\d|pod|over|item|cut)\b/m) {
- warn "No POD in $file, skipping.\n"
- if($verbose);
- return 0;
- }
-
- return 1;
-}
-
-=head1 AUTHOR
-
-Please report bugs using L<http://rt.cpan.org>.
-
-Marek Rouchal E<lt>marekr@cpan.orgE<gt>,
-heavily borrowing code from Nick Ing-Simmons' PodToHtml.
-
-Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt> provided
-C<pod_where> and C<contains_pod>.
-
-=head1 SEE ALSO
-
-L<Pod::Parser>, L<Pod::Checker>, L<perldoc>
-
-=cut
-
-1;
-
diff --git a/lib/Pod/InputObjects.pm b/lib/Pod/InputObjects.pm
deleted file mode 100644
index 13a86188bc..0000000000
--- a/lib/Pod/InputObjects.pm
+++ /dev/null
@@ -1,936 +0,0 @@
-#############################################################################
-# Pod/InputObjects.pm -- package which defines objects for input streams
-# and paragraphs and commands when parsing POD docs.
-#
-# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
-# This file is part of "PodParser". PodParser is free software;
-# you can redistribute it and/or modify it under the same terms
-# as Perl itself.
-#############################################################################
-
-package Pod::InputObjects;
-use strict;
-
-use vars qw($VERSION);
-$VERSION = '1.31'; ## Current version of this package
-require 5.005; ## requires this Perl version or later
-
-#############################################################################
-
-=head1 NAME
-
-Pod::InputObjects - objects representing POD input paragraphs, commands, etc.
-
-=head1 SYNOPSIS
-
- use Pod::InputObjects;
-
-=head1 REQUIRES
-
-perl5.004, Carp
-
-=head1 EXPORTS
-
-Nothing.
-
-=head1 DESCRIPTION
-
-This module defines some basic input objects used by B<Pod::Parser> when
-reading and parsing POD text from an input source. The following objects
-are defined:
-
-=over 4
-
-=begin __PRIVATE__
-
-=item package B<Pod::InputSource>
-
-An object corresponding to a source of POD input text. It is mostly a
-wrapper around a filehandle or C<IO::Handle>-type object (or anything
-that implements the C<getline()> method) which keeps track of some
-additional information relevant to the parsing of PODs.
-
-=end __PRIVATE__
-
-=item package B<Pod::Paragraph>
-
-An object corresponding to a paragraph of POD input text. It may be a
-plain paragraph, a verbatim paragraph, or a command paragraph (see
-L<perlpod>).
-
-=item package B<Pod::InteriorSequence>
-
-An object corresponding to an interior sequence command from the POD
-input text (see L<perlpod>).
-
-=item package B<Pod::ParseTree>
-
-An object corresponding to a tree of parsed POD text. Each "node" in
-a parse-tree (or I<ptree>) is either a text-string or a reference to
-a B<Pod::InteriorSequence> object. The nodes appear in the parse-tree
-in the order in which they were parsed from left-to-right.
-
-=back
-
-Each of these input objects are described in further detail in the
-sections which follow.
-
-=cut
-
-#############################################################################
-
-package Pod::InputSource;
-
-##---------------------------------------------------------------------------
-
-=begin __PRIVATE__
-
-=head1 B<Pod::InputSource>
-
-This object corresponds to an input source or stream of POD
-documentation. When parsing PODs, it is necessary to associate and store
-certain context information with each input source. All of this
-information is kept together with the stream itself in one of these
-C<Pod::InputSource> objects. Each such object is merely a wrapper around
-an C<IO::Handle> object of some kind (or at least something that
-implements the C<getline()> method). They have the following
-methods/attributes:
-
-=end __PRIVATE__
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=begin __PRIVATE__
-
-=head2 B<new()>
-
- my $pod_input1 = Pod::InputSource->new(-handle => $filehandle);
- my $pod_input2 = new Pod::InputSource(-handle => $filehandle,
- -name => $name);
- my $pod_input3 = new Pod::InputSource(-handle => \*STDIN);
- my $pod_input4 = Pod::InputSource->new(-handle => \*STDIN,
- -name => "(STDIN)");
-
-This is a class method that constructs a C<Pod::InputSource> object and
-returns a reference to the new input source object. It takes one or more
-keyword arguments in the form of a hash. The keyword C<-handle> is
-required and designates the corresponding input handle. The keyword
-C<-name> is optional and specifies the name associated with the input
-handle (typically a file name).
-
-=end __PRIVATE__
-
-=cut
-
-sub new {
- ## Determine if we were called via an object-ref or a classname
- my $this = shift;
- my $class = ref($this) || $this;
-
- ## Any remaining arguments are treated as initial values for the
- ## hash that is used to represent this object. Note that we default
- ## certain values by specifying them *before* the arguments passed.
- ## If they are in the argument list, they will override the defaults.
- my $self = { -name => '(unknown)',
- -handle => undef,
- -was_cutting => 0,
- @_ };
-
- ## Bless ourselves into the desired class and perform any initialization
- bless $self, $class;
- return $self;
-}
-
-##---------------------------------------------------------------------------
-
-=begin __PRIVATE__
-
-=head2 B<name()>
-
- my $filename = $pod_input->name();
- $pod_input->name($new_filename_to_use);
-
-This method gets/sets the name of the input source (usually a filename).
-If no argument is given, it returns a string containing the name of
-the input source; otherwise it sets the name of the input source to the
-contents of the given argument.
-
-=end __PRIVATE__
-
-=cut
-
-sub name {
- (@_ > 1) and $_[0]->{'-name'} = $_[1];
- return $_[0]->{'-name'};
-}
-
-## allow 'filename' as an alias for 'name'
-*filename = \&name;
-
-##---------------------------------------------------------------------------
-
-=begin __PRIVATE__
-
-=head2 B<handle()>
-
- my $handle = $pod_input->handle();
-
-Returns a reference to the handle object from which input is read (the
-one used to contructed this input source object).
-
-=end __PRIVATE__
-
-=cut
-
-sub handle {
- return $_[0]->{'-handle'};
-}
-
-##---------------------------------------------------------------------------
-
-=begin __PRIVATE__
-
-=head2 B<was_cutting()>
-
- print "Yes.\n" if ($pod_input->was_cutting());
-
-The value of the C<cutting> state (that the B<cutting()> method would
-have returned) immediately before any input was read from this input
-stream. After all input from this stream has been read, the C<cutting>
-state is restored to this value.
-
-=end __PRIVATE__
-
-=cut
-
-sub was_cutting {
- (@_ > 1) and $_[0]->{-was_cutting} = $_[1];
- return $_[0]->{-was_cutting};
-}
-
-##---------------------------------------------------------------------------
-
-#############################################################################
-
-package Pod::Paragraph;
-
-##---------------------------------------------------------------------------
-
-=head1 B<Pod::Paragraph>
-
-An object representing a paragraph of POD input text.
-It has the following methods/attributes:
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=head2 Pod::Paragraph-E<gt>B<new()>
-
- my $pod_para1 = Pod::Paragraph->new(-text => $text);
- my $pod_para2 = Pod::Paragraph->new(-name => $cmd,
- -text => $text);
- my $pod_para3 = new Pod::Paragraph(-text => $text);
- my $pod_para4 = new Pod::Paragraph(-name => $cmd,
- -text => $text);
- my $pod_para5 = Pod::Paragraph->new(-name => $cmd,
- -text => $text,
- -file => $filename,
- -line => $line_number);
-
-This is a class method that constructs a C<Pod::Paragraph> object and
-returns a reference to the new paragraph object. It may be given one or
-two keyword arguments. The C<-text> keyword indicates the corresponding
-text of the POD paragraph. The C<-name> keyword indicates the name of
-the corresponding POD command, such as C<head1> or C<item> (it should
-I<not> contain the C<=> prefix); this is needed only if the POD
-paragraph corresponds to a command paragraph. The C<-file> and C<-line>
-keywords indicate the filename and line number corresponding to the
-beginning of the paragraph
-
-=cut
-
-sub new {
- ## Determine if we were called via an object-ref or a classname
- my $this = shift;
- my $class = ref($this) || $this;
-
- ## Any remaining arguments are treated as initial values for the
- ## hash that is used to represent this object. Note that we default
- ## certain values by specifying them *before* the arguments passed.
- ## If they are in the argument list, they will override the defaults.
- my $self = {
- -name => undef,
- -text => (@_ == 1) ? shift : undef,
- -file => '<unknown-file>',
- -line => 0,
- -prefix => '=',
- -separator => ' ',
- -ptree => [],
- @_
- };
-
- ## Bless ourselves into the desired class and perform any initialization
- bless $self, $class;
- return $self;
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_para-E<gt>B<cmd_name()>
-
- my $para_cmd = $pod_para->cmd_name();
-
-If this paragraph is a command paragraph, then this method will return
-the name of the command (I<without> any leading C<=> prefix).
-
-=cut
-
-sub cmd_name {
- (@_ > 1) and $_[0]->{'-name'} = $_[1];
- return $_[0]->{'-name'};
-}
-
-## let name() be an alias for cmd_name()
-*name = \&cmd_name;
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_para-E<gt>B<text()>
-
- my $para_text = $pod_para->text();
-
-This method will return the corresponding text of the paragraph.
-
-=cut
-
-sub text {
- (@_ > 1) and $_[0]->{'-text'} = $_[1];
- return $_[0]->{'-text'};
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_para-E<gt>B<raw_text()>
-
- my $raw_pod_para = $pod_para->raw_text();
-
-This method will return the I<raw> text of the POD paragraph, exactly
-as it appeared in the input.
-
-=cut
-
-sub raw_text {
- return $_[0]->{'-text'} unless (defined $_[0]->{'-name'});
- return $_[0]->{'-prefix'} . $_[0]->{'-name'} .
- $_[0]->{'-separator'} . $_[0]->{'-text'};
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_para-E<gt>B<cmd_prefix()>
-
- my $prefix = $pod_para->cmd_prefix();
-
-If this paragraph is a command paragraph, then this method will return
-the prefix used to denote the command (which should be the string "="
-or "==").
-
-=cut
-
-sub cmd_prefix {
- return $_[0]->{'-prefix'};
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_para-E<gt>B<cmd_separator()>
-
- my $separator = $pod_para->cmd_separator();
-
-If this paragraph is a command paragraph, then this method will return
-the text used to separate the command name from the rest of the
-paragraph (if any).
-
-=cut
-
-sub cmd_separator {
- return $_[0]->{'-separator'};
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_para-E<gt>B<parse_tree()>
-
- my $ptree = $pod_parser->parse_text( $pod_para->text() );
- $pod_para->parse_tree( $ptree );
- $ptree = $pod_para->parse_tree();
-
-This method will get/set the corresponding parse-tree of the paragraph's text.
-
-=cut
-
-sub parse_tree {
- (@_ > 1) and $_[0]->{'-ptree'} = $_[1];
- return $_[0]->{'-ptree'};
-}
-
-## let ptree() be an alias for parse_tree()
-*ptree = \&parse_tree;
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_para-E<gt>B<file_line()>
-
- my ($filename, $line_number) = $pod_para->file_line();
- my $position = $pod_para->file_line();
-
-Returns the current filename and line number for the paragraph
-object. If called in a list context, it returns a list of two
-elements: first the filename, then the line number. If called in
-a scalar context, it returns a string containing the filename, followed
-by a colon (':'), followed by the line number.
-
-=cut
-
-sub file_line {
- my @loc = ($_[0]->{'-file'} || '<unknown-file>',
- $_[0]->{'-line'} || 0);
- return (wantarray) ? @loc : join(':', @loc);
-}
-
-##---------------------------------------------------------------------------
-
-#############################################################################
-
-package Pod::InteriorSequence;
-
-##---------------------------------------------------------------------------
-
-=head1 B<Pod::InteriorSequence>
-
-An object representing a POD interior sequence command.
-It has the following methods/attributes:
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=head2 Pod::InteriorSequence-E<gt>B<new()>
-
- my $pod_seq1 = Pod::InteriorSequence->new(-name => $cmd
- -ldelim => $delimiter);
- my $pod_seq2 = new Pod::InteriorSequence(-name => $cmd,
- -ldelim => $delimiter);
- my $pod_seq3 = new Pod::InteriorSequence(-name => $cmd,
- -ldelim => $delimiter,
- -file => $filename,
- -line => $line_number);
-
- my $pod_seq4 = new Pod::InteriorSequence(-name => $cmd, $ptree);
- my $pod_seq5 = new Pod::InteriorSequence($cmd, $ptree);
-
-This is a class method that constructs a C<Pod::InteriorSequence> object
-and returns a reference to the new interior sequence object. It should
-be given two keyword arguments. The C<-ldelim> keyword indicates the
-corresponding left-delimiter of the interior sequence (e.g. 'E<lt>').
-The C<-name> keyword indicates the name of the corresponding interior
-sequence command, such as C<I> or C<B> or C<C>. The C<-file> and
-C<-line> keywords indicate the filename and line number corresponding
-to the beginning of the interior sequence. If the C<$ptree> argument is
-given, it must be the last argument, and it must be either string, or
-else an array-ref suitable for passing to B<Pod::ParseTree::new> (or
-it may be a reference to a Pod::ParseTree object).
-
-=cut
-
-sub new {
- ## Determine if we were called via an object-ref or a classname
- my $this = shift;
- my $class = ref($this) || $this;
-
- ## See if first argument has no keyword
- if (((@_ <= 2) or (@_ % 2)) and $_[0] !~ /^-\w/) {
- ## Yup - need an implicit '-name' before first parameter
- unshift @_, '-name';
- }
-
- ## See if odd number of args
- if ((@_ % 2) != 0) {
- ## Yup - need an implicit '-ptree' before the last parameter
- splice @_, $#_, 0, '-ptree';
- }
-
- ## Any remaining arguments are treated as initial values for the
- ## hash that is used to represent this object. Note that we default
- ## certain values by specifying them *before* the arguments passed.
- ## If they are in the argument list, they will override the defaults.
- my $self = {
- -name => (@_ == 1) ? $_[0] : undef,
- -file => '<unknown-file>',
- -line => 0,
- -ldelim => '<',
- -rdelim => '>',
- @_
- };
-
- ## Initialize contents if they havent been already
- my $ptree = $self->{'-ptree'} || new Pod::ParseTree();
- if ( ref $ptree =~ /^(ARRAY)?$/ ) {
- ## We have an array-ref, or a normal scalar. Pass it as an
- ## an argument to the ptree-constructor
- $ptree = new Pod::ParseTree($1 ? [$ptree] : $ptree);
- }
- $self->{'-ptree'} = $ptree;
-
- ## Bless ourselves into the desired class and perform any initialization
- bless $self, $class;
- return $self;
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<cmd_name()>
-
- my $seq_cmd = $pod_seq->cmd_name();
-
-The name of the interior sequence command.
-
-=cut
-
-sub cmd_name {
- (@_ > 1) and $_[0]->{'-name'} = $_[1];
- return $_[0]->{'-name'};
-}
-
-## let name() be an alias for cmd_name()
-*name = \&cmd_name;
-
-##---------------------------------------------------------------------------
-
-## Private subroutine to set the parent pointer of all the given
-## children that are interior-sequences to be $self
-
-sub _set_child2parent_links {
- my ($self, @children) = @_;
- ## Make sure any sequences know who their parent is
- for (@children) {
- next unless (length and ref and ref ne 'SCALAR');
- if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or
- UNIVERSAL::can($_, 'nested'))
- {
- $_->nested($self);
- }
- }
-}
-
-## Private subroutine to unset child->parent links
-
-sub _unset_child2parent_links {
- my $self = shift;
- $self->{'-parent_sequence'} = undef;
- my $ptree = $self->{'-ptree'};
- for (@$ptree) {
- next unless (length and ref and ref ne 'SCALAR');
- $_->_unset_child2parent_links()
- if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
- }
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<prepend()>
-
- $pod_seq->prepend($text);
- $pod_seq1->prepend($pod_seq2);
-
-Prepends the given string or parse-tree or sequence object to the parse-tree
-of this interior sequence.
-
-=cut
-
-sub prepend {
- my $self = shift;
- $self->{'-ptree'}->prepend(@_);
- _set_child2parent_links($self, @_);
- return $self;
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<append()>
-
- $pod_seq->append($text);
- $pod_seq1->append($pod_seq2);
-
-Appends the given string or parse-tree or sequence object to the parse-tree
-of this interior sequence.
-
-=cut
-
-sub append {
- my $self = shift;
- $self->{'-ptree'}->append(@_);
- _set_child2parent_links($self, @_);
- return $self;
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<nested()>
-
- $outer_seq = $pod_seq->nested || print "not nested";
-
-If this interior sequence is nested inside of another interior
-sequence, then the outer/parent sequence that contains it is
-returned. Otherwise C<undef> is returned.
-
-=cut
-
-sub nested {
- my $self = shift;
- (@_ == 1) and $self->{'-parent_sequence'} = shift;
- return $self->{'-parent_sequence'} || undef;
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<raw_text()>
-
- my $seq_raw_text = $pod_seq->raw_text();
-
-This method will return the I<raw> text of the POD interior sequence,
-exactly as it appeared in the input.
-
-=cut
-
-sub raw_text {
- my $self = shift;
- my $text = $self->{'-name'} . $self->{'-ldelim'};
- for ( $self->{'-ptree'}->children ) {
- $text .= (ref $_) ? $_->raw_text : $_;
- }
- $text .= $self->{'-rdelim'};
- return $text;
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<left_delimiter()>
-
- my $ldelim = $pod_seq->left_delimiter();
-
-The leftmost delimiter beginning the argument text to the interior
-sequence (should be "<").
-
-=cut
-
-sub left_delimiter {
- (@_ > 1) and $_[0]->{'-ldelim'} = $_[1];
- return $_[0]->{'-ldelim'};
-}
-
-## let ldelim() be an alias for left_delimiter()
-*ldelim = \&left_delimiter;
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<right_delimiter()>
-
-The rightmost delimiter beginning the argument text to the interior
-sequence (should be ">").
-
-=cut
-
-sub right_delimiter {
- (@_ > 1) and $_[0]->{'-rdelim'} = $_[1];
- return $_[0]->{'-rdelim'};
-}
-
-## let rdelim() be an alias for right_delimiter()
-*rdelim = \&right_delimiter;
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<parse_tree()>
-
- my $ptree = $pod_parser->parse_text($paragraph_text);
- $pod_seq->parse_tree( $ptree );
- $ptree = $pod_seq->parse_tree();
-
-This method will get/set the corresponding parse-tree of the interior
-sequence's text.
-
-=cut
-
-sub parse_tree {
- (@_ > 1) and $_[0]->{'-ptree'} = $_[1];
- return $_[0]->{'-ptree'};
-}
-
-## let ptree() be an alias for parse_tree()
-*ptree = \&parse_tree;
-
-##---------------------------------------------------------------------------
-
-=head2 $pod_seq-E<gt>B<file_line()>
-
- my ($filename, $line_number) = $pod_seq->file_line();
- my $position = $pod_seq->file_line();
-
-Returns the current filename and line number for the interior sequence
-object. If called in a list context, it returns a list of two
-elements: first the filename, then the line number. If called in
-a scalar context, it returns a string containing the filename, followed
-by a colon (':'), followed by the line number.
-
-=cut
-
-sub file_line {
- my @loc = ($_[0]->{'-file'} || '<unknown-file>',
- $_[0]->{'-line'} || 0);
- return (wantarray) ? @loc : join(':', @loc);
-}
-
-##---------------------------------------------------------------------------
-
-=head2 Pod::InteriorSequence::B<DESTROY()>
-
-This method performs any necessary cleanup for the interior-sequence.
-If you override this method then it is B<imperative> that you invoke
-the parent method from within your own method, otherwise
-I<interior-sequence storage will not be reclaimed upon destruction!>
-
-=cut
-
-sub DESTROY {
- ## We need to get rid of all child->parent pointers throughout the
- ## tree so their reference counts will go to zero and they can be
- ## garbage-collected
- _unset_child2parent_links(@_);
-}
-
-##---------------------------------------------------------------------------
-
-#############################################################################
-
-package Pod::ParseTree;
-
-##---------------------------------------------------------------------------
-
-=head1 B<Pod::ParseTree>
-
-This object corresponds to a tree of parsed POD text. As POD text is
-scanned from left to right, it is parsed into an ordered list of
-text-strings and B<Pod::InteriorSequence> objects (in order of
-appearance). A B<Pod::ParseTree> object corresponds to this list of
-strings and sequences. Each interior sequence in the parse-tree may
-itself contain a parse-tree (since interior sequences may be nested).
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=head2 Pod::ParseTree-E<gt>B<new()>
-
- my $ptree1 = Pod::ParseTree->new;
- my $ptree2 = new Pod::ParseTree;
- my $ptree4 = Pod::ParseTree->new($array_ref);
- my $ptree3 = new Pod::ParseTree($array_ref);
-
-This is a class method that constructs a C<Pod::Parse_tree> object and
-returns a reference to the new parse-tree. If a single-argument is given,
-it must be a reference to an array, and is used to initialize the root
-(top) of the parse tree.
-
-=cut
-
-sub new {
- ## Determine if we were called via an object-ref or a classname
- my $this = shift;
- my $class = ref($this) || $this;
-
- my $self = (@_ == 1 and ref $_[0]) ? $_[0] : [];
-
- ## Bless ourselves into the desired class and perform any initialization
- bless $self, $class;
- return $self;
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $ptree-E<gt>B<top()>
-
- my $top_node = $ptree->top();
- $ptree->top( $top_node );
- $ptree->top( @children );
-
-This method gets/sets the top node of the parse-tree. If no arguments are
-given, it returns the topmost node in the tree (the root), which is also
-a B<Pod::ParseTree>. If it is given a single argument that is a reference,
-then the reference is assumed to a parse-tree and becomes the new top node.
-Otherwise, if arguments are given, they are treated as the new list of
-children for the top node.
-
-=cut
-
-sub top {
- my $self = shift;
- if (@_ > 0) {
- @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_;
- }
- return $self;
-}
-
-## let parse_tree() & ptree() be aliases for the 'top' method
-*parse_tree = *ptree = \&top;
-
-##---------------------------------------------------------------------------
-
-=head2 $ptree-E<gt>B<children()>
-
-This method gets/sets the children of the top node in the parse-tree.
-If no arguments are given, it returns the list (array) of children
-(each of which should be either a string or a B<Pod::InteriorSequence>.
-Otherwise, if arguments are given, they are treated as the new list of
-children for the top node.
-
-=cut
-
-sub children {
- my $self = shift;
- if (@_ > 0) {
- @{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_;
- }
- return @{ $self };
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $ptree-E<gt>B<prepend()>
-
-This method prepends the given text or parse-tree to the current parse-tree.
-If the first item on the parse-tree is text and the argument is also text,
-then the text is prepended to the first item (not added as a separate string).
-Otherwise the argument is added as a new string or parse-tree I<before>
-the current one.
-
-=cut
-
-use vars qw(@ptree); ## an alias used for performance reasons
-
-sub prepend {
- my $self = shift;
- local *ptree = $self;
- for (@_) {
- next unless length;
- if (@ptree && !(ref $ptree[0]) && !(ref $_)) {
- $ptree[0] = $_ . $ptree[0];
- }
- else {
- unshift @ptree, $_;
- }
- }
-}
-
-##---------------------------------------------------------------------------
-
-=head2 $ptree-E<gt>B<append()>
-
-This method appends the given text or parse-tree to the current parse-tree.
-If the last item on the parse-tree is text and the argument is also text,
-then the text is appended to the last item (not added as a separate string).
-Otherwise the argument is added as a new string or parse-tree I<after>
-the current one.
-
-=cut
-
-sub append {
- my $self = shift;
- local *ptree = $self;
- my $can_append = @ptree && !(ref $ptree[-1]);
- for (@_) {
- if (ref) {
- push @ptree, $_;
- }
- elsif(!length) {
- next;
- }
- elsif ($can_append) {
- $ptree[-1] .= $_;
- }
- else {
- push @ptree, $_;
- }
- }
-}
-
-=head2 $ptree-E<gt>B<raw_text()>
-
- my $ptree_raw_text = $ptree->raw_text();
-
-This method will return the I<raw> text of the POD parse-tree
-exactly as it appeared in the input.
-
-=cut
-
-sub raw_text {
- my $self = shift;
- my $text = '';
- for ( @$self ) {
- $text .= (ref $_) ? $_->raw_text : $_;
- }
- return $text;
-}
-
-##---------------------------------------------------------------------------
-
-## Private routines to set/unset child->parent links
-
-sub _unset_child2parent_links {
- my $self = shift;
- local *ptree = $self;
- for (@ptree) {
- next unless (defined and length and ref and ref ne 'SCALAR');
- $_->_unset_child2parent_links()
- if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
- }
-}
-
-sub _set_child2parent_links {
- ## nothing to do, Pod::ParseTrees cant have parent pointers
-}
-
-=head2 Pod::ParseTree::B<DESTROY()>
-
-This method performs any necessary cleanup for the parse-tree.
-If you override this method then it is B<imperative>
-that you invoke the parent method from within your own method,
-otherwise I<parse-tree storage will not be reclaimed upon destruction!>
-
-=cut
-
-sub DESTROY {
- ## We need to get rid of all child->parent pointers throughout the
- ## tree so their reference counts will go to zero and they can be
- ## garbage-collected
- _unset_child2parent_links(@_);
-}
-
-#############################################################################
-
-=head1 SEE ALSO
-
-See L<Pod::Parser>, L<Pod::Select>
-
-=head1 AUTHOR
-
-Please report bugs using L<http://rt.cpan.org>.
-
-Brad Appleton E<lt>bradapp@enteract.comE<gt>
-
-=cut
-
-1;
diff --git a/lib/Pod/ParseUtils.pm b/lib/Pod/ParseUtils.pm
deleted file mode 100644
index f3c7ef4677..0000000000
--- a/lib/Pod/ParseUtils.pm
+++ /dev/null
@@ -1,855 +0,0 @@
-#############################################################################
-# Pod/ParseUtils.pm -- helpers for POD parsing and conversion
-#
-# Copyright (C) 1999-2000 by Marek Rouchal. All rights reserved.
-# This file is part of "PodParser". PodParser is free software;
-# you can redistribute it and/or modify it under the same terms
-# as Perl itself.
-#############################################################################
-
-package Pod::ParseUtils;
-use strict;
-
-use vars qw($VERSION);
-$VERSION = '1.36'; ## Current version of this package
-require 5.005; ## requires this Perl version or later
-
-=head1 NAME
-
-Pod::ParseUtils - helpers for POD parsing and conversion
-
-=head1 SYNOPSIS
-
- use Pod::ParseUtils;
-
- my $list = new Pod::List;
- my $link = Pod::Hyperlink->new('Pod::Parser');
-
-=head1 DESCRIPTION
-
-B<Pod::ParseUtils> contains a few object-oriented helper packages for
-POD parsing and processing (i.e. in POD formatters and translators).
-
-=cut
-
-#-----------------------------------------------------------------------------
-# Pod::List
-#
-# class to hold POD list info (=over, =item, =back)
-#-----------------------------------------------------------------------------
-
-package Pod::List;
-
-use Carp;
-
-=head2 Pod::List
-
-B<Pod::List> can be used to hold information about POD lists
-(written as =over ... =item ... =back) for further processing.
-The following methods are available:
-
-=over 4
-
-=item Pod::List-E<gt>new()
-
-Create a new list object. Properties may be specified through a hash
-reference like this:
-
- my $list = Pod::List->new({ -start => $., -indent => 4 });
-
-See the individual methods/properties for details.
-
-=cut
-
-sub new {
- my $this = shift;
- my $class = ref($this) || $this;
- my %params = @_;
- my $self = {%params};
- bless $self, $class;
- $self->initialize();
- return $self;
-}
-
-sub initialize {
- my $self = shift;
- $self->{-file} ||= 'unknown';
- $self->{-start} ||= 'unknown';
- $self->{-indent} ||= 4; # perlpod: "should be the default"
- $self->{_items} = [];
- $self->{-type} ||= '';
-}
-
-=item $list-E<gt>file()
-
-Without argument, retrieves the file name the list is in. This must
-have been set before by either specifying B<-file> in the B<new()>
-method or by calling the B<file()> method with a scalar argument.
-
-=cut
-
-# The POD file name the list appears in
-sub file {
- return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
-}
-
-=item $list-E<gt>start()
-
-Without argument, retrieves the line number where the list started.
-This must have been set before by either specifying B<-start> in the
-B<new()> method or by calling the B<start()> method with a scalar
-argument.
-
-=cut
-
-# The line in the file the node appears
-sub start {
- return (@_ > 1) ? ($_[0]->{-start} = $_[1]) : $_[0]->{-start};
-}
-
-=item $list-E<gt>indent()
-
-Without argument, retrieves the indent level of the list as specified
-in C<=over n>. This must have been set before by either specifying
-B<-indent> in the B<new()> method or by calling the B<indent()> method
-with a scalar argument.
-
-=cut
-
-# indent level
-sub indent {
- return (@_ > 1) ? ($_[0]->{-indent} = $_[1]) : $_[0]->{-indent};
-}
-
-=item $list-E<gt>type()
-
-Without argument, retrieves the list type, which can be an arbitrary value,
-e.g. C<OL>, C<UL>, ... when thinking the HTML way.
-This must have been set before by either specifying
-B<-type> in the B<new()> method or by calling the B<type()> method
-with a scalar argument.
-
-=cut
-
-# The type of the list (UL, OL, ...)
-sub type {
- return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
-}
-
-=item $list-E<gt>rx()
-
-Without argument, retrieves a regular expression for simplifying the
-individual item strings once the list type has been determined. Usage:
-E.g. when converting to HTML, one might strip the leading number in
-an ordered list as C<E<lt>OLE<gt>> already prints numbers itself.
-This must have been set before by either specifying
-B<-rx> in the B<new()> method or by calling the B<rx()> method
-with a scalar argument.
-
-=cut
-
-# The regular expression to simplify the items
-sub rx {
- return (@_ > 1) ? ($_[0]->{-rx} = $_[1]) : $_[0]->{-rx};
-}
-
-=item $list-E<gt>item()
-
-Without argument, retrieves the array of the items in this list.
-The items may be represented by any scalar.
-If an argument has been given, it is pushed on the list of items.
-
-=cut
-
-# The individual =items of this list
-sub item {
- my ($self,$item) = @_;
- if(defined $item) {
- push(@{$self->{_items}}, $item);
- return $item;
- }
- else {
- return @{$self->{_items}};
- }
-}
-
-=item $list-E<gt>parent()
-
-Without argument, retrieves information about the parent holding this
-list, which is represented as an arbitrary scalar.
-This must have been set before by either specifying
-B<-parent> in the B<new()> method or by calling the B<parent()> method
-with a scalar argument.
-
-=cut
-
-# possibility for parsers/translators to store information about the
-# lists's parent object
-sub parent {
- return (@_ > 1) ? ($_[0]->{-parent} = $_[1]) : $_[0]->{-parent};
-}
-
-=item $list-E<gt>tag()
-
-Without argument, retrieves information about the list tag, which can be
-any scalar.
-This must have been set before by either specifying
-B<-tag> in the B<new()> method or by calling the B<tag()> method
-with a scalar argument.
-
-=back
-
-=cut
-
-# possibility for parsers/translators to store information about the
-# list's object
-sub tag {
- return (@_ > 1) ? ($_[0]->{-tag} = $_[1]) : $_[0]->{-tag};
-}
-
-#-----------------------------------------------------------------------------
-# Pod::Hyperlink
-#
-# class to manipulate POD hyperlinks (L<>)
-#-----------------------------------------------------------------------------
-
-package Pod::Hyperlink;
-
-=head2 Pod::Hyperlink
-
-B<Pod::Hyperlink> is a class for manipulation of POD hyperlinks. Usage:
-
- my $link = Pod::Hyperlink->new('alternative text|page/"section in page"');
-
-The B<Pod::Hyperlink> class is mainly designed to parse the contents of the
-C<LE<lt>...E<gt>> sequence, providing a simple interface for accessing the
-different parts of a POD hyperlink for further processing. It can also be
-used to construct hyperlinks.
-
-=over 4
-
-=item Pod::Hyperlink-E<gt>new()
-
-The B<new()> method can either be passed a set of key/value pairs or a single
-scalar value, namely the contents of a C<LE<lt>...E<gt>> sequence. An object
-of the class C<Pod::Hyperlink> is returned. The value C<undef> indicates a
-failure, the error message is stored in C<$@>.
-
-=cut
-
-use Carp;
-
-sub new {
- my $this = shift;
- my $class = ref($this) || $this;
- my $self = +{};
- bless $self, $class;
- $self->initialize();
- if(defined $_[0]) {
- if(ref($_[0])) {
- # called with a list of parameters
- %$self = %{$_[0]};
- $self->_construct_text();
- }
- else {
- # called with L<> contents
- return unless($self->parse($_[0]));
- }
- }
- return $self;
-}
-
-sub initialize {
- my $self = shift;
- $self->{-line} ||= 'undef';
- $self->{-file} ||= 'undef';
- $self->{-page} ||= '';
- $self->{-node} ||= '';
- $self->{-alttext} ||= '';
- $self->{-type} ||= 'undef';
- $self->{_warnings} = [];
-}
-
-=item $link-E<gt>parse($string)
-
-This method can be used to (re)parse a (new) hyperlink, i.e. the contents
-of a C<LE<lt>...E<gt>> sequence. The result is stored in the current object.
-Warnings are stored in the B<warnings> property.
-E.g. sections like C<LE<lt>open(2)E<gt>> are deprecated, as they do not point
-to Perl documents. C<LE<lt>DBI::foo(3p)E<gt>> is wrong as well, the manpage
-section can simply be dropped.
-
-=cut
-
-sub parse {
- my $self = shift;
- local($_) = $_[0];
- # syntax check the link and extract destination
- my ($alttext,$page,$node,$type,$quoted) = (undef,'','','',0);
-
- $self->{_warnings} = [];
-
- # collapse newlines with whitespace
- s/\s*\n+\s*/ /g;
-
- # strip leading/trailing whitespace
- if(s/^[\s\n]+//) {
- $self->warning('ignoring leading whitespace in link');
- }
- if(s/[\s\n]+$//) {
- $self->warning('ignoring trailing whitespace in link');
- }
- unless(length($_)) {
- _invalid_link('empty link');
- return;
- }
-
- ## Check for different possibilities. This is tedious and error-prone
- # we match all possibilities (alttext, page, section/item)
- #warn "DEBUG: link=$_\n";
-
- # only page
- # problem: a lot of people use (), or (1) or the like to indicate
- # man page sections. But this collides with L<func()> that is supposed
- # to point to an internal funtion...
- my $page_rx = '[\w.-]+(?:::[\w.-]+)*(?:[(](?:\d\w*|)[)]|)';
- # page name only
- if(/^($page_rx)$/o) {
- $page = $1;
- $type = 'page';
- }
- # alttext, page and "section"
- elsif(m{^(.*?)\s*[|]\s*($page_rx)\s*/\s*"(.+)"$}o) {
- ($alttext, $page, $node) = ($1, $2, $3);
- $type = 'section';
- $quoted = 1; #... therefore | and / are allowed
- }
- # alttext and page
- elsif(/^(.*?)\s*[|]\s*($page_rx)$/o) {
- ($alttext, $page) = ($1, $2);
- $type = 'page';
- }
- # alttext and "section"
- elsif(m{^(.*?)\s*[|]\s*(?:/\s*|)"(.+)"$}) {
- ($alttext, $node) = ($1,$2);
- $type = 'section';
- $quoted = 1;
- }
- # page and "section"
- elsif(m{^($page_rx)\s*/\s*"(.+)"$}o) {
- ($page, $node) = ($1, $2);
- $type = 'section';
- $quoted = 1;
- }
- # page and item
- elsif(m{^($page_rx)\s*/\s*(.+)$}o) {
- ($page, $node) = ($1, $2);
- $type = 'item';
- }
- # only "section"
- elsif(m{^/?"(.+)"$}) {
- $node = $1;
- $type = 'section';
- $quoted = 1;
- }
- # only item
- elsif(m{^\s*/(.+)$}) {
- $node = $1;
- $type = 'item';
- }
-
- # non-standard: Hyperlink with alt-text - doesn't remove protocol prefix, maybe it should?
- elsif(/^ \s* (.*?) \s* [|] \s* (\w+:[^:\s] [^\s|]*?) \s* $/ix) {
- ($alttext,$node) = ($1,$2);
- $type = 'hyperlink';
- }
-
- # non-standard: Hyperlink
- elsif(/^(\w+:[^:\s]\S*)$/i) {
- $node = $1;
- $type = 'hyperlink';
- }
- # alttext, page and item
- elsif(m{^(.*?)\s*[|]\s*($page_rx)\s*/\s*(.+)$}o) {
- ($alttext, $page, $node) = ($1, $2, $3);
- $type = 'item';
- }
- # alttext and item
- elsif(m{^(.*?)\s*[|]\s*/(.+)$}) {
- ($alttext, $node) = ($1,$2);
- }
- # must be an item or a "malformed" section (without "")
- else {
- $node = $_;
- $type = 'item';
- }
- # collapse whitespace in nodes
- $node =~ s/\s+/ /gs;
-
- # empty alternative text expands to node name
- if(defined $alttext) {
- if(!length($alttext)) {
- $alttext = $node || $page;
- }
- }
- else {
- $alttext = '';
- }
-
- if($page =~ /[(]\w*[)]$/) {
- $self->warning("(section) in '$page' deprecated");
- }
- if(!$quoted && $node =~ m{[|/]} && $type ne 'hyperlink') {
- $self->warning("node '$node' contains non-escaped | or /");
- }
- if($alttext =~ m{[|/]}) {
- $self->warning("alternative text '$node' contains non-escaped | or /");
- }
- $self->{-page} = $page;
- $self->{-node} = $node;
- $self->{-alttext} = $alttext;
- #warn "DEBUG: page=$page section=$section item=$item alttext=$alttext\n";
- $self->{-type} = $type;
- $self->_construct_text();
- 1;
-}
-
-sub _construct_text {
- my $self = shift;
- my $alttext = $self->alttext();
- my $type = $self->type();
- my $section = $self->node();
- my $page = $self->page();
- my $page_ext = '';
- $page =~ s/([(]\w*[)])$// && ($page_ext = $1);
- if($alttext) {
- $self->{_text} = $alttext;
- }
- elsif($type eq 'hyperlink') {
- $self->{_text} = $section;
- }
- else {
- $self->{_text} = ($section || '') .
- (($page && $section) ? ' in ' : '') .
- "$page$page_ext";
- }
- # for being marked up later
- # use the non-standard markers P<> and Q<>, so that the resulting
- # text can be parsed by the translators. It's their job to put
- # the correct hypertext around the linktext
- if($alttext) {
- $self->{_markup} = "Q<$alttext>";
- }
- elsif($type eq 'hyperlink') {
- $self->{_markup} = "Q<$section>";
- }
- else {
- $self->{_markup} = (!$section ? '' : "Q<$section>") .
- ($page ? ($section ? ' in ':'') . "P<$page>$page_ext" : '');
- }
-}
-
-=item $link-E<gt>markup($string)
-
-Set/retrieve the textual value of the link. This string contains special
-markers C<PE<lt>E<gt>> and C<QE<lt>E<gt>> that should be expanded by the
-translator's interior sequence expansion engine to the
-formatter-specific code to highlight/activate the hyperlink. The details
-have to be implemented in the translator.
-
-=cut
-
-#' retrieve/set markuped text
-sub markup {
- return (@_ > 1) ? ($_[0]->{_markup} = $_[1]) : $_[0]->{_markup};
-}
-
-=item $link-E<gt>text()
-
-This method returns the textual representation of the hyperlink as above,
-but without markers (read only). Depending on the link type this is one of
-the following alternatives (the + and * denote the portions of the text
-that are marked up):
-
- +perl+ L<perl>
- *$|* in +perlvar+ L<perlvar/$|>
- *OPTIONS* in +perldoc+ L<perldoc/"OPTIONS">
- *DESCRIPTION* L<"DESCRIPTION">
-
-=cut
-
-# The complete link's text
-sub text {
- return $_[0]->{_text};
-}
-
-=item $link-E<gt>warning()
-
-After parsing, this method returns any warnings encountered during the
-parsing process.
-
-=cut
-
-# Set/retrieve warnings
-sub warning {
- my $self = shift;
- if(@_) {
- push(@{$self->{_warnings}}, @_);
- return @_;
- }
- return @{$self->{_warnings}};
-}
-
-=item $link-E<gt>file()
-
-=item $link-E<gt>line()
-
-Just simple slots for storing information about the line and the file
-the link was encountered in. Has to be filled in manually.
-
-=cut
-
-# The line in the file the link appears
-sub line {
- return (@_ > 1) ? ($_[0]->{-line} = $_[1]) : $_[0]->{-line};
-}
-
-# The POD file name the link appears in
-sub file {
- return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
-}
-
-=item $link-E<gt>page()
-
-This method sets or returns the POD page this link points to.
-
-=cut
-
-# The POD page the link appears on
-sub page {
- if (@_ > 1) {
- $_[0]->{-page} = $_[1];
- $_[0]->_construct_text();
- }
- return $_[0]->{-page};
-}
-
-=item $link-E<gt>node()
-
-As above, but the destination node text of the link.
-
-=cut
-
-# The link destination
-sub node {
- if (@_ > 1) {
- $_[0]->{-node} = $_[1];
- $_[0]->_construct_text();
- }
- return $_[0]->{-node};
-}
-
-=item $link-E<gt>alttext()
-
-Sets or returns an alternative text specified in the link.
-
-=cut
-
-# Potential alternative text
-sub alttext {
- if (@_ > 1) {
- $_[0]->{-alttext} = $_[1];
- $_[0]->_construct_text();
- }
- return $_[0]->{-alttext};
-}
-
-=item $link-E<gt>type()
-
-The node type, either C<section> or C<item>. As an unofficial type,
-there is also C<hyperlink>, derived from e.g. C<LE<lt>http://perl.comE<gt>>
-
-=cut
-
-# The type: item or headn
-sub type {
- return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
-}
-
-=item $link-E<gt>link()
-
-Returns the link as contents of C<LE<lt>E<gt>>. Reciprocal to B<parse()>.
-
-=back
-
-=cut
-
-# The link itself
-sub link {
- my $self = shift;
- my $link = $self->page() || '';
- if($self->node()) {
- my $node = $self->node();
- $node =~ s/\|/E<verbar>/g;
- $node =~ s{/}{E<sol>}g;
- if($self->type() eq 'section') {
- $link .= ($link ? '/' : '') . '"' . $node . '"';
- }
- elsif($self->type() eq 'hyperlink') {
- $link = $self->node();
- }
- else { # item
- $link .= '/' . $node;
- }
- }
- if($self->alttext()) {
- my $text = $self->alttext();
- $text =~ s/\|/E<verbar>/g;
- $text =~ s{/}{E<sol>}g;
- $link = "$text|$link";
- }
- return $link;
-}
-
-sub _invalid_link {
- my ($msg) = @_;
- # this sets @_
- #eval { die "$msg\n" };
- #chomp $@;
- $@ = $msg; # this seems to work, too!
- return;
-}
-
-#-----------------------------------------------------------------------------
-# Pod::Cache
-#
-# class to hold POD page details
-#-----------------------------------------------------------------------------
-
-package Pod::Cache;
-
-=head2 Pod::Cache
-
-B<Pod::Cache> holds information about a set of POD documents,
-especially the nodes for hyperlinks.
-The following methods are available:
-
-=over 4
-
-=item Pod::Cache-E<gt>new()
-
-Create a new cache object. This object can hold an arbitrary number of
-POD documents of class Pod::Cache::Item.
-
-=cut
-
-sub new {
- my $this = shift;
- my $class = ref($this) || $this;
- my $self = [];
- bless $self, $class;
- return $self;
-}
-
-=item $cache-E<gt>item()
-
-Add a new item to the cache. Without arguments, this method returns a
-list of all cache elements.
-
-=cut
-
-sub item {
- my ($self,%param) = @_;
- if(%param) {
- my $item = Pod::Cache::Item->new(%param);
- push(@$self, $item);
- return $item;
- }
- else {
- return @{$self};
- }
-}
-
-=item $cache-E<gt>find_page($name)
-
-Look for a POD document named C<$name> in the cache. Returns the
-reference to the corresponding Pod::Cache::Item object or undef if
-not found.
-
-=back
-
-=cut
-
-sub find_page {
- my ($self,$page) = @_;
- foreach(@$self) {
- if($_->page() eq $page) {
- return $_;
- }
- }
- return;
-}
-
-package Pod::Cache::Item;
-
-=head2 Pod::Cache::Item
-
-B<Pod::Cache::Item> holds information about individual POD documents,
-that can be grouped in a Pod::Cache object.
-It is intended to hold information about the hyperlink nodes of POD
-documents.
-The following methods are available:
-
-=over 4
-
-=item Pod::Cache::Item-E<gt>new()
-
-Create a new object.
-
-=cut
-
-sub new {
- my $this = shift;
- my $class = ref($this) || $this;
- my %params = @_;
- my $self = {%params};
- bless $self, $class;
- $self->initialize();
- return $self;
-}
-
-sub initialize {
- my $self = shift;
- $self->{-nodes} = [] unless(defined $self->{-nodes});
-}
-
-=item $cacheitem-E<gt>page()
-
-Set/retrieve the POD document name (e.g. "Pod::Parser").
-
-=cut
-
-# The POD page
-sub page {
- return (@_ > 1) ? ($_[0]->{-page} = $_[1]) : $_[0]->{-page};
-}
-
-=item $cacheitem-E<gt>description()
-
-Set/retrieve the POD short description as found in the C<=head1 NAME>
-section.
-
-=cut
-
-# The POD description, taken out of NAME if present
-sub description {
- return (@_ > 1) ? ($_[0]->{-description} = $_[1]) : $_[0]->{-description};
-}
-
-=item $cacheitem-E<gt>path()
-
-Set/retrieve the POD file storage path.
-
-=cut
-
-# The file path
-sub path {
- return (@_ > 1) ? ($_[0]->{-path} = $_[1]) : $_[0]->{-path};
-}
-
-=item $cacheitem-E<gt>file()
-
-Set/retrieve the POD file name.
-
-=cut
-
-# The POD file name
-sub file {
- return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
-}
-
-=item $cacheitem-E<gt>nodes()
-
-Add a node (or a list of nodes) to the document's node list. Note that
-the order is kept, i.e. start with the first node and end with the last.
-If no argument is given, the current list of nodes is returned in the
-same order the nodes have been added.
-A node can be any scalar, but usually is a pair of node string and
-unique id for the C<find_node> method to work correctly.
-
-=cut
-
-# The POD nodes
-sub nodes {
- my ($self,@nodes) = @_;
- if(@nodes) {
- push(@{$self->{-nodes}}, @nodes);
- return @nodes;
- }
- else {
- return @{$self->{-nodes}};
- }
-}
-
-=item $cacheitem-E<gt>find_node($name)
-
-Look for a node or index entry named C<$name> in the object.
-Returns the unique id of the node (i.e. the second element of the array
-stored in the node array) or undef if not found.
-
-=cut
-
-sub find_node {
- my ($self,$node) = @_;
- my @search;
- push(@search, @{$self->{-nodes}}) if($self->{-nodes});
- push(@search, @{$self->{-idx}}) if($self->{-idx});
- foreach(@search) {
- if($_->[0] eq $node) {
- return $_->[1]; # id
- }
- }
- return;
-}
-
-=item $cacheitem-E<gt>idx()
-
-Add an index entry (or a list of them) to the document's index list. Note that
-the order is kept, i.e. start with the first node and end with the last.
-If no argument is given, the current list of index entries is returned in the
-same order the entries have been added.
-An index entry can be any scalar, but usually is a pair of string and
-unique id.
-
-=back
-
-=cut
-
-# The POD index entries
-sub idx {
- my ($self,@idx) = @_;
- if(@idx) {
- push(@{$self->{-idx}}, @idx);
- return @idx;
- }
- else {
- return @{$self->{-idx}};
- }
-}
-
-=head1 AUTHOR
-
-Please report bugs using L<http://rt.cpan.org>.
-
-Marek Rouchal E<lt>marekr@cpan.orgE<gt>, borrowing
-a lot of things from L<pod2man> and L<pod2roff> as well as other POD
-processing tools by Tom Christiansen, Brad Appleton and Russ Allbery.
-
-=head1 SEE ALSO
-
-L<pod2man>, L<pod2roff>, L<Pod::Parser>, L<Pod::Checker>,
-L<pod2html>
-
-=cut
-
-1;
diff --git a/lib/Pod/Parser.pm b/lib/Pod/Parser.pm
deleted file mode 100644
index c807f3fbad..0000000000
--- a/lib/Pod/Parser.pm
+++ /dev/null
@@ -1,1829 +0,0 @@
-#############################################################################
-# Pod/Parser.pm -- package which defines a base class for parsing POD docs.
-#
-# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
-# This file is part of "PodParser". PodParser is free software;
-# you can redistribute it and/or modify it under the same terms
-# as Perl itself.
-#############################################################################
-
-package Pod::Parser;
-use strict;
-
-## These "variables" are used as local "glob aliases" for performance
-use vars qw($VERSION @ISA %myData %myOpts @input_stack);
-$VERSION = '1.37'; ## Current version of this package
-require 5.005; ## requires this Perl version or later
-
-#############################################################################
-
-=head1 NAME
-
-Pod::Parser - base class for creating POD filters and translators
-
-=head1 SYNOPSIS
-
- use Pod::Parser;
-
- package MyParser;
- @ISA = qw(Pod::Parser);
-
- sub command {
- my ($parser, $command, $paragraph, $line_num) = @_;
- ## Interpret the command and its text; sample actions might be:
- if ($command eq 'head1') { ... }
- elsif ($command eq 'head2') { ... }
- ## ... other commands and their actions
- my $out_fh = $parser->output_handle();
- my $expansion = $parser->interpolate($paragraph, $line_num);
- print $out_fh $expansion;
- }
-
- sub verbatim {
- my ($parser, $paragraph, $line_num) = @_;
- ## Format verbatim paragraph; sample actions might be:
- my $out_fh = $parser->output_handle();
- print $out_fh $paragraph;
- }
-
- sub textblock {
- my ($parser, $paragraph, $line_num) = @_;
- ## Translate/Format this block of text; sample actions might be:
- my $out_fh = $parser->output_handle();
- my $expansion = $parser->interpolate($paragraph, $line_num);
- print $out_fh $expansion;
- }
-
- sub interior_sequence {
- my ($parser, $seq_command, $seq_argument) = @_;
- ## Expand an interior sequence; sample actions might be:
- return "*$seq_argument*" if ($seq_command eq 'B');
- return "`$seq_argument'" if ($seq_command eq 'C');
- return "_${seq_argument}_'" if ($seq_command eq 'I');
- ## ... other sequence commands and their resulting text
- }
-
- package main;
-
- ## Create a parser object and have it parse file whose name was
- ## given on the command-line (use STDIN if no files were given).
- $parser = new MyParser();
- $parser->parse_from_filehandle(\*STDIN) if (@ARGV == 0);
- for (@ARGV) { $parser->parse_from_file($_); }
-
-=head1 REQUIRES
-
-perl5.005, Pod::InputObjects, Exporter, Symbol, Carp
-
-=head1 EXPORTS
-
-Nothing.
-
-=head1 DESCRIPTION
-
-B<Pod::Parser> is a base class for creating POD filters and translators.
-It handles most of the effort involved with parsing the POD sections
-from an input stream, leaving subclasses free to be concerned only with
-performing the actual translation of text.
-
-B<Pod::Parser> parses PODs, and makes method calls to handle the various
-components of the POD. Subclasses of B<Pod::Parser> override these methods
-to translate the POD into whatever output format they desire.
-
-=head1 QUICK OVERVIEW
-
-To create a POD filter for translating POD documentation into some other
-format, you create a subclass of B<Pod::Parser> which typically overrides
-just the base class implementation for the following methods:
-
-=over 2
-
-=item *
-
-B<command()>
-
-=item *
-
-B<verbatim()>
-
-=item *
-
-B<textblock()>
-
-=item *
-
-B<interior_sequence()>
-
-=back
-
-You may also want to override the B<begin_input()> and B<end_input()>
-methods for your subclass (to perform any needed per-file and/or
-per-document initialization or cleanup).
-
-If you need to perform any preprocessing of input before it is parsed
-you may want to override one or more of B<preprocess_line()> and/or
-B<preprocess_paragraph()>.
-
-Sometimes it may be necessary to make more than one pass over the input
-files. If this is the case you have several options. You can make the
-first pass using B<Pod::Parser> and override your methods to store the
-intermediate results in memory somewhere for the B<end_pod()> method to
-process. You could use B<Pod::Parser> for several passes with an
-appropriate state variable to control the operation for each pass. If
-your input source can't be reset to start at the beginning, you can
-store it in some other structure as a string or an array and have that
-structure implement a B<getline()> method (which is all that
-B<parse_from_filehandle()> uses to read input).
-
-Feel free to add any member data fields you need to keep track of things
-like current font, indentation, horizontal or vertical position, or
-whatever else you like. Be sure to read L<"PRIVATE METHODS AND DATA">
-to avoid name collisions.
-
-For the most part, the B<Pod::Parser> base class should be able to
-do most of the input parsing for you and leave you free to worry about
-how to interpret the commands and translate the result.
-
-Note that all we have described here in this quick overview is the
-simplest most straightforward use of B<Pod::Parser> to do stream-based
-parsing. It is also possible to use the B<Pod::Parser::parse_text> function
-to do more sophisticated tree-based parsing. See L<"TREE-BASED PARSING">.
-
-=head1 PARSING OPTIONS
-
-A I<parse-option> is simply a named option of B<Pod::Parser> with a
-value that corresponds to a certain specified behavior. These various
-behaviors of B<Pod::Parser> may be enabled/disabled by setting
-or unsetting one or more I<parse-options> using the B<parseopts()> method.
-The set of currently accepted parse-options is as follows:
-
-=over 3
-
-=item B<-want_nonPODs> (default: unset)
-
-Normally (by default) B<Pod::Parser> will only provide access to
-the POD sections of the input. Input paragraphs that are not part
-of the POD-format documentation are not made available to the caller
-(not even using B<preprocess_paragraph()>). Setting this option to a
-non-empty, non-zero value will allow B<preprocess_paragraph()> to see
-non-POD sections of the input as well as POD sections. The B<cutting()>
-method can be used to determine if the corresponding paragraph is a POD
-paragraph, or some other input paragraph.
-
-=item B<-process_cut_cmd> (default: unset)
-
-Normally (by default) B<Pod::Parser> handles the C<=cut> POD directive
-by itself and does not pass it on to the caller for processing. Setting
-this option to a non-empty, non-zero value will cause B<Pod::Parser> to
-pass the C<=cut> directive to the caller just like any other POD command
-(and hence it may be processed by the B<command()> method).
-
-B<Pod::Parser> will still interpret the C<=cut> directive to mean that
-"cutting mode" has been (re)entered, but the caller will get a chance
-to capture the actual C<=cut> paragraph itself for whatever purpose
-it desires.
-
-=item B<-warnings> (default: unset)
-
-Normally (by default) B<Pod::Parser> recognizes a bare minimum of
-pod syntax errors and warnings and issues diagnostic messages
-for errors, but not for warnings. (Use B<Pod::Checker> to do more
-thorough checking of POD syntax.) Setting this option to a non-empty,
-non-zero value will cause B<Pod::Parser> to issue diagnostics for
-the few warnings it recognizes as well as the errors.
-
-=back
-
-Please see L<"parseopts()"> for a complete description of the interface
-for the setting and unsetting of parse-options.
-
-=cut
-
-#############################################################################
-
-#use diagnostics;
-use Pod::InputObjects;
-use Carp;
-use Exporter;
-BEGIN {
- if ($] < 5.006) {
- require Symbol;
- import Symbol;
- }
-}
-@ISA = qw(Exporter);
-
-#############################################################################
-
-=head1 RECOMMENDED SUBROUTINE/METHOD OVERRIDES
-
-B<Pod::Parser> provides several methods which most subclasses will probably
-want to override. These methods are as follows:
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=head1 B<command()>
-
- $parser->command($cmd,$text,$line_num,$pod_para);
-
-This method should be overridden by subclasses to take the appropriate
-action when a POD command paragraph (denoted by a line beginning with
-"=") is encountered. When such a POD directive is seen in the input,
-this method is called and is passed:
-
-=over 3
-
-=item C<$cmd>
-
-the name of the command for this POD paragraph
-
-=item C<$text>
-
-the paragraph text for the given POD paragraph command.
-
-=item C<$line_num>
-
-the line-number of the beginning of the paragraph
-
-=item C<$pod_para>
-
-a reference to a C<Pod::Paragraph> object which contains further
-information about the paragraph command (see L<Pod::InputObjects>
-for details).
-
-=back
-
-B<Note> that this method I<is> called for C<=pod> paragraphs.
-
-The base class implementation of this method simply treats the raw POD
-command as normal block of paragraph text (invoking the B<textblock()>
-method with the command paragraph).
-
-=cut
-
-sub command {
- my ($self, $cmd, $text, $line_num, $pod_para) = @_;
- ## Just treat this like a textblock
- $self->textblock($pod_para->raw_text(), $line_num, $pod_para);
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<verbatim()>
-
- $parser->verbatim($text,$line_num,$pod_para);
-
-This method may be overridden by subclasses to take the appropriate
-action when a block of verbatim text is encountered. It is passed the
-following parameters:
-
-=over 3
-
-=item C<$text>
-
-the block of text for the verbatim paragraph
-
-=item C<$line_num>
-
-the line-number of the beginning of the paragraph
-
-=item C<$pod_para>
-
-a reference to a C<Pod::Paragraph> object which contains further
-information about the paragraph (see L<Pod::InputObjects>
-for details).
-
-=back
-
-The base class implementation of this method simply prints the textblock
-(unmodified) to the output filehandle.
-
-=cut
-
-sub verbatim {
- my ($self, $text, $line_num, $pod_para) = @_;
- my $out_fh = $self->{_OUTPUT};
- print $out_fh $text;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<textblock()>
-
- $parser->textblock($text,$line_num,$pod_para);
-
-This method may be overridden by subclasses to take the appropriate
-action when a normal block of POD text is encountered (although the base
-class method will usually do what you want). It is passed the following
-parameters:
-
-=over 3
-
-=item C<$text>
-
-the block of text for the a POD paragraph
-
-=item C<$line_num>
-
-the line-number of the beginning of the paragraph
-
-=item C<$pod_para>
-
-a reference to a C<Pod::Paragraph> object which contains further
-information about the paragraph (see L<Pod::InputObjects>
-for details).
-
-=back
-
-In order to process interior sequences, subclasses implementations of
-this method will probably want to invoke either B<interpolate()> or
-B<parse_text()>, passing it the text block C<$text>, and the corresponding
-line number in C<$line_num>, and then perform any desired processing upon
-the returned result.
-
-The base class implementation of this method simply prints the text block
-as it occurred in the input stream).
-
-=cut
-
-sub textblock {
- my ($self, $text, $line_num, $pod_para) = @_;
- my $out_fh = $self->{_OUTPUT};
- print $out_fh $self->interpolate($text, $line_num);
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<interior_sequence()>
-
- $parser->interior_sequence($seq_cmd,$seq_arg,$pod_seq);
-
-This method should be overridden by subclasses to take the appropriate
-action when an interior sequence is encountered. An interior sequence is
-an embedded command within a block of text which appears as a command
-name (usually a single uppercase character) followed immediately by a
-string of text which is enclosed in angle brackets. This method is
-passed the sequence command C<$seq_cmd> and the corresponding text
-C<$seq_arg>. It is invoked by the B<interpolate()> method for each interior
-sequence that occurs in the string that it is passed. It should return
-the desired text string to be used in place of the interior sequence.
-The C<$pod_seq> argument is a reference to a C<Pod::InteriorSequence>
-object which contains further information about the interior sequence.
-Please see L<Pod::InputObjects> for details if you need to access this
-additional information.
-
-Subclass implementations of this method may wish to invoke the
-B<nested()> method of C<$pod_seq> to see if it is nested inside
-some other interior-sequence (and if so, which kind).
-
-The base class implementation of the B<interior_sequence()> method
-simply returns the raw text of the interior sequence (as it occurred
-in the input) to the caller.
-
-=cut
-
-sub interior_sequence {
- my ($self, $seq_cmd, $seq_arg, $pod_seq) = @_;
- ## Just return the raw text of the interior sequence
- return $pod_seq->raw_text();
-}
-
-#############################################################################
-
-=head1 OPTIONAL SUBROUTINE/METHOD OVERRIDES
-
-B<Pod::Parser> provides several methods which subclasses may want to override
-to perform any special pre/post-processing. These methods do I<not> have to
-be overridden, but it may be useful for subclasses to take advantage of them.
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=head1 B<new()>
-
- my $parser = Pod::Parser->new();
-
-This is the constructor for B<Pod::Parser> and its subclasses. You
-I<do not> need to override this method! It is capable of constructing
-subclass objects as well as base class objects, provided you use
-any of the following constructor invocation styles:
-
- my $parser1 = MyParser->new();
- my $parser2 = new MyParser();
- my $parser3 = $parser2->new();
-
-where C<MyParser> is some subclass of B<Pod::Parser>.
-
-Using the syntax C<MyParser::new()> to invoke the constructor is I<not>
-recommended, but if you insist on being able to do this, then the
-subclass I<will> need to override the B<new()> constructor method. If
-you do override the constructor, you I<must> be sure to invoke the
-B<initialize()> method of the newly blessed object.
-
-Using any of the above invocations, the first argument to the
-constructor is always the corresponding package name (or object
-reference). No other arguments are required, but if desired, an
-associative array (or hash-table) my be passed to the B<new()>
-constructor, as in:
-
- my $parser1 = MyParser->new( MYDATA => $value1, MOREDATA => $value2 );
- my $parser2 = new MyParser( -myflag => 1 );
-
-All arguments passed to the B<new()> constructor will be treated as
-key/value pairs in a hash-table. The newly constructed object will be
-initialized by copying the contents of the given hash-table (which may
-have been empty). The B<new()> constructor for this class and all of its
-subclasses returns a blessed reference to the initialized object (hash-table).
-
-=cut
-
-sub new {
- ## Determine if we were called via an object-ref or a classname
- my ($this,%params) = @_;
- my $class = ref($this) || $this;
- ## Any remaining arguments are treated as initial values for the
- ## hash that is used to represent this object.
- my $self = { %params };
- ## Bless ourselves into the desired class and perform any initialization
- bless $self, $class;
- $self->initialize();
- return $self;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<initialize()>
-
- $parser->initialize();
-
-This method performs any necessary object initialization. It takes no
-arguments (other than the object instance of course, which is typically
-copied to a local variable named C<$self>). If subclasses override this
-method then they I<must> be sure to invoke C<$self-E<gt>SUPER::initialize()>.
-
-=cut
-
-sub initialize {
- #my $self = shift;
- #return;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<begin_pod()>
-
- $parser->begin_pod();
-
-This method is invoked at the beginning of processing for each POD
-document that is encountered in the input. Subclasses should override
-this method to perform any per-document initialization.
-
-=cut
-
-sub begin_pod {
- #my $self = shift;
- #return;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<begin_input()>
-
- $parser->begin_input();
-
-This method is invoked by B<parse_from_filehandle()> immediately I<before>
-processing input from a filehandle. The base class implementation does
-nothing, however, subclasses may override it to perform any per-file
-initializations.
-
-Note that if multiple files are parsed for a single POD document
-(perhaps the result of some future C<=include> directive) this method
-is invoked for every file that is parsed. If you wish to perform certain
-initializations once per document, then you should use B<begin_pod()>.
-
-=cut
-
-sub begin_input {
- #my $self = shift;
- #return;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<end_input()>
-
- $parser->end_input();
-
-This method is invoked by B<parse_from_filehandle()> immediately I<after>
-processing input from a filehandle. The base class implementation does
-nothing, however, subclasses may override it to perform any per-file
-cleanup actions.
-
-Please note that if multiple files are parsed for a single POD document
-(perhaps the result of some kind of C<=include> directive) this method
-is invoked for every file that is parsed. If you wish to perform certain
-cleanup actions once per document, then you should use B<end_pod()>.
-
-=cut
-
-sub end_input {
- #my $self = shift;
- #return;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<end_pod()>
-
- $parser->end_pod();
-
-This method is invoked at the end of processing for each POD document
-that is encountered in the input. Subclasses should override this method
-to perform any per-document finalization.
-
-=cut
-
-sub end_pod {
- #my $self = shift;
- #return;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<preprocess_line()>
-
- $textline = $parser->preprocess_line($text, $line_num);
-
-This method should be overridden by subclasses that wish to perform
-any kind of preprocessing for each I<line> of input (I<before> it has
-been determined whether or not it is part of a POD paragraph). The
-parameter C<$text> is the input line; and the parameter C<$line_num> is
-the line number of the corresponding text line.
-
-The value returned should correspond to the new text to use in its
-place. If the empty string or an undefined value is returned then no
-further processing will be performed for this line.
-
-Please note that the B<preprocess_line()> method is invoked I<before>
-the B<preprocess_paragraph()> method. After all (possibly preprocessed)
-lines in a paragraph have been assembled together and it has been
-determined that the paragraph is part of the POD documentation from one
-of the selected sections, then B<preprocess_paragraph()> is invoked.
-
-The base class implementation of this method returns the given text.
-
-=cut
-
-sub preprocess_line {
- my ($self, $text, $line_num) = @_;
- return $text;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<preprocess_paragraph()>
-
- $textblock = $parser->preprocess_paragraph($text, $line_num);
-
-This method should be overridden by subclasses that wish to perform any
-kind of preprocessing for each block (paragraph) of POD documentation
-that appears in the input stream. The parameter C<$text> is the POD
-paragraph from the input file; and the parameter C<$line_num> is the
-line number for the beginning of the corresponding paragraph.
-
-The value returned should correspond to the new text to use in its
-place If the empty string is returned or an undefined value is
-returned, then the given C<$text> is ignored (not processed).
-
-This method is invoked after gathering up all the lines in a paragraph
-and after determining the cutting state of the paragraph,
-but before trying to further parse or interpret them. After
-B<preprocess_paragraph()> returns, the current cutting state (which
-is returned by C<$self-E<gt>cutting()>) is examined. If it evaluates
-to true then input text (including the given C<$text>) is cut (not
-processed) until the next POD directive is encountered.
-
-Please note that the B<preprocess_line()> method is invoked I<before>
-the B<preprocess_paragraph()> method. After all (possibly preprocessed)
-lines in a paragraph have been assembled together and either it has been
-determined that the paragraph is part of the POD documentation from one
-of the selected sections or the C<-want_nonPODs> option is true,
-then B<preprocess_paragraph()> is invoked.
-
-The base class implementation of this method returns the given text.
-
-=cut
-
-sub preprocess_paragraph {
- my ($self, $text, $line_num) = @_;
- return $text;
-}
-
-#############################################################################
-
-=head1 METHODS FOR PARSING AND PROCESSING
-
-B<Pod::Parser> provides several methods to process input text. These
-methods typically won't need to be overridden (and in some cases they
-can't be overridden), but subclasses may want to invoke them to exploit
-their functionality.
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=head1 B<parse_text()>
-
- $ptree1 = $parser->parse_text($text, $line_num);
- $ptree2 = $parser->parse_text({%opts}, $text, $line_num);
- $ptree3 = $parser->parse_text(\%opts, $text, $line_num);
-
-This method is useful if you need to perform your own interpolation
-of interior sequences and can't rely upon B<interpolate> to expand
-them in simple bottom-up order.
-
-The parameter C<$text> is a string or block of text to be parsed
-for interior sequences; and the parameter C<$line_num> is the
-line number corresponding to the beginning of C<$text>.
-
-B<parse_text()> will parse the given text into a parse-tree of "nodes."
-and interior-sequences. Each "node" in the parse tree is either a
-text-string, or a B<Pod::InteriorSequence>. The result returned is a
-parse-tree of type B<Pod::ParseTree>. Please see L<Pod::InputObjects>
-for more information about B<Pod::InteriorSequence> and B<Pod::ParseTree>.
-
-If desired, an optional hash-ref may be specified as the first argument
-to customize certain aspects of the parse-tree that is created and
-returned. The set of recognized option keywords are:
-
-=over 3
-
-=item B<-expand_seq> =E<gt> I<code-ref>|I<method-name>
-
-Normally, the parse-tree returned by B<parse_text()> will contain an
-unexpanded C<Pod::InteriorSequence> object for each interior-sequence
-encountered. Specifying B<-expand_seq> tells B<parse_text()> to "expand"
-every interior-sequence it sees by invoking the referenced function
-(or named method of the parser object) and using the return value as the
-expanded result.
-
-If a subroutine reference was given, it is invoked as:
-
- &$code_ref( $parser, $sequence )
-
-and if a method-name was given, it is invoked as:
-
- $parser->method_name( $sequence )
-
-where C<$parser> is a reference to the parser object, and C<$sequence>
-is a reference to the interior-sequence object.
-[I<NOTE>: If the B<interior_sequence()> method is specified, then it is
-invoked according to the interface specified in L<"interior_sequence()">].
-
-=item B<-expand_text> =E<gt> I<code-ref>|I<method-name>
-
-Normally, the parse-tree returned by B<parse_text()> will contain a
-text-string for each contiguous sequence of characters outside of an
-interior-sequence. Specifying B<-expand_text> tells B<parse_text()> to
-"preprocess" every such text-string it sees by invoking the referenced
-function (or named method of the parser object) and using the return value
-as the preprocessed (or "expanded") result. [Note that if the result is
-an interior-sequence, then it will I<not> be expanded as specified by the
-B<-expand_seq> option; Any such recursive expansion needs to be handled by
-the specified callback routine.]
-
-If a subroutine reference was given, it is invoked as:
-
- &$code_ref( $parser, $text, $ptree_node )
-
-and if a method-name was given, it is invoked as:
-
- $parser->method_name( $text, $ptree_node )
-
-where C<$parser> is a reference to the parser object, C<$text> is the
-text-string encountered, and C<$ptree_node> is a reference to the current
-node in the parse-tree (usually an interior-sequence object or else the
-top-level node of the parse-tree).
-
-=item B<-expand_ptree> =E<gt> I<code-ref>|I<method-name>
-
-Rather than returning a C<Pod::ParseTree>, pass the parse-tree as an
-argument to the referenced subroutine (or named method of the parser
-object) and return the result instead of the parse-tree object.
-
-If a subroutine reference was given, it is invoked as:
-
- &$code_ref( $parser, $ptree )
-
-and if a method-name was given, it is invoked as:
-
- $parser->method_name( $ptree )
-
-where C<$parser> is a reference to the parser object, and C<$ptree>
-is a reference to the parse-tree object.
-
-=back
-
-=cut
-
-sub parse_text {
- my $self = shift;
- local $_ = '';
-
- ## Get options and set any defaults
- my %opts = (ref $_[0]) ? %{ shift() } : ();
- my $expand_seq = $opts{'-expand_seq'} || undef;
- my $expand_text = $opts{'-expand_text'} || undef;
- my $expand_ptree = $opts{'-expand_ptree'} || undef;
-
- my $text = shift;
- my $line = shift;
- my $file = $self->input_file();
- my $cmd = "";
-
- ## Convert method calls into closures, for our convenience
- my $xseq_sub = $expand_seq;
- my $xtext_sub = $expand_text;
- my $xptree_sub = $expand_ptree;
- if (defined $expand_seq and $expand_seq eq 'interior_sequence') {
- ## If 'interior_sequence' is the method to use, we have to pass
- ## more than just the sequence object, we also need to pass the
- ## sequence name and text.
- $xseq_sub = sub {
- my ($sself, $iseq) = @_;
- my $args = join('', $iseq->parse_tree->children);
- return $sself->interior_sequence($iseq->name, $args, $iseq);
- };
- }
- ref $xseq_sub or $xseq_sub = sub { shift()->$expand_seq(@_) };
- ref $xtext_sub or $xtext_sub = sub { shift()->$expand_text(@_) };
- ref $xptree_sub or $xptree_sub = sub { shift()->$expand_ptree(@_) };
-
- ## Keep track of the "current" interior sequence, and maintain a stack
- ## of "in progress" sequences.
- ##
- ## NOTE that we push our own "accumulator" at the very beginning of the
- ## stack. It's really a parse-tree, not a sequence; but it implements
- ## the methods we need so we can use it to gather-up all the sequences
- ## and strings we parse. Thus, by the end of our parsing, it should be
- ## the only thing left on our stack and all we have to do is return it!
- ##
- my $seq = Pod::ParseTree->new();
- my @seq_stack = ($seq);
- my ($ldelim, $rdelim) = ('', '');
-
- ## Iterate over all sequence starts text (NOTE: split with
- ## capturing parens keeps the delimiters)
- $_ = $text;
- my @tokens = split /([A-Z]<(?:<+\s)?)/;
- while ( @tokens ) {
- $_ = shift @tokens;
- ## Look for the beginning of a sequence
- if ( /^([A-Z])(<(?:<+\s)?)$/ ) {
- ## Push a new sequence onto the stack of those "in-progress"
- my $ldelim_orig;
- ($cmd, $ldelim_orig) = ($1, $2);
- ($ldelim = $ldelim_orig) =~ s/\s+$//;
- ($rdelim = $ldelim) =~ tr/</>/;
- $seq = Pod::InteriorSequence->new(
- -name => $cmd,
- -ldelim => $ldelim_orig, -rdelim => $rdelim,
- -file => $file, -line => $line
- );
- (@seq_stack > 1) and $seq->nested($seq_stack[-1]);
- push @seq_stack, $seq;
- }
- ## Look for sequence ending
- elsif ( @seq_stack > 1 ) {
- ## Make sure we match the right kind of closing delimiter
- my ($seq_end, $post_seq) = ('', '');
- if ( ($ldelim eq '<' and /\A(.*?)(>)/s)
- or /\A(.*?)(\s+$rdelim)/s )
- {
- ## Found end-of-sequence, capture the interior and the
- ## closing the delimiter, and put the rest back on the
- ## token-list
- $post_seq = substr($_, length($1) + length($2));
- ($_, $seq_end) = ($1, $2);
- (length $post_seq) and unshift @tokens, $post_seq;
- }
- if (length) {
- ## In the middle of a sequence, append this text to it, and
- ## dont forget to "expand" it if that's what the caller wanted
- $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_);
- $_ .= $seq_end;
- }
- if (length $seq_end) {
- ## End of current sequence, record terminating delimiter
- $seq->rdelim($seq_end);
- ## Pop it off the stack of "in progress" sequences
- pop @seq_stack;
- ## Append result to its parent in current parse tree
- $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq)
- : $seq);
- ## Remember the current cmd-name and left-delimiter
- if(@seq_stack > 1) {
- $cmd = $seq_stack[-1]->name;
- $ldelim = $seq_stack[-1]->ldelim;
- $rdelim = $seq_stack[-1]->rdelim;
- } else {
- $cmd = $ldelim = $rdelim = '';
- }
- }
- }
- elsif (length) {
- ## In the middle of a sequence, append this text to it, and
- ## dont forget to "expand" it if that's what the caller wanted
- $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_);
- }
- ## Keep track of line count
- $line += s/\r*\n//;
- ## Remember the "current" sequence
- $seq = $seq_stack[-1];
- }
-
- ## Handle unterminated sequences
- my $errorsub = (@seq_stack > 1) ? $self->errorsub() : undef;
- while (@seq_stack > 1) {
- ($cmd, $file, $line) = ($seq->name, $seq->file_line);
- $ldelim = $seq->ldelim;
- ($rdelim = $ldelim) =~ tr/</>/;
- $rdelim =~ s/^(\S+)(\s*)$/$2$1/;
- pop @seq_stack;
- my $errmsg = "*** ERROR: unterminated ${cmd}${ldelim}...${rdelim}".
- " at line $line in file $file\n";
- (ref $errorsub) and &{$errorsub}($errmsg)
- or (defined $errorsub) and $self->$errorsub($errmsg)
- or carp($errmsg);
- $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) : $seq);
- $seq = $seq_stack[-1];
- }
-
- ## Return the resulting parse-tree
- my $ptree = (pop @seq_stack)->parse_tree;
- return $expand_ptree ? &$xptree_sub($self, $ptree) : $ptree;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<interpolate()>
-
- $textblock = $parser->interpolate($text, $line_num);
-
-This method translates all text (including any embedded interior sequences)
-in the given text string C<$text> and returns the interpolated result. The
-parameter C<$line_num> is the line number corresponding to the beginning
-of C<$text>.
-
-B<interpolate()> merely invokes a private method to recursively expand
-nested interior sequences in bottom-up order (innermost sequences are
-expanded first). If there is a need to expand nested sequences in
-some alternate order, use B<parse_text> instead.
-
-=cut
-
-sub interpolate {
- my($self, $text, $line_num) = @_;
- my %parse_opts = ( -expand_seq => 'interior_sequence' );
- my $ptree = $self->parse_text( \%parse_opts, $text, $line_num );
- return join '', $ptree->children();
-}
-
-##---------------------------------------------------------------------------
-
-=begin __PRIVATE__
-
-=head1 B<parse_paragraph()>
-
- $parser->parse_paragraph($text, $line_num);
-
-This method takes the text of a POD paragraph to be processed, along
-with its corresponding line number, and invokes the appropriate method
-(one of B<command()>, B<verbatim()>, or B<textblock()>).
-
-For performance reasons, this method is invoked directly without any
-dynamic lookup; Hence subclasses may I<not> override it!
-
-=end __PRIVATE__
-
-=cut
-
-sub parse_paragraph {
- my ($self, $text, $line_num) = @_;
- local *myData = $self; ## alias to avoid deref-ing overhead
- local *myOpts = ($myData{_PARSEOPTS} ||= {}); ## get parse-options
- local $_;
-
- ## See if we want to preprocess nonPOD paragraphs as well as POD ones.
- my $wantNonPods = $myOpts{'-want_nonPODs'};
-
- ## Update cutting status
- $myData{_CUTTING} = 0 if $text =~ /^={1,2}\S/;
-
- ## Perform any desired preprocessing if we wanted it this early
- $wantNonPods and $text = $self->preprocess_paragraph($text, $line_num);
-
- ## Ignore up until next POD directive if we are cutting
- return if $myData{_CUTTING};
-
- ## Now we know this is block of text in a POD section!
-
- ##-----------------------------------------------------------------
- ## This is a hook (hack ;-) for Pod::Select to do its thing without
- ## having to override methods, but also without Pod::Parser assuming
- ## $self is an instance of Pod::Select (if the _SELECTED_SECTIONS
- ## field exists then we assume there is an is_selected() method for
- ## us to invoke (calling $self->can('is_selected') could verify this
- ## but that is more overhead than I want to incur)
- ##-----------------------------------------------------------------
-
- ## Ignore this block if it isnt in one of the selected sections
- if (exists $myData{_SELECTED_SECTIONS}) {
- $self->is_selected($text) or return ($myData{_CUTTING} = 1);
- }
-
- ## If we havent already, perform any desired preprocessing and
- ## then re-check the "cutting" state
- unless ($wantNonPods) {
- $text = $self->preprocess_paragraph($text, $line_num);
- return 1 unless ((defined $text) and (length $text));
- return 1 if ($myData{_CUTTING});
- }
-
- ## Look for one of the three types of paragraphs
- my ($pfx, $cmd, $arg, $sep) = ('', '', '', '');
- my $pod_para = undef;
- if ($text =~ /^(={1,2})(?=\S)/) {
- ## Looks like a command paragraph. Capture the command prefix used
- ## ("=" or "=="), as well as the command-name, its paragraph text,
- ## and whatever sequence of characters was used to separate them
- $pfx = $1;
- $_ = substr($text, length $pfx);
- ($cmd, $sep, $text) = split /(\s+)/, $_, 2;
- ## If this is a "cut" directive then we dont need to do anything
- ## except return to "cutting" mode.
- if ($cmd eq 'cut') {
- $myData{_CUTTING} = 1;
- return unless $myOpts{'-process_cut_cmd'};
- }
- }
- ## Save the attributes indicating how the command was specified.
- $pod_para = new Pod::Paragraph(
- -name => $cmd,
- -text => $text,
- -prefix => $pfx,
- -separator => $sep,
- -file => $myData{_INFILE},
- -line => $line_num
- );
- # ## Invoke appropriate callbacks
- # if (exists $myData{_CALLBACKS}) {
- # ## Look through the callback list, invoke callbacks,
- # ## then see if we need to do the default actions
- # ## (invoke_callbacks will return true if we do).
- # return 1 unless $self->invoke_callbacks($cmd, $text, $line_num, $pod_para);
- # }
-
- # If the last paragraph ended in whitespace, and we're not between verbatim blocks, carp
- if ($myData{_WHITESPACE} and $myOpts{'-warnings'}
- and not ($text =~ /^\s+/ and ($myData{_PREVIOUS}||"") eq "verbatim")) {
- my $errorsub = $self->errorsub();
- my $line = $line_num - 1;
- my $errmsg = "*** WARNING: line containing nothing but whitespace".
- " in paragraph at line $line in file $myData{_INFILE}\n";
- (ref $errorsub) and &{$errorsub}($errmsg)
- or (defined $errorsub) and $self->$errorsub($errmsg)
- or carp($errmsg);
- }
-
- if (length $cmd) {
- ## A command paragraph
- $self->command($cmd, $text, $line_num, $pod_para);
- $myData{_PREVIOUS} = $cmd;
- }
- elsif ($text =~ /^\s+/) {
- ## Indented text - must be a verbatim paragraph
- $self->verbatim($text, $line_num, $pod_para);
- $myData{_PREVIOUS} = "verbatim";
- }
- else {
- ## Looks like an ordinary block of text
- $self->textblock($text, $line_num, $pod_para);
- $myData{_PREVIOUS} = "textblock";
- }
-
- # Update the whitespace for the next time around
- $myData{_WHITESPACE} = $text =~ /^[^\S\r\n]+\Z/m ? 1 : 0;
-
- return 1;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<parse_from_filehandle()>
-
- $parser->parse_from_filehandle($in_fh,$out_fh);
-
-This method takes an input filehandle (which is assumed to already be
-opened for reading) and reads the entire input stream looking for blocks
-(paragraphs) of POD documentation to be processed. If no first argument
-is given the default input filehandle C<STDIN> is used.
-
-The C<$in_fh> parameter may be any object that provides a B<getline()>
-method to retrieve a single line of input text (hence, an appropriate
-wrapper object could be used to parse PODs from a single string or an
-array of strings).
-
-Using C<$in_fh-E<gt>getline()>, input is read line-by-line and assembled
-into paragraphs or "blocks" (which are separated by lines containing
-nothing but whitespace). For each block of POD documentation
-encountered it will invoke a method to parse the given paragraph.
-
-If a second argument is given then it should correspond to a filehandle where
-output should be sent (otherwise the default output filehandle is
-C<STDOUT> if no output filehandle is currently in use).
-
-B<NOTE:> For performance reasons, this method caches the input stream at
-the top of the stack in a local variable. Any attempts by clients to
-change the stack contents during processing when in the midst executing
-of this method I<will not affect> the input stream used by the current
-invocation of this method.
-
-This method does I<not> usually need to be overridden by subclasses.
-
-=cut
-
-sub parse_from_filehandle {
- my $self = shift;
- my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
- my ($in_fh, $out_fh) = @_;
- $in_fh = \*STDIN unless ($in_fh);
- local *myData = $self; ## alias to avoid deref-ing overhead
- local *myOpts = ($myData{_PARSEOPTS} ||= {}); ## get parse-options
- local $_;
-
- ## Put this stream at the top of the stack and do beginning-of-input
- ## processing. NOTE that $in_fh might be reset during this process.
- my $topstream = $self->_push_input_stream($in_fh, $out_fh);
- (exists $opts{-cutting}) and $self->cutting( $opts{-cutting} );
-
- ## Initialize line/paragraph
- my ($textline, $paragraph) = ('', '');
- my ($nlines, $plines) = (0, 0);
-
- ## Use <$fh> instead of $fh->getline where possible (for speed)
- $_ = ref $in_fh;
- my $tied_fh = (/^(?:GLOB|FileHandle|IO::\w+)$/ or tied $in_fh);
-
- ## Read paragraphs line-by-line
- while (defined ($textline = $tied_fh ? <$in_fh> : $in_fh->getline)) {
- $textline = $self->preprocess_line($textline, ++$nlines);
- next unless ((defined $textline) && (length $textline));
-
- if ((! length $paragraph) && ($textline =~ /^==/)) {
- ## '==' denotes a one-line command paragraph
- $paragraph = $textline;
- $plines = 1;
- $textline = '';
- } else {
- ## Append this line to the current paragraph
- $paragraph .= $textline;
- ++$plines;
- }
-
- ## See if this line is blank and ends the current paragraph.
- ## If it isnt, then keep iterating until it is.
- next unless (($textline =~ /^([^\S\r\n]*)[\r\n]*$/)
- && (length $paragraph));
-
- ## Now process the paragraph
- parse_paragraph($self, $paragraph, ($nlines - $plines) + 1);
- $paragraph = '';
- $plines = 0;
- }
- ## Dont forget about the last paragraph in the file
- if (length $paragraph) {
- parse_paragraph($self, $paragraph, ($nlines - $plines) + 1)
- }
-
- ## Now pop the input stream off the top of the input stack.
- $self->_pop_input_stream();
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<parse_from_file()>
-
- $parser->parse_from_file($filename,$outfile);
-
-This method takes a filename and does the following:
-
-=over 2
-
-=item *
-
-opens the input and output files for reading
-(creating the appropriate filehandles)
-
-=item *
-
-invokes the B<parse_from_filehandle()> method passing it the
-corresponding input and output filehandles.
-
-=item *
-
-closes the input and output files.
-
-=back
-
-If the special input filename "-" or "<&STDIN" is given then the STDIN
-filehandle is used for input (and no open or close is performed). If no
-input filename is specified then "-" is implied. Filehandle references,
-or objects that support the regular IO operations (like C<E<lt>$fhE<gt>>
-or C<$fh-<Egt>getline>) are also accepted; the handles must already be
-opened.
-
-If a second argument is given then it should be the name of the desired
-output file. If the special output filename "-" or ">&STDOUT" is given
-then the STDOUT filehandle is used for output (and no open or close is
-performed). If the special output filename ">&STDERR" is given then the
-STDERR filehandle is used for output (and no open or close is
-performed). If no output filehandle is currently in use and no output
-filename is specified, then "-" is implied.
-Alternatively, filehandle references or objects that support the regular
-IO operations (like C<print>, e.g. L<IO::String>) are also accepted;
-the object must already be opened.
-
-This method does I<not> usually need to be overridden by subclasses.
-
-=cut
-
-sub parse_from_file {
- my $self = shift;
- my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
- my ($infile, $outfile) = @_;
- my ($in_fh, $out_fh);
- if ($] < 5.006) {
- ($in_fh, $out_fh) = (gensym(), gensym());
- }
- my ($close_input, $close_output) = (0, 0);
- local *myData = $self;
- local *_;
-
- ## Is $infile a filename or a (possibly implied) filehandle
- if (defined $infile && ref $infile) {
- if (ref($infile) =~ /^(SCALAR|ARRAY|HASH|CODE|REF)$/) {
- croak "Input from $1 reference not supported!\n";
- }
- ## Must be a filehandle-ref (or else assume its a ref to an object
- ## that supports the common IO read operations).
- $myData{_INFILE} = ${$infile};
- $in_fh = $infile;
- }
- elsif (!defined($infile) || !length($infile) || ($infile eq '-')
- || ($infile =~ /^<&(?:STDIN|0)$/i))
- {
- ## Not a filename, just a string implying STDIN
- $infile ||= '-';
- $myData{_INFILE} = '<standard input>';
- $in_fh = \*STDIN;
- }
- else {
- ## We have a filename, open it for reading
- $myData{_INFILE} = $infile;
- open($in_fh, "< $infile") or
- croak "Can't open $infile for reading: $!\n";
- $close_input = 1;
- }
-
- ## NOTE: we need to be *very* careful when "defaulting" the output
- ## file. We only want to use a default if this is the beginning of
- ## the entire document (but *not* if this is an included file). We
- ## determine this by seeing if the input stream stack has been set-up
- ## already
-
- ## Is $outfile a filename, a (possibly implied) filehandle, maybe a ref?
- if (ref $outfile) {
- ## we need to check for ref() first, as other checks involve reading
- if (ref($outfile) =~ /^(ARRAY|HASH|CODE)$/) {
- croak "Output to $1 reference not supported!\n";
- }
- elsif (ref($outfile) eq 'SCALAR') {
-# # NOTE: IO::String isn't a part of the perl distribution,
-# # so probably we shouldn't support this case...
-# require IO::String;
-# $myData{_OUTFILE} = "$outfile";
-# $out_fh = IO::String->new($outfile);
- croak "Output to SCALAR reference not supported!\n";
- }
- else {
- ## Must be a filehandle-ref (or else assume its a ref to an
- ## object that supports the common IO write operations).
- $myData{_OUTFILE} = ${$outfile};
- $out_fh = $outfile;
- }
- }
- elsif (!defined($outfile) || !length($outfile) || ($outfile eq '-')
- || ($outfile =~ /^>&?(?:STDOUT|1)$/i))
- {
- if (defined $myData{_TOP_STREAM}) {
- $out_fh = $myData{_OUTPUT};
- }
- else {
- ## Not a filename, just a string implying STDOUT
- $outfile ||= '-';
- $myData{_OUTFILE} = '<standard output>';
- $out_fh = \*STDOUT;
- }
- }
- elsif ($outfile =~ /^>&(STDERR|2)$/i) {
- ## Not a filename, just a string implying STDERR
- $myData{_OUTFILE} = '<standard error>';
- $out_fh = \*STDERR;
- }
- else {
- ## We have a filename, open it for writing
- $myData{_OUTFILE} = $outfile;
- (-d $outfile) and croak "$outfile is a directory, not POD input!\n";
- open($out_fh, "> $outfile") or
- croak "Can't open $outfile for writing: $!\n";
- $close_output = 1;
- }
-
- ## Whew! That was a lot of work to set up reasonably/robust behavior
- ## in the case of a non-filename for reading and writing. Now we just
- ## have to parse the input and close the handles when we're finished.
- $self->parse_from_filehandle(\%opts, $in_fh, $out_fh);
-
- $close_input and
- close($in_fh) || croak "Can't close $infile after reading: $!\n";
- $close_output and
- close($out_fh) || croak "Can't close $outfile after writing: $!\n";
-}
-
-#############################################################################
-
-=head1 ACCESSOR METHODS
-
-Clients of B<Pod::Parser> should use the following methods to access
-instance data fields:
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=head1 B<errorsub()>
-
- $parser->errorsub("method_name");
- $parser->errorsub(\&warn_user);
- $parser->errorsub(sub { print STDERR, @_ });
-
-Specifies the method or subroutine to use when printing error messages
-about POD syntax. The supplied method/subroutine I<must> return TRUE upon
-successful printing of the message. If C<undef> is given, then the B<carp>
-builtin is used to issue error messages (this is the default behavior).
-
- my $errorsub = $parser->errorsub()
- my $errmsg = "This is an error message!\n"
- (ref $errorsub) and &{$errorsub}($errmsg)
- or (defined $errorsub) and $parser->$errorsub($errmsg)
- or carp($errmsg);
-
-Returns a method name, or else a reference to the user-supplied subroutine
-used to print error messages. Returns C<undef> if the B<carp> builtin
-is used to issue error messages (this is the default behavior).
-
-=cut
-
-sub errorsub {
- return (@_ > 1) ? ($_[0]->{_ERRORSUB} = $_[1]) : $_[0]->{_ERRORSUB};
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<cutting()>
-
- $boolean = $parser->cutting();
-
-Returns the current C<cutting> state: a boolean-valued scalar which
-evaluates to true if text from the input file is currently being "cut"
-(meaning it is I<not> considered part of the POD document).
-
- $parser->cutting($boolean);
-
-Sets the current C<cutting> state to the given value and returns the
-result.
-
-=cut
-
-sub cutting {
- return (@_ > 1) ? ($_[0]->{_CUTTING} = $_[1]) : $_[0]->{_CUTTING};
-}
-
-##---------------------------------------------------------------------------
-
-##---------------------------------------------------------------------------
-
-=head1 B<parseopts()>
-
-When invoked with no additional arguments, B<parseopts> returns a hashtable
-of all the current parsing options.
-
- ## See if we are parsing non-POD sections as well as POD ones
- my %opts = $parser->parseopts();
- $opts{'-want_nonPODs}' and print "-want_nonPODs\n";
-
-When invoked using a single string, B<parseopts> treats the string as the
-name of a parse-option and returns its corresponding value if it exists
-(returns C<undef> if it doesn't).
-
- ## Did we ask to see '=cut' paragraphs?
- my $want_cut = $parser->parseopts('-process_cut_cmd');
- $want_cut and print "-process_cut_cmd\n";
-
-When invoked with multiple arguments, B<parseopts> treats them as
-key/value pairs and the specified parse-option names are set to the
-given values. Any unspecified parse-options are unaffected.
-
- ## Set them back to the default
- $parser->parseopts(-warnings => 0);
-
-When passed a single hash-ref, B<parseopts> uses that hash to completely
-reset the existing parse-options, all previous parse-option values
-are lost.
-
- ## Reset all options to default
- $parser->parseopts( { } );
-
-See L<"PARSING OPTIONS"> for more information on the name and meaning of each
-parse-option currently recognized.
-
-=cut
-
-sub parseopts {
- local *myData = shift;
- local *myOpts = ($myData{_PARSEOPTS} ||= {});
- return %myOpts if (@_ == 0);
- if (@_ == 1) {
- local $_ = shift;
- return ref($_) ? $myData{_PARSEOPTS} = $_ : $myOpts{$_};
- }
- my @newOpts = (%myOpts, @_);
- $myData{_PARSEOPTS} = { @newOpts };
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<output_file()>
-
- $fname = $parser->output_file();
-
-Returns the name of the output file being written.
-
-=cut
-
-sub output_file {
- return $_[0]->{_OUTFILE};
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<output_handle()>
-
- $fhandle = $parser->output_handle();
-
-Returns the output filehandle object.
-
-=cut
-
-sub output_handle {
- return $_[0]->{_OUTPUT};
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<input_file()>
-
- $fname = $parser->input_file();
-
-Returns the name of the input file being read.
-
-=cut
-
-sub input_file {
- return $_[0]->{_INFILE};
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<input_handle()>
-
- $fhandle = $parser->input_handle();
-
-Returns the current input filehandle object.
-
-=cut
-
-sub input_handle {
- return $_[0]->{_INPUT};
-}
-
-##---------------------------------------------------------------------------
-
-=begin __PRIVATE__
-
-=head1 B<input_streams()>
-
- $listref = $parser->input_streams();
-
-Returns a reference to an array which corresponds to the stack of all
-the input streams that are currently in the middle of being parsed.
-
-While parsing an input stream, it is possible to invoke
-B<parse_from_file()> or B<parse_from_filehandle()> to parse a new input
-stream and then return to parsing the previous input stream. Each input
-stream to be parsed is pushed onto the end of this input stack
-before any of its input is read. The input stream that is currently
-being parsed is always at the end (or top) of the input stack. When an
-input stream has been exhausted, it is popped off the end of the
-input stack.
-
-Each element on this input stack is a reference to C<Pod::InputSource>
-object. Please see L<Pod::InputObjects> for more details.
-
-This method might be invoked when printing diagnostic messages, for example,
-to obtain the name and line number of the all input files that are currently
-being processed.
-
-=end __PRIVATE__
-
-=cut
-
-sub input_streams {
- return $_[0]->{_INPUT_STREAMS};
-}
-
-##---------------------------------------------------------------------------
-
-=begin __PRIVATE__
-
-=head1 B<top_stream()>
-
- $hashref = $parser->top_stream();
-
-Returns a reference to the hash-table that represents the element
-that is currently at the top (end) of the input stream stack
-(see L<"input_streams()">). The return value will be the C<undef>
-if the input stack is empty.
-
-This method might be used when printing diagnostic messages, for example,
-to obtain the name and line number of the current input file.
-
-=end __PRIVATE__
-
-=cut
-
-sub top_stream {
- return $_[0]->{_TOP_STREAM} || undef;
-}
-
-#############################################################################
-
-=head1 PRIVATE METHODS AND DATA
-
-B<Pod::Parser> makes use of several internal methods and data fields
-which clients should not need to see or use. For the sake of avoiding
-name collisions for client data and methods, these methods and fields
-are briefly discussed here. Determined hackers may obtain further
-information about them by reading the B<Pod::Parser> source code.
-
-Private data fields are stored in the hash-object whose reference is
-returned by the B<new()> constructor for this class. The names of all
-private methods and data-fields used by B<Pod::Parser> begin with a
-prefix of "_" and match the regular expression C</^_\w+$/>.
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=begin _PRIVATE_
-
-=head1 B<_push_input_stream()>
-
- $hashref = $parser->_push_input_stream($in_fh,$out_fh);
-
-This method will push the given input stream on the input stack and
-perform any necessary beginning-of-document or beginning-of-file
-processing. The argument C<$in_fh> is the input stream filehandle to
-push, and C<$out_fh> is the corresponding output filehandle to use (if
-it is not given or is undefined, then the current output stream is used,
-which defaults to standard output if it doesnt exist yet).
-
-The value returned will be reference to the hash-table that represents
-the new top of the input stream stack. I<Please Note> that it is
-possible for this method to use default values for the input and output
-file handles. If this happens, you will need to look at the C<INPUT>
-and C<OUTPUT> instance data members to determine their new values.
-
-=end _PRIVATE_
-
-=cut
-
-sub _push_input_stream {
- my ($self, $in_fh, $out_fh) = @_;
- local *myData = $self;
-
- ## Initialize stuff for the entire document if this is *not*
- ## an included file.
- ##
- ## NOTE: we need to be *very* careful when "defaulting" the output
- ## filehandle. We only want to use a default value if this is the
- ## beginning of the entire document (but *not* if this is an included
- ## file).
- unless (defined $myData{_TOP_STREAM}) {
- $out_fh = \*STDOUT unless (defined $out_fh);
- $myData{_CUTTING} = 1; ## current "cutting" state
- $myData{_INPUT_STREAMS} = []; ## stack of all input streams
- }
-
- ## Initialize input indicators
- $myData{_OUTFILE} = '(unknown)' unless (defined $myData{_OUTFILE});
- $myData{_OUTPUT} = $out_fh if (defined $out_fh);
- $in_fh = \*STDIN unless (defined $in_fh);
- $myData{_INFILE} = '(unknown)' unless (defined $myData{_INFILE});
- $myData{_INPUT} = $in_fh;
- my $input_top = $myData{_TOP_STREAM}
- = new Pod::InputSource(
- -name => $myData{_INFILE},
- -handle => $in_fh,
- -was_cutting => $myData{_CUTTING}
- );
- local *input_stack = $myData{_INPUT_STREAMS};
- push(@input_stack, $input_top);
-
- ## Perform beginning-of-document and/or beginning-of-input processing
- $self->begin_pod() if (@input_stack == 1);
- $self->begin_input();
-
- return $input_top;
-}
-
-##---------------------------------------------------------------------------
-
-=begin _PRIVATE_
-
-=head1 B<_pop_input_stream()>
-
- $hashref = $parser->_pop_input_stream();
-
-This takes no arguments. It will perform any necessary end-of-file or
-end-of-document processing and then pop the current input stream from
-the top of the input stack.
-
-The value returned will be reference to the hash-table that represents
-the new top of the input stream stack.
-
-=end _PRIVATE_
-
-=cut
-
-sub _pop_input_stream {
- my ($self) = @_;
- local *myData = $self;
- local *input_stack = $myData{_INPUT_STREAMS};
-
- ## Perform end-of-input and/or end-of-document processing
- $self->end_input() if (@input_stack > 0);
- $self->end_pod() if (@input_stack == 1);
-
- ## Restore cutting state to whatever it was before we started
- ## parsing this file.
- my $old_top = pop(@input_stack);
- $myData{_CUTTING} = $old_top->was_cutting();
-
- ## Dont forget to reset the input indicators
- my $input_top = undef;
- if (@input_stack > 0) {
- $input_top = $myData{_TOP_STREAM} = $input_stack[-1];
- $myData{_INFILE} = $input_top->name();
- $myData{_INPUT} = $input_top->handle();
- } else {
- delete $myData{_TOP_STREAM};
- delete $myData{_INPUT_STREAMS};
- }
-
- return $input_top;
-}
-
-#############################################################################
-
-=head1 TREE-BASED PARSING
-
-If straightforward stream-based parsing wont meet your needs (as is
-likely the case for tasks such as translating PODs into structured
-markup languages like HTML and XML) then you may need to take the
-tree-based approach. Rather than doing everything in one pass and
-calling the B<interpolate()> method to expand sequences into text, it
-may be desirable to instead create a parse-tree using the B<parse_text()>
-method to return a tree-like structure which may contain an ordered
-list of children (each of which may be a text-string, or a similar
-tree-like structure).
-
-Pay special attention to L<"METHODS FOR PARSING AND PROCESSING"> and
-to the objects described in L<Pod::InputObjects>. The former describes
-the gory details and parameters for how to customize and extend the
-parsing behavior of B<Pod::Parser>. B<Pod::InputObjects> provides
-several objects that may all be used interchangeably as parse-trees. The
-most obvious one is the B<Pod::ParseTree> object. It defines the basic
-interface and functionality that all things trying to be a POD parse-tree
-should do. A B<Pod::ParseTree> is defined such that each "node" may be a
-text-string, or a reference to another parse-tree. Each B<Pod::Paragraph>
-object and each B<Pod::InteriorSequence> object also supports the basic
-parse-tree interface.
-
-The B<parse_text()> method takes a given paragraph of text, and
-returns a parse-tree that contains one or more children, each of which
-may be a text-string, or an InteriorSequence object. There are also
-callback-options that may be passed to B<parse_text()> to customize
-the way it expands or transforms interior-sequences, as well as the
-returned result. These callbacks can be used to create a parse-tree
-with custom-made objects (which may or may not support the parse-tree
-interface, depending on how you choose to do it).
-
-If you wish to turn an entire POD document into a parse-tree, that process
-is fairly straightforward. The B<parse_text()> method is the key to doing
-this successfully. Every paragraph-callback (i.e. the polymorphic methods
-for B<command()>, B<verbatim()>, and B<textblock()> paragraphs) takes
-a B<Pod::Paragraph> object as an argument. Each paragraph object has a
-B<parse_tree()> method that can be used to get or set a corresponding
-parse-tree. So for each of those paragraph-callback methods, simply call
-B<parse_text()> with the options you desire, and then use the returned
-parse-tree to assign to the given paragraph object.
-
-That gives you a parse-tree for each paragraph - so now all you need is
-an ordered list of paragraphs. You can maintain that yourself as a data
-element in the object/hash. The most straightforward way would be simply
-to use an array-ref, with the desired set of custom "options" for each
-invocation of B<parse_text>. Let's assume the desired option-set is
-given by the hash C<%options>. Then we might do something like the
-following:
-
- package MyPodParserTree;
-
- @ISA = qw( Pod::Parser );
-
- ...
-
- sub begin_pod {
- my $self = shift;
- $self->{'-paragraphs'} = []; ## initialize paragraph list
- }
-
- sub command {
- my ($parser, $command, $paragraph, $line_num, $pod_para) = @_;
- my $ptree = $parser->parse_text({%options}, $paragraph, ...);
- $pod_para->parse_tree( $ptree );
- push @{ $self->{'-paragraphs'} }, $pod_para;
- }
-
- sub verbatim {
- my ($parser, $paragraph, $line_num, $pod_para) = @_;
- push @{ $self->{'-paragraphs'} }, $pod_para;
- }
-
- sub textblock {
- my ($parser, $paragraph, $line_num, $pod_para) = @_;
- my $ptree = $parser->parse_text({%options}, $paragraph, ...);
- $pod_para->parse_tree( $ptree );
- push @{ $self->{'-paragraphs'} }, $pod_para;
- }
-
- ...
-
- package main;
- ...
- my $parser = new MyPodParserTree(...);
- $parser->parse_from_file(...);
- my $paragraphs_ref = $parser->{'-paragraphs'};
-
-Of course, in this module-author's humble opinion, I'd be more inclined to
-use the existing B<Pod::ParseTree> object than a simple array. That way
-everything in it, paragraphs and sequences, all respond to the same core
-interface for all parse-tree nodes. The result would look something like:
-
- package MyPodParserTree2;
-
- ...
-
- sub begin_pod {
- my $self = shift;
- $self->{'-ptree'} = new Pod::ParseTree; ## initialize parse-tree
- }
-
- sub parse_tree {
- ## convenience method to get/set the parse-tree for the entire POD
- (@_ > 1) and $_[0]->{'-ptree'} = $_[1];
- return $_[0]->{'-ptree'};
- }
-
- sub command {
- my ($parser, $command, $paragraph, $line_num, $pod_para) = @_;
- my $ptree = $parser->parse_text({<<options>>}, $paragraph, ...);
- $pod_para->parse_tree( $ptree );
- $parser->parse_tree()->append( $pod_para );
- }
-
- sub verbatim {
- my ($parser, $paragraph, $line_num, $pod_para) = @_;
- $parser->parse_tree()->append( $pod_para );
- }
-
- sub textblock {
- my ($parser, $paragraph, $line_num, $pod_para) = @_;
- my $ptree = $parser->parse_text({<<options>>}, $paragraph, ...);
- $pod_para->parse_tree( $ptree );
- $parser->parse_tree()->append( $pod_para );
- }
-
- ...
-
- package main;
- ...
- my $parser = new MyPodParserTree2(...);
- $parser->parse_from_file(...);
- my $ptree = $parser->parse_tree;
- ...
-
-Now you have the entire POD document as one great big parse-tree. You
-can even use the B<-expand_seq> option to B<parse_text> to insert
-whole different kinds of objects. Just don't expect B<Pod::Parser>
-to know what to do with them after that. That will need to be in your
-code. Or, alternatively, you can insert any object you like so long as
-it conforms to the B<Pod::ParseTree> interface.
-
-One could use this to create subclasses of B<Pod::Paragraphs> and
-B<Pod::InteriorSequences> for specific commands (or to create your own
-custom node-types in the parse-tree) and add some kind of B<emit()>
-method to each custom node/subclass object in the tree. Then all you'd
-need to do is recursively walk the tree in the desired order, processing
-the children (most likely from left to right) by formatting them if
-they are text-strings, or by calling their B<emit()> method if they
-are objects/references.
-
-=head1 CAVEATS
-
-Please note that POD has the notion of "paragraphs": this is something
-starting I<after> a blank (read: empty) line, with the single exception
-of the file start, which is also starting a paragraph. That means that
-especially a command (e.g. C<=head1>) I<must> be preceded with a blank
-line; C<__END__> is I<not> a blank line.
-
-=head1 SEE ALSO
-
-L<Pod::InputObjects>, L<Pod::Select>
-
-B<Pod::InputObjects> defines POD input objects corresponding to
-command paragraphs, parse-trees, and interior-sequences.
-
-B<Pod::Select> is a subclass of B<Pod::Parser> which provides the ability
-to selectively include and/or exclude sections of a POD document from being
-translated based upon the current heading, subheading, subsubheading, etc.
-
-=for __PRIVATE__
-B<Pod::Callbacks> is a subclass of B<Pod::Parser> which gives its users
-the ability the employ I<callback functions> instead of, or in addition
-to, overriding methods of the base class.
-
-=for __PRIVATE__
-B<Pod::Select> and B<Pod::Callbacks> do not override any
-methods nor do they define any new methods with the same name. Because
-of this, they may I<both> be used (in combination) as a base class of
-the same subclass in order to combine their functionality without
-causing any namespace clashes due to multiple inheritance.
-
-=head1 AUTHOR
-
-Please report bugs using L<http://rt.cpan.org>.
-
-Brad Appleton E<lt>bradapp@enteract.comE<gt>
-
-Based on code for B<Pod::Text> written by
-Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
-
-=head1 LICENSE
-
-Pod-Parser is free software; you can redistribute it and/or modify it
-under the terms of the Artistic License distributed with Perl version
-5.000 or (at your option) any later version. Please refer to the
-Artistic License that came with your Perl distribution for more
-details. If your version of Perl was not distributed under the
-terms of the Artistic License, than you may distribute PodParser
-under the same terms as Perl itself.
-
-=cut
-
-1;
-# vim: ts=4 sw=4 et
diff --git a/lib/Pod/PlainText.pm b/lib/Pod/PlainText.pm
deleted file mode 100644
index 0dce1799b2..0000000000
--- a/lib/Pod/PlainText.pm
+++ /dev/null
@@ -1,738 +0,0 @@
-# Pod::PlainText -- Convert POD data to formatted ASCII text.
-# $Id: Text.pm,v 2.1 1999/09/20 11:53:33 eagle Exp $
-#
-# Copyright 1999-2000 by Russ Allbery <rra@stanford.edu>
-#
-# This program is free software; you can redistribute it and/or modify it
-# under the same terms as Perl itself.
-#
-# This module is intended to be a replacement for Pod::Text, and attempts to
-# match its output except for some specific circumstances where other
-# decisions seemed to produce better output. It uses Pod::Parser and is
-# designed to be very easy to subclass.
-
-############################################################################
-# Modules and declarations
-############################################################################
-
-package Pod::PlainText;
-use strict;
-
-require 5.005;
-
-use Carp qw(carp croak);
-use Pod::Select ();
-
-use vars qw(@ISA %ESCAPES $VERSION);
-
-# We inherit from Pod::Select instead of Pod::Parser so that we can be used
-# by Pod::Usage.
-@ISA = qw(Pod::Select);
-
-$VERSION = '2.04';
-
-BEGIN {
- if ($] < 5.006) {
- require Symbol;
- import Symbol;
- }
-}
-
-############################################################################
-# Table of supported E<> escapes
-############################################################################
-
-# This table is taken near verbatim from Pod::PlainText in Pod::Parser,
-# which got it near verbatim from the original Pod::Text. It is therefore
-# credited to Tom Christiansen, and I'm glad I didn't have to write it. :)
-%ESCAPES = (
- 'amp' => '&', # ampersand
- 'lt' => '<', # left chevron, less-than
- 'gt' => '>', # right chevron, greater-than
- 'quot' => '"', # double quote
-
- "Aacute" => "\xC1", # capital A, acute accent
- "aacute" => "\xE1", # small a, acute accent
- "Acirc" => "\xC2", # capital A, circumflex accent
- "acirc" => "\xE2", # small a, circumflex accent
- "AElig" => "\xC6", # capital AE diphthong (ligature)
- "aelig" => "\xE6", # small ae diphthong (ligature)
- "Agrave" => "\xC0", # capital A, grave accent
- "agrave" => "\xE0", # small a, grave accent
- "Aring" => "\xC5", # capital A, ring
- "aring" => "\xE5", # small a, ring
- "Atilde" => "\xC3", # capital A, tilde
- "atilde" => "\xE3", # small a, tilde
- "Auml" => "\xC4", # capital A, dieresis or umlaut mark
- "auml" => "\xE4", # small a, dieresis or umlaut mark
- "Ccedil" => "\xC7", # capital C, cedilla
- "ccedil" => "\xE7", # small c, cedilla
- "Eacute" => "\xC9", # capital E, acute accent
- "eacute" => "\xE9", # small e, acute accent
- "Ecirc" => "\xCA", # capital E, circumflex accent
- "ecirc" => "\xEA", # small e, circumflex accent
- "Egrave" => "\xC8", # capital E, grave accent
- "egrave" => "\xE8", # small e, grave accent
- "ETH" => "\xD0", # capital Eth, Icelandic
- "eth" => "\xF0", # small eth, Icelandic
- "Euml" => "\xCB", # capital E, dieresis or umlaut mark
- "euml" => "\xEB", # small e, dieresis or umlaut mark
- "Iacute" => "\xCD", # capital I, acute accent
- "iacute" => "\xED", # small i, acute accent
- "Icirc" => "\xCE", # capital I, circumflex accent
- "icirc" => "\xEE", # small i, circumflex accent
- "Igrave" => "\xCD", # capital I, grave accent
- "igrave" => "\xED", # small i, grave accent
- "Iuml" => "\xCF", # capital I, dieresis or umlaut mark
- "iuml" => "\xEF", # small i, dieresis or umlaut mark
- "Ntilde" => "\xD1", # capital N, tilde
- "ntilde" => "\xF1", # small n, tilde
- "Oacute" => "\xD3", # capital O, acute accent
- "oacute" => "\xF3", # small o, acute accent
- "Ocirc" => "\xD4", # capital O, circumflex accent
- "ocirc" => "\xF4", # small o, circumflex accent
- "Ograve" => "\xD2", # capital O, grave accent
- "ograve" => "\xF2", # small o, grave accent
- "Oslash" => "\xD8", # capital O, slash
- "oslash" => "\xF8", # small o, slash
- "Otilde" => "\xD5", # capital O, tilde
- "otilde" => "\xF5", # small o, tilde
- "Ouml" => "\xD6", # capital O, dieresis or umlaut mark
- "ouml" => "\xF6", # small o, dieresis or umlaut mark
- "szlig" => "\xDF", # small sharp s, German (sz ligature)
- "THORN" => "\xDE", # capital THORN, Icelandic
- "thorn" => "\xFE", # small thorn, Icelandic
- "Uacute" => "\xDA", # capital U, acute accent
- "uacute" => "\xFA", # small u, acute accent
- "Ucirc" => "\xDB", # capital U, circumflex accent
- "ucirc" => "\xFB", # small u, circumflex accent
- "Ugrave" => "\xD9", # capital U, grave accent
- "ugrave" => "\xF9", # small u, grave accent
- "Uuml" => "\xDC", # capital U, dieresis or umlaut mark
- "uuml" => "\xFC", # small u, dieresis or umlaut mark
- "Yacute" => "\xDD", # capital Y, acute accent
- "yacute" => "\xFD", # small y, acute accent
- "yuml" => "\xFF", # small y, dieresis or umlaut mark
-
- "lchevron" => "\xAB", # left chevron (double less than)
- "rchevron" => "\xBB", # right chevron (double greater than)
-);
-
-
-############################################################################
-# Initialization
-############################################################################
-
-# Initialize the object. Must be sure to call our parent initializer.
-sub initialize {
- my $self = shift;
-
- $$self{alt} = 0 unless defined $$self{alt};
- $$self{indent} = 4 unless defined $$self{indent};
- $$self{loose} = 0 unless defined $$self{loose};
- $$self{sentence} = 0 unless defined $$self{sentence};
- $$self{width} = 76 unless defined $$self{width};
-
- $$self{INDENTS} = []; # Stack of indentations.
- $$self{MARGIN} = $$self{indent}; # Current left margin in spaces.
-
- return $self->SUPER::initialize;
-}
-
-
-############################################################################
-# Core overrides
-############################################################################
-
-# Called for each command paragraph. Gets the command, the associated
-# paragraph, the line number, and a Pod::Paragraph object. Just dispatches
-# the command to a method named the same as the command. =cut is handled
-# internally by Pod::Parser.
-sub command {
- my $self = shift;
- my $command = shift;
- return if $command eq 'pod';
- return if ($$self{EXCLUDE} && $command ne 'end');
- if (defined $$self{ITEM}) {
- $self->item ("\n");
- local $_ = "\n";
- $self->output($_) if($command eq 'back');
- }
- $command = 'cmd_' . $command;
- return $self->$command (@_);
-}
-
-# Called for a verbatim paragraph. Gets the paragraph, the line number, and
-# a Pod::Paragraph object. Just output it verbatim, but with tabs converted
-# to spaces.
-sub verbatim {
- my $self = shift;
- return if $$self{EXCLUDE};
- $self->item if defined $$self{ITEM};
- local $_ = shift;
- return if /^\s*$/;
- s/^(\s*\S+)/(' ' x $$self{MARGIN}) . $1/gme;
- return $self->output($_);
-}
-
-# Called for a regular text block. Gets the paragraph, the line number, and
-# a Pod::Paragraph object. Perform interpolation and output the results.
-sub textblock {
- my $self = shift;
- return if $$self{EXCLUDE};
- if($$self{VERBATIM}) {
- $self->output($_[0]);
- return;
- }
- local $_ = shift;
- my $line = shift;
-
- # Perform a little magic to collapse multiple L<> references. This is
- # here mostly for backwards-compatibility. We'll just rewrite the whole
- # thing into actual text at this part, bypassing the whole internal
- # sequence parsing thing.
- s{
- (
- L< # A link of the form L</something>.
- /
- (
- [:\w]+ # The item has to be a simple word...
- (\(\))? # ...or simple function.
- )
- >
- (
- ,?\s+(and\s+)? # Allow lots of them, conjuncted.
- L<
- /
- (
- [:\w]+
- (\(\))?
- )
- >
- )+
- )
- } {
- local $_ = $1;
- s%L</([^>]+)>%$1%g;
- my @items = split /(?:,?\s+(?:and\s+)?)/;
- my $string = "the ";
- my $i;
- for ($i = 0; $i < @items; $i++) {
- $string .= $items[$i];
- $string .= ", " if @items > 2 && $i != $#items;
- $string .= " and " if ($i == $#items - 1);
- }
- $string .= " entries elsewhere in this document";
- $string;
- }gex;
-
- # Now actually interpolate and output the paragraph.
- $_ = $self->interpolate ($_, $line);
- s/\s*$/\n/s;
- if (defined $$self{ITEM}) {
- $self->item ($_ . "\n");
- } else {
- $self->output ($self->reformat ($_ . "\n"));
- }
-}
-
-# Called for an interior sequence. Gets the command, argument, and a
-# Pod::InteriorSequence object and is expected to return the resulting text.
-# Calls code, bold, italic, file, and link to handle those types of
-# sequences, and handles S<>, E<>, X<>, and Z<> directly.
-sub interior_sequence {
- my $self = shift;
- my $command = shift;
- local $_ = shift;
- return '' if ($command eq 'X' || $command eq 'Z');
-
- # Expand escapes into the actual character now, carping if invalid.
- if ($command eq 'E') {
- return $ESCAPES{$_} if defined $ESCAPES{$_};
- carp "Unknown escape: E<$_>";
- return "E<$_>";
- }
-
- # For all the other sequences, empty content produces no output.
- return if $_ eq '';
-
- # For S<>, compress all internal whitespace and then map spaces to \01.
- # When we output the text, we'll map this back.
- if ($command eq 'S') {
- s/\s{2,}/ /g;
- tr/ /\01/;
- return $_;
- }
-
- # Anything else needs to get dispatched to another method.
- if ($command eq 'B') { return $self->seq_b ($_) }
- elsif ($command eq 'C') { return $self->seq_c ($_) }
- elsif ($command eq 'F') { return $self->seq_f ($_) }
- elsif ($command eq 'I') { return $self->seq_i ($_) }
- elsif ($command eq 'L') { return $self->seq_l ($_) }
- else { carp "Unknown sequence $command<$_>" }
-}
-
-# Called for each paragraph that's actually part of the POD. We take
-# advantage of this opportunity to untabify the input.
-sub preprocess_paragraph {
- my $self = shift;
- local $_ = shift;
- 1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;
- return $_;
-}
-
-
-############################################################################
-# Command paragraphs
-############################################################################
-
-# All command paragraphs take the paragraph and the line number.
-
-# First level heading.
-sub cmd_head1 {
- my $self = shift;
- local $_ = shift;
- s/\s+$//s;
- $_ = $self->interpolate ($_, shift);
- if ($$self{alt}) {
- $self->output ("\n==== $_ ====\n\n");
- } else {
- $_ .= "\n" if $$self{loose};
- $self->output ($_ . "\n");
- }
-}
-
-# Second level heading.
-sub cmd_head2 {
- my $self = shift;
- local $_ = shift;
- s/\s+$//s;
- $_ = $self->interpolate ($_, shift);
- if ($$self{alt}) {
- $self->output ("\n== $_ ==\n\n");
- } else {
- $_ .= "\n" if $$self{loose};
- $self->output (' ' x ($$self{indent} / 2) . $_ . "\n");
- }
-}
-
-# third level heading - not strictly perlpodspec compliant
-sub cmd_head3 {
- my $self = shift;
- local $_ = shift;
- s/\s+$//s;
- $_ = $self->interpolate ($_, shift);
- if ($$self{alt}) {
- $self->output ("\n= $_ =\n");
- } else {
- $_ .= "\n" if $$self{loose};
- $self->output (' ' x ($$self{indent}) . $_ . "\n");
- }
-}
-
-# fourth level heading - not strictly perlpodspec compliant
-# just like head3
-*cmd_head4 = \&cmd_head3;
-
-# Start a list.
-sub cmd_over {
- my $self = shift;
- local $_ = shift;
- unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }
- push (@{ $$self{INDENTS} }, $$self{MARGIN});
- $$self{MARGIN} += ($_ + 0);
-}
-
-# End a list.
-sub cmd_back {
- my $self = shift;
- $$self{MARGIN} = pop @{ $$self{INDENTS} };
- unless (defined $$self{MARGIN}) {
- carp 'Unmatched =back';
- $$self{MARGIN} = $$self{indent};
- }
-}
-
-# An individual list item.
-sub cmd_item {
- my $self = shift;
- if (defined $$self{ITEM}) { $self->item }
- local $_ = shift;
- s/\s+$//s;
- $$self{ITEM} = $self->interpolate ($_);
-}
-
-# Begin a block for a particular translator. Setting VERBATIM triggers
-# special handling in textblock().
-sub cmd_begin {
- my $self = shift;
- local $_ = shift;
- my ($kind) = /^(\S+)/ or return;
- if ($kind eq 'text') {
- $$self{VERBATIM} = 1;
- } else {
- $$self{EXCLUDE} = 1;
- }
-}
-
-# End a block for a particular translator. We assume that all =begin/=end
-# pairs are properly closed.
-sub cmd_end {
- my $self = shift;
- $$self{EXCLUDE} = 0;
- $$self{VERBATIM} = 0;
-}
-
-# One paragraph for a particular translator. Ignore it unless it's intended
-# for text, in which case we treat it as a verbatim text block.
-sub cmd_for {
- my $self = shift;
- local $_ = shift;
- my $line = shift;
- return unless s/^text\b[ \t]*\n?//;
- $self->verbatim ($_, $line);
-}
-
-
-############################################################################
-# Interior sequences
-############################################################################
-
-# The simple formatting ones. These are here mostly so that subclasses can
-# override them and do more complicated things.
-sub seq_b { return $_[0]{alt} ? "``$_[1]''" : $_[1] }
-sub seq_c { return $_[0]{alt} ? "``$_[1]''" : "`$_[1]'" }
-sub seq_f { return $_[0]{alt} ? "\"$_[1]\"" : $_[1] }
-sub seq_i { return '*' . $_[1] . '*' }
-
-# The complicated one. Handle links. Since this is plain text, we can't
-# actually make any real links, so this is all to figure out what text we
-# print out.
-sub seq_l {
- my $self = shift;
- local $_ = shift;
-
- # Smash whitespace in case we were split across multiple lines.
- s/\s+/ /g;
-
- # If we were given any explicit text, just output it.
- if (/^([^|]+)\|/) { return $1 }
-
- # Okay, leading and trailing whitespace isn't important; get rid of it.
- s/^\s+//;
- s/\s+$//;
-
- # Default to using the whole content of the link entry as a section
- # name. Note that L<manpage/> forces a manpage interpretation, as does
- # something looking like L<manpage(section)>. The latter is an
- # enhancement over the original Pod::Text.
- my ($manpage, $section) = ('', $_);
- if (/^(?:https?|ftp|news):/) {
- # a URL
- return $_;
- } elsif (/^"\s*(.*?)\s*"$/) {
- $section = '"' . $1 . '"';
- } elsif (m/^[-:.\w]+(?:\(\S+\))?$/) {
- ($manpage, $section) = ($_, '');
- } elsif (m{/}) {
- ($manpage, $section) = split (/\s*\/\s*/, $_, 2);
- }
-
- my $text = '';
- # Now build the actual output text.
- if (!length $section) {
- $text = "the $manpage manpage" if length $manpage;
- } elsif ($section =~ /^[:\w]+(?:\(\))?/) {
- $text .= 'the ' . $section . ' entry';
- $text .= (length $manpage) ? " in the $manpage manpage"
- : ' elsewhere in this document';
- } else {
- $section =~ s/^\"\s*//;
- $section =~ s/\s*\"$//;
- $text .= 'the section on "' . $section . '"';
- $text .= " in the $manpage manpage" if length $manpage;
- }
- return $text;
-}
-
-
-############################################################################
-# List handling
-############################################################################
-
-# This method is called whenever an =item command is complete (in other
-# words, we've seen its associated paragraph or know for certain that it
-# doesn't have one). It gets the paragraph associated with the item as an
-# argument. If that argument is empty, just output the item tag; if it
-# contains a newline, output the item tag followed by the newline.
-# Otherwise, see if there's enough room for us to output the item tag in the
-# margin of the text or if we have to put it on a separate line.
-sub item {
- my $self = shift;
- local $_ = shift;
- my $tag = $$self{ITEM};
- unless (defined $tag) {
- carp 'item called without tag';
- return;
- }
- undef $$self{ITEM};
- my $indent = $$self{INDENTS}[-1];
- unless (defined $indent) { $indent = $$self{indent} }
- my $space = ' ' x $indent;
- $space =~ s/^ /:/ if $$self{alt};
- if (!$_ || /^\s+$/ || ($$self{MARGIN} - $indent < length ($tag) + 1)) {
- my $margin = $$self{MARGIN};
- $$self{MARGIN} = $indent;
- my $output = $self->reformat ($tag);
- $output =~ s/\n*$/\n/;
- $self->output ($output);
- $$self{MARGIN} = $margin;
- $self->output ($self->reformat ($_)) if /\S/;
- } else {
- $_ = $self->reformat ($_);
- s/^ /:/ if ($$self{alt} && $indent > 0);
- my $tagspace = ' ' x length $tag;
- s/^($space)$tagspace/$1$tag/ or carp 'Bizarre space in item';
- $self->output ($_);
- }
-}
-
-
-############################################################################
-# Output formatting
-############################################################################
-
-# Wrap a line, indenting by the current left margin. We can't use
-# Text::Wrap because it plays games with tabs. We can't use formline, even
-# though we'd really like to, because it screws up non-printing characters.
-# So we have to do the wrapping ourselves.
-sub wrap {
- my $self = shift;
- local $_ = shift;
- my $output = '';
- my $spaces = ' ' x $$self{MARGIN};
- my $width = $$self{width} - $$self{MARGIN};
- while (length > $width) {
- if (s/^([^\n]{0,$width})\s+// || s/^([^\n]{$width})//) {
- $output .= $spaces . $1 . "\n";
- } else {
- last;
- }
- }
- $output .= $spaces . $_;
- $output =~ s/\s+$/\n\n/;
- return $output;
-}
-
-# Reformat a paragraph of text for the current margin. Takes the text to
-# reformat and returns the formatted text.
-sub reformat {
- my $self = shift;
- local $_ = shift;
-
- # If we're trying to preserve two spaces after sentences, do some
- # munging to support that. Otherwise, smash all repeated whitespace.
- if ($$self{sentence}) {
- s/ +$//mg;
- s/\.\n/. \n/g;
- s/\n/ /g;
- s/ +/ /g;
- } else {
- s/\s+/ /g;
- }
- return $self->wrap($_);
-}
-
-# Output text to the output device.
-sub output { $_[1] =~ tr/\01/ /; print { $_[0]->output_handle } $_[1] }
-
-
-############################################################################
-# Backwards compatibility
-############################################################################
-
-# The old Pod::Text module did everything in a pod2text() function. This
-# tries to provide the same interface for legacy applications.
-sub pod2text {
- my @args;
-
- # This is really ugly; I hate doing option parsing in the middle of a
- # module. But the old Pod::Text module supported passing flags to its
- # entry function, so handle -a and -<number>.
- while ($_[0] =~ /^-/) {
- my $flag = shift;
- if ($flag eq '-a') { push (@args, alt => 1) }
- elsif ($flag =~ /^-(\d+)$/) { push (@args, width => $1) }
- else {
- unshift (@_, $flag);
- last;
- }
- }
-
- # Now that we know what arguments we're using, create the parser.
- my $parser = Pod::PlainText->new (@args);
-
- # If two arguments were given, the second argument is going to be a file
- # handle. That means we want to call parse_from_filehandle(), which
- # means we need to turn the first argument into a file handle. Magic
- # open will handle the <&STDIN case automagically.
- if (defined $_[1]) {
- my $infh;
- if ($] < 5.006) {
- $infh = gensym();
- }
- unless (open ($infh, $_[0])) {
- croak ("Can't open $_[0] for reading: $!\n");
- }
- $_[0] = $infh;
- return $parser->parse_from_filehandle (@_);
- } else {
- return $parser->parse_from_file (@_);
- }
-}
-
-
-############################################################################
-# Module return value and documentation
-############################################################################
-
-1;
-__END__
-
-=head1 NAME
-
-Pod::PlainText - Convert POD data to formatted ASCII text
-
-=head1 SYNOPSIS
-
- use Pod::PlainText;
- my $parser = Pod::PlainText->new (sentence => 0, width => 78);
-
- # Read POD from STDIN and write to STDOUT.
- $parser->parse_from_filehandle;
-
- # Read POD from file.pod and write to file.txt.
- $parser->parse_from_file ('file.pod', 'file.txt');
-
-=head1 DESCRIPTION
-
-Pod::PlainText is a module that can convert documentation in the POD format (the
-preferred language for documenting Perl) into formatted ASCII. It uses no
-special formatting controls or codes whatsoever, and its output is therefore
-suitable for nearly any device.
-
-As a derived class from Pod::Parser, Pod::PlainText supports the same methods and
-interfaces. See L<Pod::Parser> for all the details; briefly, one creates a
-new parser with C<Pod::PlainText-E<gt>new()> and then calls either
-parse_from_filehandle() or parse_from_file().
-
-new() can take options, in the form of key/value pairs, that control the
-behavior of the parser. The currently recognized options are:
-
-=over 4
-
-=item alt
-
-If set to a true value, selects an alternate output format that, among other
-things, uses a different heading style and marks C<=item> entries with a
-colon in the left margin. Defaults to false.
-
-=item indent
-
-The number of spaces to indent regular text, and the default indentation for
-C<=over> blocks. Defaults to 4.
-
-=item loose
-
-If set to a true value, a blank line is printed after a C<=headN> headings.
-If set to false (the default), no blank line is printed after C<=headN>.
-This is the default because it's the expected formatting for manual pages;
-if you're formatting arbitrary text documents, setting this to true may
-result in more pleasing output.
-
-=item sentence
-
-If set to a true value, Pod::PlainText will assume that each sentence ends in two
-spaces, and will try to preserve that spacing. If set to false, all
-consecutive whitespace in non-verbatim paragraphs is compressed into a
-single space. Defaults to true.
-
-=item width
-
-The column at which to wrap text on the right-hand side. Defaults to 76.
-
-=back
-
-The standard Pod::Parser method parse_from_filehandle() takes up to two
-arguments, the first being the file handle to read POD from and the second
-being the file handle to write the formatted output to. The first defaults
-to STDIN if not given, and the second defaults to STDOUT. The method
-parse_from_file() is almost identical, except that its two arguments are the
-input and output disk files instead. See L<Pod::Parser> for the specific
-details.
-
-=head1 DIAGNOSTICS
-
-=over 4
-
-=item Bizarre space in item
-
-(W) Something has gone wrong in internal C<=item> processing. This message
-indicates a bug in Pod::PlainText; you should never see it.
-
-=item Can't open %s for reading: %s
-
-(F) Pod::PlainText was invoked via the compatibility mode pod2text() interface
-and the input file it was given could not be opened.
-
-=item Unknown escape: %s
-
-(W) The POD source contained an C<EE<lt>E<gt>> escape that Pod::PlainText didn't
-know about.
-
-=item Unknown sequence: %s
-
-(W) The POD source contained a non-standard internal sequence (something of
-the form C<XE<lt>E<gt>>) that Pod::PlainText didn't know about.
-
-=item Unmatched =back
-
-(W) Pod::PlainText encountered a C<=back> command that didn't correspond to an
-C<=over> command.
-
-=back
-
-=head1 RESTRICTIONS
-
-Embedded Ctrl-As (octal 001) in the input will be mapped to spaces on
-output, due to an internal implementation detail.
-
-=head1 NOTES
-
-This is a replacement for an earlier Pod::Text module written by Tom
-Christiansen. It has a revamped interface, since it now uses Pod::Parser,
-but an interface roughly compatible with the old Pod::Text::pod2text()
-function is still available. Please change to the new calling convention,
-though.
-
-The original Pod::Text contained code to do formatting via termcap
-sequences, although it wasn't turned on by default and it was problematic to
-get it to work at all. This rewrite doesn't even try to do that, but a
-subclass of it does. Look for L<Pod::Text::Termcap|Pod::Text::Termcap>.
-
-=head1 SEE ALSO
-
-L<Pod::Parser|Pod::Parser>, L<Pod::Text::Termcap|Pod::Text::Termcap>,
-pod2text(1)
-
-=head1 AUTHOR
-
-Please report bugs using L<http://rt.cpan.org>.
-
-Russ Allbery E<lt>rra@stanford.eduE<gt>, based I<very> heavily on the
-original Pod::Text by Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> and
-its conversion to Pod::Parser by Brad Appleton
-E<lt>bradapp@enteract.comE<gt>.
-
-=cut
diff --git a/lib/Pod/Select.pm b/lib/Pod/Select.pm
deleted file mode 100644
index 4724cb79cf..0000000000
--- a/lib/Pod/Select.pm
+++ /dev/null
@@ -1,746 +0,0 @@
-#############################################################################
-# Pod/Select.pm -- function to select portions of POD docs
-#
-# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
-# This file is part of "PodParser". PodParser is free software;
-# you can redistribute it and/or modify it under the same terms
-# as Perl itself.
-#############################################################################
-
-package Pod::Select;
-use strict;
-
-use vars qw($VERSION @ISA @EXPORT $MAX_HEADING_LEVEL %myData @section_headings @selected_sections);
-$VERSION = '1.36'; ## Current version of this package
-require 5.005; ## requires this Perl version or later
-
-#############################################################################
-
-=head1 NAME
-
-Pod::Select, podselect() - extract selected sections of POD from input
-
-=head1 SYNOPSIS
-
- use Pod::Select;
-
- ## Select all the POD sections for each file in @filelist
- ## and print the result on standard output.
- podselect(@filelist);
-
- ## Same as above, but write to tmp.out
- podselect({-output => "tmp.out"}, @filelist):
-
- ## Select from the given filelist, only those POD sections that are
- ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.
- podselect({-sections => ["NAME|SYNOPSIS", "OPTIONS"]}, @filelist):
-
- ## Select the "DESCRIPTION" section of the PODs from STDIN and write
- ## the result to STDERR.
- podselect({-output => ">&STDERR", -sections => ["DESCRIPTION"]}, \*STDIN);
-
-or
-
- use Pod::Select;
-
- ## Create a parser object for selecting POD sections from the input
- $parser = new Pod::Select();
-
- ## Select all the POD sections for each file in @filelist
- ## and print the result to tmp.out.
- $parser->parse_from_file("<&STDIN", "tmp.out");
-
- ## Select from the given filelist, only those POD sections that are
- ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.
- $parser->select("NAME|SYNOPSIS", "OPTIONS");
- for (@filelist) { $parser->parse_from_file($_); }
-
- ## Select the "DESCRIPTION" and "SEE ALSO" sections of the PODs from
- ## STDIN and write the result to STDERR.
- $parser->select("DESCRIPTION");
- $parser->add_selection("SEE ALSO");
- $parser->parse_from_filehandle(\*STDIN, \*STDERR);
-
-=head1 REQUIRES
-
-perl5.005, Pod::Parser, Exporter, Carp
-
-=head1 EXPORTS
-
-podselect()
-
-=head1 DESCRIPTION
-
-B<podselect()> is a function which will extract specified sections of
-pod documentation from an input stream. This ability is provided by the
-B<Pod::Select> module which is a subclass of B<Pod::Parser>.
-B<Pod::Select> provides a method named B<select()> to specify the set of
-POD sections to select for processing/printing. B<podselect()> merely
-creates a B<Pod::Select> object and then invokes the B<podselect()>
-followed by B<parse_from_file()>.
-
-=head1 SECTION SPECIFICATIONS
-
-B<podselect()> and B<Pod::Select::select()> may be given one or more
-"section specifications" to restrict the text processed to only the
-desired set of sections and their corresponding subsections. A section
-specification is a string containing one or more Perl-style regular
-expressions separated by forward slashes ("/"). If you need to use a
-forward slash literally within a section title you can escape it with a
-backslash ("\/").
-
-The formal syntax of a section specification is:
-
-=over 4
-
-=item *
-
-I<head1-title-regex>/I<head2-title-regex>/...
-
-=back
-
-Any omitted or empty regular expressions will default to ".*".
-Please note that each regular expression given is implicitly
-anchored by adding "^" and "$" to the beginning and end. Also, if a
-given regular expression starts with a "!" character, then the
-expression is I<negated> (so C<!foo> would match anything I<except>
-C<foo>).
-
-Some example section specifications follow.
-
-=over 4
-
-=item *
-
-Match the C<NAME> and C<SYNOPSIS> sections and all of their subsections:
-
-C<NAME|SYNOPSIS>
-
-=item *
-
-Match only the C<Question> and C<Answer> subsections of the C<DESCRIPTION>
-section:
-
-C<DESCRIPTION/Question|Answer>
-
-=item *
-
-Match the C<Comments> subsection of I<all> sections:
-
-C</Comments>
-
-=item *
-
-Match all subsections of C<DESCRIPTION> I<except> for C<Comments>:
-
-C<DESCRIPTION/!Comments>
-
-=item *
-
-Match the C<DESCRIPTION> section but do I<not> match any of its subsections:
-
-C<DESCRIPTION/!.+>
-
-=item *
-
-Match all top level sections but none of their subsections:
-
-C</!.+>
-
-=back
-
-=begin _NOT_IMPLEMENTED_
-
-=head1 RANGE SPECIFICATIONS
-
-B<podselect()> and B<Pod::Select::select()> may be given one or more
-"range specifications" to restrict the text processed to only the
-desired ranges of paragraphs in the desired set of sections. A range
-specification is a string containing a single Perl-style regular
-expression (a regex), or else two Perl-style regular expressions
-(regexs) separated by a ".." (Perl's "range" operator is "..").
-The regexs in a range specification are delimited by forward slashes
-("/"). If you need to use a forward slash literally within a regex you
-can escape it with a backslash ("\/").
-
-The formal syntax of a range specification is:
-
-=over 4
-
-=item *
-
-/I<start-range-regex>/[../I<end-range-regex>/]
-
-=back
-
-Where each the item inside square brackets (the ".." followed by the
-end-range-regex) is optional. Each "range-regex" is of the form:
-
- =cmd-expr text-expr
-
-Where I<cmd-expr> is intended to match the name of one or more POD
-commands, and I<text-expr> is intended to match the paragraph text for
-the command. If a range-regex is supposed to match a POD command, then
-the first character of the regex (the one after the initial '/')
-absolutely I<must> be a single '=' character; it may not be anything
-else (not even a regex meta-character) if it is supposed to match
-against the name of a POD command.
-
-If no I<=cmd-expr> is given then the text-expr will be matched against
-plain textblocks unless it is preceded by a space, in which case it is
-matched against verbatim text-blocks. If no I<text-expr> is given then
-only the command-portion of the paragraph is matched against.
-
-Note that these two expressions are each implicitly anchored. This
-means that when matching against the command-name, there will be an
-implicit '^' and '$' around the given I<=cmd-expr>; and when matching
-against the paragraph text there will be an implicit '\A' and '\Z'
-around the given I<text-expr>.
-
-Unlike with section-specs, the '!' character does I<not> have any special
-meaning (negation or otherwise) at the beginning of a range-spec!
-
-Some example range specifications follow.
-
-=over 4
-
-=item
-Match all C<=for html> paragraphs:
-
-C</=for html/>
-
-=item
-Match all paragraphs between C<=begin html> and C<=end html>
-(note that this will I<not> work correctly if such sections
-are nested):
-
-C</=begin html/../=end html/>
-
-=item
-Match all paragraphs between the given C<=item> name until the end of the
-current section:
-
-C</=item mine/../=head\d/>
-
-=item
-Match all paragraphs between the given C<=item> until the next item, or
-until the end of the itemized list (note that this will I<not> work as
-desired if the item contains an itemized list nested within it):
-
-C</=item mine/../=(item|back)/>
-
-=back
-
-=end _NOT_IMPLEMENTED_
-
-=cut
-
-#############################################################################
-
-#use diagnostics;
-use Carp;
-use Pod::Parser 1.04;
-
-@ISA = qw(Pod::Parser);
-@EXPORT = qw(&podselect);
-
-## Maximum number of heading levels supported for '=headN' directives
-*MAX_HEADING_LEVEL = \3;
-
-#############################################################################
-
-=head1 OBJECT METHODS
-
-The following methods are provided in this module. Each one takes a
-reference to the object itself as an implicit first parameter.
-
-=cut
-
-##---------------------------------------------------------------------------
-
-## =begin _PRIVATE_
-##
-## =head1 B<_init_headings()>
-##
-## Initialize the current set of active section headings.
-##
-## =cut
-##
-## =end _PRIVATE_
-
-sub _init_headings {
- my $self = shift;
- local *myData = $self;
-
- ## Initialize current section heading titles if necessary
- unless (defined $myData{_SECTION_HEADINGS}) {
- local *section_headings = $myData{_SECTION_HEADINGS} = [];
- for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
- $section_headings[$i] = '';
- }
- }
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<curr_headings()>
-
- ($head1, $head2, $head3, ...) = $parser->curr_headings();
- $head1 = $parser->curr_headings(1);
-
-This method returns a list of the currently active section headings and
-subheadings in the document being parsed. The list of headings returned
-corresponds to the most recently parsed paragraph of the input.
-
-If an argument is given, it must correspond to the desired section
-heading number, in which case only the specified section heading is
-returned. If there is no current section heading at the specified
-level, then C<undef> is returned.
-
-=cut
-
-sub curr_headings {
- my $self = shift;
- $self->_init_headings() unless (defined $self->{_SECTION_HEADINGS});
- my @headings = @{ $self->{_SECTION_HEADINGS} };
- return (@_ > 0 and $_[0] =~ /^\d+$/) ? $headings[$_[0] - 1] : @headings;
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<select()>
-
- $parser->select($section_spec1,$section_spec2,...);
-
-This method is used to select the particular sections and subsections of
-POD documentation that are to be printed and/or processed. The existing
-set of selected sections is I<replaced> with the given set of sections.
-See B<add_selection()> for adding to the current set of selected
-sections.
-
-Each of the C<$section_spec> arguments should be a section specification
-as described in L<"SECTION SPECIFICATIONS">. The section specifications
-are parsed by this method and the resulting regular expressions are
-stored in the invoking object.
-
-If no C<$section_spec> arguments are given, then the existing set of
-selected sections is cleared out (which means C<all> sections will be
-processed).
-
-This method should I<not> normally be overridden by subclasses.
-
-=cut
-
-sub select {
- my ($self, @sections) = @_;
- local *myData = $self;
- local $_;
-
-### NEED TO DISCERN A SECTION-SPEC FROM A RANGE-SPEC (look for m{^/.+/$}?)
-
- ##---------------------------------------------------------------------
- ## The following is a blatant hack for backward compatibility, and for
- ## implementing add_selection(). If the *first* *argument* is the
- ## string "+", then the remaining section specifications are *added*
- ## to the current set of selections; otherwise the given section
- ## specifications will *replace* the current set of selections.
- ##
- ## This should probably be fixed someday, but for the present time,
- ## it seems incredibly unlikely that "+" would ever correspond to
- ## a legitimate section heading
- ##---------------------------------------------------------------------
- my $add = ($sections[0] eq '+') ? shift(@sections) : '';
-
- ## Reset the set of sections to use
- unless (@sections) {
- delete $myData{_SELECTED_SECTIONS} unless ($add);
- return;
- }
- $myData{_SELECTED_SECTIONS} = []
- unless ($add && exists $myData{_SELECTED_SECTIONS});
- local *selected_sections = $myData{_SELECTED_SECTIONS};
-
- ## Compile each spec
- for my $spec (@sections) {
- if ( defined($_ = _compile_section_spec($spec)) ) {
- ## Store them in our sections array
- push(@selected_sections, $_);
- }
- else {
- carp qq{Ignoring section spec "$spec"!\n};
- }
- }
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<add_selection()>
-
- $parser->add_selection($section_spec1,$section_spec2,...);
-
-This method is used to add to the currently selected sections and
-subsections of POD documentation that are to be printed and/or
-processed. See <select()> for replacing the currently selected sections.
-
-Each of the C<$section_spec> arguments should be a section specification
-as described in L<"SECTION SPECIFICATIONS">. The section specifications
-are parsed by this method and the resulting regular expressions are
-stored in the invoking object.
-
-This method should I<not> normally be overridden by subclasses.
-
-=cut
-
-sub add_selection {
- my $self = shift;
- return $self->select('+', @_);
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<clear_selections()>
-
- $parser->clear_selections();
-
-This method takes no arguments, it has the exact same effect as invoking
-<select()> with no arguments.
-
-=cut
-
-sub clear_selections {
- my $self = shift;
- return $self->select();
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<match_section()>
-
- $boolean = $parser->match_section($heading1,$heading2,...);
-
-Returns a value of true if the given section and subsection heading
-titles match any of the currently selected section specifications in
-effect from prior calls to B<select()> and B<add_selection()> (or if
-there are no explicitly selected/deselected sections).
-
-The arguments C<$heading1>, C<$heading2>, etc. are the heading titles of
-the corresponding sections, subsections, etc. to try and match. If
-C<$headingN> is omitted then it defaults to the current corresponding
-section heading title in the input.
-
-This method should I<not> normally be overridden by subclasses.
-
-=cut
-
-sub match_section {
- my $self = shift;
- my (@headings) = @_;
- local *myData = $self;
-
- ## Return true if no restrictions were explicitly specified
- my $selections = (exists $myData{_SELECTED_SECTIONS})
- ? $myData{_SELECTED_SECTIONS} : undef;
- return 1 unless ((defined $selections) && @{$selections});
-
- ## Default any unspecified sections to the current one
- my @current_headings = $self->curr_headings();
- for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
- (defined $headings[$i]) or $headings[$i] = $current_headings[$i];
- }
-
- ## Look for a match against the specified section expressions
- for my $section_spec ( @{$selections} ) {
- ##------------------------------------------------------
- ## Each portion of this spec must match in order for
- ## the spec to be matched. So we will start with a
- ## match-value of 'true' and logically 'and' it with
- ## the results of matching a given element of the spec.
- ##------------------------------------------------------
- my $match = 1;
- for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
- my $regex = $section_spec->[$i];
- my $negated = ($regex =~ s/^\!//);
- $match &= ($negated ? ($headings[$i] !~ /${regex}/)
- : ($headings[$i] =~ /${regex}/));
- last unless ($match);
- }
- return 1 if ($match);
- }
- return 0; ## no match
-}
-
-##---------------------------------------------------------------------------
-
-=head1 B<is_selected()>
-
- $boolean = $parser->is_selected($paragraph);
-
-This method is used to determine if the block of text given in
-C<$paragraph> falls within the currently selected set of POD sections
-and subsections to be printed or processed. This method is also
-responsible for keeping track of the current input section and
-subsections. It is assumed that C<$paragraph> is the most recently read
-(but not yet processed) input paragraph.
-
-The value returned will be true if the C<$paragraph> and the rest of the
-text in the same section as C<$paragraph> should be selected (included)
-for processing; otherwise a false value is returned.
-
-=cut
-
-sub is_selected {
- my ($self, $paragraph) = @_;
- local $_;
- local *myData = $self;
-
- $self->_init_headings() unless (defined $myData{_SECTION_HEADINGS});
-
- ## Keep track of current sections levels and headings
- $_ = $paragraph;
- if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*?)\s*$/)
- {
- ## This is a section heading command
- my ($level, $heading) = ($2, $3);
- $level = 1 + (length($1) / 3) if ((! length $level) || (length $1));
- ## Reset the current section heading at this level
- $myData{_SECTION_HEADINGS}->[$level - 1] = $heading;
- ## Reset subsection headings of this one to empty
- for (my $i = $level; $i < $MAX_HEADING_LEVEL; ++$i) {
- $myData{_SECTION_HEADINGS}->[$i] = '';
- }
- }
-
- return $self->match_section();
-}
-
-#############################################################################
-
-=head1 EXPORTED FUNCTIONS
-
-The following functions are exported by this module. Please note that
-these are functions (not methods) and therefore C<do not> take an
-implicit first argument.
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=head1 B<podselect()>
-
- podselect(\%options,@filelist);
-
-B<podselect> will print the raw (untranslated) POD paragraphs of all
-POD sections in the given input files specified by C<@filelist>
-according to the given options.
-
-If any argument to B<podselect> is a reference to a hash
-(associative array) then the values with the following keys are
-processed as follows:
-
-=over 4
-
-=item B<-output>
-
-A string corresponding to the desired output file (or ">&STDOUT"
-or ">&STDERR"). The default is to use standard output.
-
-=item B<-sections>
-
-A reference to an array of sections specifications (as described in
-L<"SECTION SPECIFICATIONS">) which indicate the desired set of POD
-sections and subsections to be selected from input. If no section
-specifications are given, then all sections of the PODs are used.
-
-=begin _NOT_IMPLEMENTED_
-
-=item B<-ranges>
-
-A reference to an array of range specifications (as described in
-L<"RANGE SPECIFICATIONS">) which indicate the desired range of POD
-paragraphs to be selected from the desired input sections. If no range
-specifications are given, then all paragraphs of the desired sections
-are used.
-
-=end _NOT_IMPLEMENTED_
-
-=back
-
-All other arguments should correspond to the names of input files
-containing POD sections. A file name of "-" or "<&STDIN" will
-be interpreted to mean standard input (which is the default if no
-filenames are given).
-
-=cut
-
-sub podselect {
- my(@argv) = @_;
- my %defaults = ();
- my $pod_parser = new Pod::Select(%defaults);
- my $num_inputs = 0;
- my $output = '>&STDOUT';
- my %opts;
- local $_;
- for (@argv) {
- if (ref($_)) {
- next unless (ref($_) eq 'HASH');
- %opts = (%defaults, %{$_});
-
- ##-------------------------------------------------------------
- ## Need this for backward compatibility since we formerly used
- ## options that were all uppercase words rather than ones that
- ## looked like Unix command-line options.
- ## to be uppercase keywords)
- ##-------------------------------------------------------------
- %opts = map {
- my ($key, $val) = (lc $_, $opts{$_});
- $key =~ s/^(?=\w)/-/;
- $key =~ /^-se[cl]/ and $key = '-sections';
- #! $key eq '-range' and $key .= 's';
- ($key => $val);
- } (keys %opts);
-
- ## Process the options
- (exists $opts{'-output'}) and $output = $opts{'-output'};
-
- ## Select the desired sections
- $pod_parser->select(@{ $opts{'-sections'} })
- if ( (defined $opts{'-sections'})
- && ((ref $opts{'-sections'}) eq 'ARRAY') );
-
- #! ## Select the desired paragraph ranges
- #! $pod_parser->select(@{ $opts{'-ranges'} })
- #! if ( (defined $opts{'-ranges'})
- #! && ((ref $opts{'-ranges'}) eq 'ARRAY') );
- }
- else {
- $pod_parser->parse_from_file($_, $output);
- ++$num_inputs;
- }
- }
- $pod_parser->parse_from_file('-') unless ($num_inputs > 0);
-}
-
-#############################################################################
-
-=head1 PRIVATE METHODS AND DATA
-
-B<Pod::Select> makes uses a number of internal methods and data fields
-which clients should not need to see or use. For the sake of avoiding
-name collisions with client data and methods, these methods and fields
-are briefly discussed here. Determined hackers may obtain further
-information about them by reading the B<Pod::Select> source code.
-
-Private data fields are stored in the hash-object whose reference is
-returned by the B<new()> constructor for this class. The names of all
-private methods and data-fields used by B<Pod::Select> begin with a
-prefix of "_" and match the regular expression C</^_\w+$/>.
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=begin _PRIVATE_
-
-=head1 B<_compile_section_spec()>
-
- $listref = $parser->_compile_section_spec($section_spec);
-
-This function (note it is a function and I<not> a method) takes a
-section specification (as described in L<"SECTION SPECIFICATIONS">)
-given in C<$section_sepc>, and compiles it into a list of regular
-expressions. If C<$section_spec> has no syntax errors, then a reference
-to the list (array) of corresponding regular expressions is returned;
-otherwise C<undef> is returned and an error message is printed (using
-B<carp>) for each invalid regex.
-
-=end _PRIVATE_
-
-=cut
-
-sub _compile_section_spec {
- my ($section_spec) = @_;
- my (@regexs, $negated);
-
- ## Compile the spec into a list of regexs
- local $_ = $section_spec;
- s{\\\\}{\001}g; ## handle escaped backward slashes
- s{\\/}{\002}g; ## handle escaped forward slashes
-
- ## Parse the regexs for the heading titles
- @regexs = split(/\//, $_, $MAX_HEADING_LEVEL);
-
- ## Set default regex for ommitted levels
- for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
- $regexs[$i] = '.*' unless ((defined $regexs[$i])
- && (length $regexs[$i]));
- }
- ## Modify the regexs as needed and validate their syntax
- my $bad_regexs = 0;
- for (@regexs) {
- $_ .= '.+' if ($_ eq '!');
- s{\001}{\\\\}g; ## restore escaped backward slashes
- s{\002}{\\/}g; ## restore escaped forward slashes
- $negated = s/^\!//; ## check for negation
- eval "m{$_}"; ## check regex syntax
- if ($@) {
- ++$bad_regexs;
- carp qq{Bad regular expression /$_/ in "$section_spec": $@\n};
- }
- else {
- ## Add the forward and rear anchors (and put the negator back)
- $_ = '^' . $_ unless (/^\^/);
- $_ = $_ . '$' unless (/\$$/);
- $_ = '!' . $_ if ($negated);
- }
- }
- return (! $bad_regexs) ? [ @regexs ] : undef;
-}
-
-##---------------------------------------------------------------------------
-
-=begin _PRIVATE_
-
-=head2 $self->{_SECTION_HEADINGS}
-
-A reference to an array of the current section heading titles for each
-heading level (note that the first heading level title is at index 0).
-
-=end _PRIVATE_
-
-=cut
-
-##---------------------------------------------------------------------------
-
-=begin _PRIVATE_
-
-=head2 $self->{_SELECTED_SECTIONS}
-
-A reference to an array of references to arrays. Each subarray is a list
-of anchored regular expressions (preceded by a "!" if the expression is to
-be negated). The index of the expression in the subarray should correspond
-to the index of the heading title in C<$self-E<gt>{_SECTION_HEADINGS}>
-that it is to be matched against.
-
-=end _PRIVATE_
-
-=cut
-
-#############################################################################
-
-=head1 SEE ALSO
-
-L<Pod::Parser>
-
-=head1 AUTHOR
-
-Please report bugs using L<http://rt.cpan.org>.
-
-Brad Appleton E<lt>bradapp@enteract.comE<gt>
-
-Based on code for B<pod2text> written by
-Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
-
-=cut
-
-1;
-# vim: ts=4 sw=4 et
diff --git a/lib/Pod/Usage.pm b/lib/Pod/Usage.pm
deleted file mode 100644
index f463fb9c46..0000000000
--- a/lib/Pod/Usage.pm
+++ /dev/null
@@ -1,730 +0,0 @@
-#############################################################################
-# Pod/Usage.pm -- print usage messages for the running script.
-#
-# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
-# This file is part of "PodParser". PodParser is free software;
-# you can redistribute it and/or modify it under the same terms
-# as Perl itself.
-#############################################################################
-
-package Pod::Usage;
-use strict;
-
-use vars qw($VERSION @ISA @EXPORT);
-$VERSION = '1.36'; ## Current version of this package
-require 5.005; ## requires this Perl version or later
-
-=head1 NAME
-
-Pod::Usage, pod2usage() - print a usage message from embedded pod documentation
-
-=head1 SYNOPSIS
-
- use Pod::Usage
-
- my $message_text = "This text precedes the usage message.";
- my $exit_status = 2; ## The exit status to use
- my $verbose_level = 0; ## The verbose level to use
- my $filehandle = \*STDERR; ## The filehandle to write to
-
- pod2usage($message_text);
-
- pod2usage($exit_status);
-
- pod2usage( { -message => $message_text ,
- -exitval => $exit_status ,
- -verbose => $verbose_level,
- -output => $filehandle } );
-
- pod2usage( -msg => $message_text ,
- -exitval => $exit_status ,
- -verbose => $verbose_level,
- -output => $filehandle );
-
- pod2usage( -verbose => 2,
- -noperldoc => 1 )
-
-=head1 ARGUMENTS
-
-B<pod2usage> should be given either a single argument, or a list of
-arguments corresponding to an associative array (a "hash"). When a single
-argument is given, it should correspond to exactly one of the following:
-
-=over 4
-
-=item *
-
-A string containing the text of a message to print I<before> printing
-the usage message
-
-=item *
-
-A numeric value corresponding to the desired exit status
-
-=item *
-
-A reference to a hash
-
-=back
-
-If more than one argument is given then the entire argument list is
-assumed to be a hash. If a hash is supplied (either as a reference or
-as a list) it should contain one or more elements with the following
-keys:
-
-=over 4
-
-=item C<-message>
-
-=item C<-msg>
-
-The text of a message to print immediately prior to printing the
-program's usage message.
-
-=item C<-exitval>
-
-The desired exit status to pass to the B<exit()> function.
-This should be an integer, or else the string "NOEXIT" to
-indicate that control should simply be returned without
-terminating the invoking process.
-
-=item C<-verbose>
-
-The desired level of "verboseness" to use when printing the usage
-message. If the corresponding value is 0, then only the "SYNOPSIS"
-section of the pod documentation is printed. If the corresponding value
-is 1, then the "SYNOPSIS" section, along with any section entitled
-"OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is printed. If the
-corresponding value is 2 or more then the entire manpage is printed.
-
-The special verbosity level 99 requires to also specify the -sections
-parameter; then these sections are extracted (see L<Pod::Select>)
-and printed.
-
-=item C<-sections>
-
-A string representing a selection list for sections to be printed
-when -verbose is set to 99, e.g. C<"NAME|SYNOPSIS|DESCRIPTION|VERSION">.
-
-Alternatively, an array reference of section specifications can be used:
-
- pod2usage(-verbose => 99,
- -sections => [ qw(fred fred/subsection) ] );
-
-=item C<-output>
-
-A reference to a filehandle, or the pathname of a file to which the
-usage message should be written. The default is C<\*STDERR> unless the
-exit value is less than 2 (in which case the default is C<\*STDOUT>).
-
-=item C<-input>
-
-A reference to a filehandle, or the pathname of a file from which the
-invoking script's pod documentation should be read. It defaults to the
-file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).
-
-If you are calling B<pod2usage()> from a module and want to display
-that module's POD, you can use this:
-
- use Pod::Find qw(pod_where);
- pod2usage( -input => pod_where({-inc => 1}, __PACKAGE__) );
-
-=item C<-pathlist>
-
-A list of directory paths. If the input file does not exist, then it
-will be searched for in the given directory list (in the order the
-directories appear in the list). It defaults to the list of directories
-implied by C<$ENV{PATH}>. The list may be specified either by a reference
-to an array, or by a string of directory paths which use the same path
-separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
-MSWin32 and DOS).
-
-=item C<-noperldoc>
-
-By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
-specified. This does not work well e.g. if the script was packed
-with L<PAR>. The -noperldoc option suppresses the external call to
-L<perldoc> and uses the simple text formatter (L<Pod::Text>) to
-output the POD.
-
-=back
-
-=head1 DESCRIPTION
-
-B<pod2usage> will print a usage message for the invoking script (using
-its embedded pod documentation) and then exit the script with the
-desired exit status. The usage message printed may have any one of three
-levels of "verboseness": If the verbose level is 0, then only a synopsis
-is printed. If the verbose level is 1, then the synopsis is printed
-along with a description (if present) of the command line options and
-arguments. If the verbose level is 2, then the entire manual page is
-printed.
-
-Unless they are explicitly specified, the default values for the exit
-status, verbose level, and output stream to use are determined as
-follows:
-
-=over 4
-
-=item *
-
-If neither the exit status nor the verbose level is specified, then the
-default is to use an exit status of 2 with a verbose level of 0.
-
-=item *
-
-If an exit status I<is> specified but the verbose level is I<not>, then the
-verbose level will default to 1 if the exit status is less than 2 and
-will default to 0 otherwise.
-
-=item *
-
-If an exit status is I<not> specified but verbose level I<is> given, then
-the exit status will default to 2 if the verbose level is 0 and will
-default to 1 otherwise.
-
-=item *
-
-If the exit status used is less than 2, then output is printed on
-C<STDOUT>. Otherwise output is printed on C<STDERR>.
-
-=back
-
-Although the above may seem a bit confusing at first, it generally does
-"the right thing" in most situations. This determination of the default
-values to use is based upon the following typical Unix conventions:
-
-=over 4
-
-=item *
-
-An exit status of 0 implies "success". For example, B<diff(1)> exits
-with a status of 0 if the two files have the same contents.
-
-=item *
-
-An exit status of 1 implies possibly abnormal, but non-defective, program
-termination. For example, B<grep(1)> exits with a status of 1 if
-it did I<not> find a matching line for the given regular expression.
-
-=item *
-
-An exit status of 2 or more implies a fatal error. For example, B<ls(1)>
-exits with a status of 2 if you specify an illegal (unknown) option on
-the command line.
-
-=item *
-
-Usage messages issued as a result of bad command-line syntax should go
-to C<STDERR>. However, usage messages issued due to an explicit request
-to print usage (like specifying B<-help> on the command line) should go
-to C<STDOUT>, just in case the user wants to pipe the output to a pager
-(such as B<more(1)>).
-
-=item *
-
-If program usage has been explicitly requested by the user, it is often
-desirable to exit with a status of 1 (as opposed to 0) after issuing
-the user-requested usage message. It is also desirable to give a
-more verbose description of program usage in this case.
-
-=back
-
-B<pod2usage> doesn't force the above conventions upon you, but it will
-use them by default if you don't expressly tell it to do otherwise. The
-ability of B<pod2usage()> to accept a single number or a string makes it
-convenient to use as an innocent looking error message handling function:
-
- use Pod::Usage;
- use Getopt::Long;
-
- ## Parse options
- GetOptions("help", "man", "flag1") || pod2usage(2);
- pod2usage(1) if ($opt_help);
- pod2usage(-verbose => 2) if ($opt_man);
-
- ## Check for too many filenames
- pod2usage("$0: Too many files given.\n") if (@ARGV > 1);
-
-Some user's however may feel that the above "economy of expression" is
-not particularly readable nor consistent and may instead choose to do
-something more like the following:
-
- use Pod::Usage;
- use Getopt::Long;
-
- ## Parse options
- GetOptions("help", "man", "flag1") || pod2usage(-verbose => 0);
- pod2usage(-verbose => 1) if ($opt_help);
- pod2usage(-verbose => 2) if ($opt_man);
-
- ## Check for too many filenames
- pod2usage(-verbose => 2, -message => "$0: Too many files given.\n")
- if (@ARGV > 1);
-
-As with all things in Perl, I<there's more than one way to do it>, and
-B<pod2usage()> adheres to this philosophy. If you are interested in
-seeing a number of different ways to invoke B<pod2usage> (although by no
-means exhaustive), please refer to L<"EXAMPLES">.
-
-=head1 EXAMPLES
-
-Each of the following invocations of C<pod2usage()> will print just the
-"SYNOPSIS" section to C<STDERR> and will exit with a status of 2:
-
- pod2usage();
-
- pod2usage(2);
-
- pod2usage(-verbose => 0);
-
- pod2usage(-exitval => 2);
-
- pod2usage({-exitval => 2, -output => \*STDERR});
-
- pod2usage({-verbose => 0, -output => \*STDERR});
-
- pod2usage(-exitval => 2, -verbose => 0);
-
- pod2usage(-exitval => 2, -verbose => 0, -output => \*STDERR);
-
-Each of the following invocations of C<pod2usage()> will print a message
-of "Syntax error." (followed by a newline) to C<STDERR>, immediately
-followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
-will exit with a status of 2:
-
- pod2usage("Syntax error.");
-
- pod2usage(-message => "Syntax error.", -verbose => 0);
-
- pod2usage(-msg => "Syntax error.", -exitval => 2);
-
- pod2usage({-msg => "Syntax error.", -exitval => 2, -output => \*STDERR});
-
- pod2usage({-msg => "Syntax error.", -verbose => 0, -output => \*STDERR});
-
- pod2usage(-msg => "Syntax error.", -exitval => 2, -verbose => 0);
-
- pod2usage(-message => "Syntax error.",
- -exitval => 2,
- -verbose => 0,
- -output => \*STDERR);
-
-Each of the following invocations of C<pod2usage()> will print the
-"SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
-C<STDOUT> and will exit with a status of 1:
-
- pod2usage(1);
-
- pod2usage(-verbose => 1);
-
- pod2usage(-exitval => 1);
-
- pod2usage({-exitval => 1, -output => \*STDOUT});
-
- pod2usage({-verbose => 1, -output => \*STDOUT});
-
- pod2usage(-exitval => 1, -verbose => 1);
-
- pod2usage(-exitval => 1, -verbose => 1, -output => \*STDOUT});
-
-Each of the following invocations of C<pod2usage()> will print the
-entire manual page to C<STDOUT> and will exit with a status of 1:
-
- pod2usage(-verbose => 2);
-
- pod2usage({-verbose => 2, -output => \*STDOUT});
-
- pod2usage(-exitval => 1, -verbose => 2);
-
- pod2usage({-exitval => 1, -verbose => 2, -output => \*STDOUT});
-
-=head2 Recommended Use
-
-Most scripts should print some type of usage message to C<STDERR> when a
-command line syntax error is detected. They should also provide an
-option (usually C<-H> or C<-help>) to print a (possibly more verbose)
-usage message to C<STDOUT>. Some scripts may even wish to go so far as to
-provide a means of printing their complete documentation to C<STDOUT>
-(perhaps by allowing a C<-man> option). The following complete example
-uses B<Pod::Usage> in combination with B<Getopt::Long> to do all of these
-things:
-
- use Getopt::Long;
- use Pod::Usage;
-
- my $man = 0;
- my $help = 0;
- ## Parse options and print usage if there is a syntax error,
- ## or if usage was explicitly requested.
- GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
- pod2usage(1) if $help;
- pod2usage(-verbose => 2) if $man;
-
- ## If no arguments were given, then allow STDIN to be used only
- ## if it's not connected to a terminal (otherwise print usage)
- pod2usage("$0: No files given.") if ((@ARGV == 0) && (-t STDIN));
- __END__
-
- =head1 NAME
-
- sample - Using GetOpt::Long and Pod::Usage
-
- =head1 SYNOPSIS
-
- sample [options] [file ...]
-
- Options:
- -help brief help message
- -man full documentation
-
- =head1 OPTIONS
-
- =over 8
-
- =item B<-help>
-
- Print a brief help message and exits.
-
- =item B<-man>
-
- Prints the manual page and exits.
-
- =back
-
- =head1 DESCRIPTION
-
- B<This program> will read the given input file(s) and do something
- useful with the contents thereof.
-
- =cut
-
-=head1 CAVEATS
-
-By default, B<pod2usage()> will use C<$0> as the path to the pod input
-file. Unfortunately, not all systems on which Perl runs will set C<$0>
-properly (although if C<$0> isn't found, B<pod2usage()> will search
-C<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
-If this is the case for your system, you may need to explicitly specify
-the path to the pod docs for the invoking script using something
-similar to the following:
-
- pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
-
-In the pathological case that a script is called via a relative path
-I<and> the script itself changes the current working directory
-(see L<perlfunc/chdir>) I<before> calling pod2usage, Pod::Usage will
-fail even on robust platforms. Don't do that.
-
-=head1 AUTHOR
-
-Please report bugs using L<http://rt.cpan.org>.
-
-Marek Rouchal E<lt>marekr@cpan.orgE<gt>
-
-Brad Appleton E<lt>bradapp@enteract.comE<gt>
-
-Based on code for B<Pod::Text::pod2text()> written by
-Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
-
-=head1 ACKNOWLEDGMENTS
-
-Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience
-with re-writing this manpage.
-
-=head1 SEE ALSO
-
-L<Pod::Parser>, L<Getopt::Long>, L<Pod::Find>
-
-=cut
-
-#############################################################################
-
-#use diagnostics;
-use Carp;
-use Config;
-use Exporter;
-use File::Spec;
-
-@EXPORT = qw(&pod2usage);
-BEGIN {
- if ( $] >= 5.005_58 ) {
- require Pod::Text;
- @ISA = qw( Pod::Text );
- }
- else {
- require Pod::PlainText;
- @ISA = qw( Pod::PlainText );
- }
-}
-
-require Pod::Select;
-
-##---------------------------------------------------------------------------
-
-##---------------------------------
-## Function definitions begin here
-##---------------------------------
-
-sub pod2usage {
- local($_) = shift;
- my %opts;
- ## Collect arguments
- if (@_ > 0) {
- ## Too many arguments - assume that this is a hash and
- ## the user forgot to pass a reference to it.
- %opts = ($_, @_);
- }
- elsif (!defined $_) {
- $_ = '';
- }
- elsif (ref $_) {
- ## User passed a ref to a hash
- %opts = %{$_} if (ref($_) eq 'HASH');
- }
- elsif (/^[-+]?\d+$/) {
- ## User passed in the exit value to use
- $opts{'-exitval'} = $_;
- }
- else {
- ## User passed in a message to print before issuing usage.
- $_ and $opts{'-message'} = $_;
- }
-
- ## Need this for backward compatibility since we formerly used
- ## options that were all uppercase words rather than ones that
- ## looked like Unix command-line options.
- ## to be uppercase keywords)
- %opts = map {
- my ($key, $val) = ($_, $opts{$_});
- $key =~ s/^(?=\w)/-/;
- $key =~ /^-msg/i and $key = '-message';
- $key =~ /^-exit/i and $key = '-exitval';
- lc($key) => $val;
- } (keys %opts);
-
- ## Now determine default -exitval and -verbose values to use
- if ((! defined $opts{'-exitval'}) && (! defined $opts{'-verbose'})) {
- $opts{'-exitval'} = 2;
- $opts{'-verbose'} = 0;
- }
- elsif (! defined $opts{'-exitval'}) {
- $opts{'-exitval'} = ($opts{'-verbose'} > 0) ? 1 : 2;
- }
- elsif (! defined $opts{'-verbose'}) {
- $opts{'-verbose'} = (lc($opts{'-exitval'}) eq 'noexit' ||
- $opts{'-exitval'} < 2);
- }
-
- ## Default the output file
- $opts{'-output'} = (lc($opts{'-exitval'}) eq 'noexit' ||
- $opts{'-exitval'} < 2) ? \*STDOUT : \*STDERR
- unless (defined $opts{'-output'});
- ## Default the input file
- $opts{'-input'} = $0 unless (defined $opts{'-input'});
-
- ## Look up input file in path if it doesnt exist.
- unless ((ref $opts{'-input'}) || (-e $opts{'-input'})) {
- my $basename = $opts{'-input'};
- my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/i) ? ';'
- : (($^O eq 'MacOS' || $^O eq 'VMS') ? ',' : ':');
- my $pathspec = $opts{'-pathlist'} || $ENV{PATH} || $ENV{PERL5LIB};
-
- my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
- for my $dirname (@paths) {
- $_ = File::Spec->catfile($dirname, $basename) if length;
- last if (-e $_) && ($opts{'-input'} = $_);
- }
- }
-
- ## Now create a pod reader and constrain it to the desired sections.
- my $parser = new Pod::Usage(USAGE_OPTIONS => \%opts);
- if ($opts{'-verbose'} == 0) {
- $parser->select('(?:SYNOPSIS|USAGE)\s*');
- }
- elsif ($opts{'-verbose'} == 1) {
- my $opt_re = '(?i)' .
- '(?:OPTIONS|ARGUMENTS)' .
- '(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?';
- $parser->select( '(?:SYNOPSIS|USAGE)\s*', $opt_re, "DESCRIPTION/$opt_re" );
- }
- elsif ($opts{'-verbose'} >= 2 && $opts{'-verbose'} != 99) {
- $parser->select('.*');
- }
- elsif ($opts{'-verbose'} == 99) {
- my $sections = $opts{'-sections'};
- $parser->select( (ref $sections) ? @$sections : $sections );
- $opts{'-verbose'} = 1;
- }
-
- ## Now translate the pod document and then exit with the desired status
- if ( !$opts{'-noperldoc'}
- and $opts{'-verbose'} >= 2
- and !ref($opts{'-input'})
- and $opts{'-output'} == \*STDOUT )
- {
- ## spit out the entire PODs. Might as well invoke perldoc
- my $progpath = File::Spec->catfile($Config{scriptdir}, 'perldoc');
- print { $opts{'-output'} } ($opts{'-message'}, "\n") if($opts{'-message'});
- if(defined $opts{-input} && $opts{-input} =~ /^\s*(\S.*?)\s*$/) {
- # the perldocs back to 5.005 should all have -F
- # without -F there are warnings in -T scripts
- system($progpath, '-F', $1);
- if($?) {
- # RT16091: fall back to more if perldoc failed
- system(($Config{pager} || $ENV{PAGER} || '/bin/more'), $1);
- }
- } else {
- croak "Unspecified input file or insecure argument.\n";
- }
- }
- else {
- $parser->parse_from_file($opts{'-input'}, $opts{'-output'});
- }
-
- exit($opts{'-exitval'}) unless (lc($opts{'-exitval'}) eq 'noexit');
-}
-
-##---------------------------------------------------------------------------
-
-##-------------------------------
-## Method definitions begin here
-##-------------------------------
-
-sub new {
- my $this = shift;
- my $class = ref($this) || $this;
- my %params = @_;
- my $self = {%params};
- bless $self, $class;
- if ($self->can('initialize')) {
- $self->initialize();
- } else {
- $self = $self->SUPER::new();
- %$self = (%$self, %params);
- }
- return $self;
-}
-
-sub select {
- my ($self, @sections) = @_;
- if ($ISA[0]->can('select')) {
- $self->SUPER::select(@sections);
- } else {
- # we're using Pod::Simple - need to mimic the behavior of Pod::Select
- my $add = ($sections[0] eq '+') ? shift(@sections) : '';
- ## Reset the set of sections to use
- unless (@sections) {
- delete $self->{USAGE_SELECT} unless ($add);
- return;
- }
- $self->{USAGE_SELECT} = []
- unless ($add && $self->{USAGE_SELECT});
- my $sref = $self->{USAGE_SELECT};
- ## Compile each spec
- for my $spec (@sections) {
- my $cs = Pod::Select::_compile_section_spec($spec);
- if ( defined $cs ) {
- ## Store them in our sections array
- push(@$sref, $cs);
- } else {
- carp qq{Ignoring section spec "$spec"!\n};
- }
- }
- }
-}
-
-# Override Pod::Text->seq_i to return just "arg", not "*arg*".
-sub seq_i { return $_[1] }
-
-# This overrides the Pod::Text method to do something very akin to what
-# Pod::Select did as well as the work done below by preprocess_paragraph.
-# Note that the below is very, very specific to Pod::Text.
-sub _handle_element_end {
- my ($self, $element) = @_;
- if ($element eq 'head1') {
- $self->{USAGE_HEADINGS} = [ $$self{PENDING}[-1][1] ];
- if ($self->{USAGE_OPTIONS}->{-verbose} < 2) {
- $$self{PENDING}[-1][1] =~ s/^\s*SYNOPSIS\s*$/USAGE/;
- }
- } elsif ($element =~ /^head(\d+)$/ && $1) { # avoid 0
- my $idx = $1 - 1;
- $self->{USAGE_HEADINGS} = [] unless($self->{USAGE_HEADINGS});
- $self->{USAGE_HEADINGS}->[$idx] = $$self{PENDING}[-1][1];
- }
- if ($element =~ /^head\d+$/) {
- $$self{USAGE_SKIPPING} = 1;
- if (!$$self{USAGE_SELECT} || !@{ $$self{USAGE_SELECT} }) {
- $$self{USAGE_SKIPPING} = 0;
- } else {
- my @headings = @{$$self{USAGE_HEADINGS}};
- for my $section_spec ( @{$$self{USAGE_SELECT}} ) {
- my $match = 1;
- for (my $i = 0; $i < $Pod::Select::MAX_HEADING_LEVEL; ++$i) {
- $headings[$i] = '' unless defined $headings[$i];
- my $regex = $section_spec->[$i];
- my $negated = ($regex =~ s/^\!//);
- $match &= ($negated ? ($headings[$i] !~ /${regex}/)
- : ($headings[$i] =~ /${regex}/));
- last unless ($match);
- } # end heading levels
- if ($match) {
- $$self{USAGE_SKIPPING} = 0;
- last;
- }
- } # end sections
- }
-
- # Try to do some lowercasing instead of all-caps in headings, and use
- # a colon to end all headings.
- if($self->{USAGE_OPTIONS}->{-verbose} < 2) {
- local $_ = $$self{PENDING}[-1][1];
- s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
- s/\s*$/:/ unless (/:\s*$/);
- $_ .= "\n";
- $$self{PENDING}[-1][1] = $_;
- }
- }
- if ($$self{USAGE_SKIPPING} && $element !~ m/^over-/) {
- pop @{ $$self{PENDING} };
- } else {
- $self->SUPER::_handle_element_end($element);
- }
-}
-
-# required for Pod::Simple API
-sub start_document {
- my $self = shift;
- $self->SUPER::start_document();
- my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
- my $out_fh = $self->output_fh();
- print $out_fh "$msg\n";
-}
-
-# required for old Pod::Parser API
-sub begin_pod {
- my $self = shift;
- $self->SUPER::begin_pod(); ## Have to call superclass
- my $msg = $self->{USAGE_OPTIONS}->{-message} or return 1;
- my $out_fh = $self->output_handle();
- print $out_fh "$msg\n";
-}
-
-sub preprocess_paragraph {
- my $self = shift;
- local $_ = shift;
- my $line = shift;
- ## See if this is a heading and we arent printing the entire manpage.
- if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/) {
- ## Change the title of the SYNOPSIS section to USAGE
- s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/;
- ## Try to do some lowercasing instead of all-caps in headings
- s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
- ## Use a colon to end all headings
- s/\s*$/:/ unless (/:\s*$/);
- $_ .= "\n";
- }
- return $self->SUPER::preprocess_paragraph($_);
-}
-
-1; # keep require happy
diff --git a/lib/Pod/t/contains_pod.t b/lib/Pod/t/contains_pod.t
deleted file mode 100644
index 25cce53781..0000000000
--- a/lib/Pod/t/contains_pod.t
+++ /dev/null
@@ -1,27 +0,0 @@
-#!/usr/bin/env perl
-
-# Copyright (C) 2005 Joshua Hoblitt
-#
-# $Id$
-
-use strict;
-BEGIN {
- if( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = '../lib';
- } else {
- use lib qw( ./lib );
- }
-}
-
-use Test::More tests => 2;
-
-use Pod::Find qw( contains_pod );
-
-{
- ok(contains_pod('lib/contains_pod.xr'), "contains pod");
-}
-
-{
- ok(contains_pod('lib/contains_bad_pod.xr'), "contains bad pod");
-}