Update Pod-Parser to CPAN version 1.60
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Tue, 5 Feb 2013 22:45:57 +0000 (22:45 +0000)
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Tue, 5 Feb 2013 23:37:03 +0000 (23:37 +0000)
  [DELTA]

  [Pod-Parser]

  31-Jan-2013           Marek Rouchal                        <marekr@cpan.org>
  -----------------------------------------------------------------------------
  Version 1.60
  + removed Pod::Checker and Pod::Usage from this distribution - they are now
    separate distros and are subjects to be refactored, to be based upon
    Pod::Simple. Thanks to rjbs for reminding me of this.

Add Pod-Checker and Pod-Usage to cpan/

These have been split out of Pod-Parser

  [Pod-Checker]

  27-Jan-2013           Marek Rouchal                        <marekr@cpan.org>
  -----------------------------------------------------------------------------
  Version 1.60
  + preparation of changing this module to use Pod::Simple
    refactored the Pod-Parser distribution and moved all things Pod::Checker
    to this new distribution package
  + CPAN RT#79535: Pod::Checker synopsis for podchecker is opposite
    corrected the POD synopsis
  + factored this distribution out of Pod-Parser-1.51

  [Pod-Usage]

  1.61 (marekr)
  - fix empty META.yml (CPAN RT#83118: META.yml is empty)
  - update outdated test expected data (CPAN RT#83111: fails test)
 
  1.60 (marekr)
  - moved POD behind __END__ for slighlty quicker loading
  - CPAN RT#81387: 2 suggestions for module Pod::Usage
    added example of how to use FindBin to locate the script;
    added $Pod::Usage::Formatter to allow a different base class
  - CPAN RT#75598: [PATCH] Don't use perldoc if it is missing
    implemented as suggested in the RT ticket
  - factored Pod::Usageout of the Pod-Parser distribution into a separate one,
    in order to prepare the rewrite based upon Pod::Simple
  - thanks to rjbs for driving this

69 files changed:
MANIFEST
Porting/Maintainers.pl
cpan/Pod-Checker/.gitignore [new file with mode: 0644]
cpan/Pod-Checker/lib/Pod/Checker.pm [moved from cpan/Pod-Parser/lib/Pod/Checker.pm with 96% similarity]
cpan/Pod-Checker/scripts/podchecker.PL [moved from cpan/Pod-Parser/scripts/podchecker.PL with 96% similarity]
cpan/Pod-Checker/t/pod/contains_bad_pod.xr [new file with mode: 0644]
cpan/Pod-Checker/t/pod/empty.xr [new file with mode: 0644]
cpan/Pod-Checker/t/pod/podchkenc.t [moved from cpan/Pod-Parser/t/pod/podchkenc.t with 94% similarity]
cpan/Pod-Checker/t/pod/podchkenc.xr [moved from cpan/Pod-Parser/t/pod/podchkenc.xr with 98% similarity]
cpan/Pod-Checker/t/pod/poderrs.t [moved from cpan/Pod-Parser/t/pod/poderrs.t with 93% similarity]
cpan/Pod-Checker/t/pod/poderrs.xr [moved from cpan/Pod-Parser/t/pod/poderrs.xr with 98% similarity]
cpan/Pod-Checker/t/pod/selfcheck.t [new file with mode: 0644]
cpan/Pod-Checker/t/pod/testcmp.pl [new file with mode: 0644]
cpan/Pod-Checker/t/pod/testpchk.pl [new file with mode: 0644]
cpan/Pod-Parser/.gitignore
cpan/Pod-Parser/lib/Pod/Find.pm
cpan/Pod-Parser/lib/Pod/InputObjects.pm
cpan/Pod-Parser/lib/Pod/ParseUtils.pm
cpan/Pod-Parser/lib/Pod/Parser.pm
cpan/Pod-Parser/lib/Pod/PlainText.pm
cpan/Pod-Parser/lib/Pod/Select.pm
cpan/Pod-Parser/scripts/podselect.PL
cpan/Pod-Parser/t/pod/contains_bad_pod.xr
cpan/Pod-Parser/t/pod/contains_pod.t
cpan/Pod-Parser/t/pod/contains_pod.xr
cpan/Pod-Parser/t/pod/emptycmd.t
cpan/Pod-Parser/t/pod/emptycmd.xr
cpan/Pod-Parser/t/pod/find.t
cpan/Pod-Parser/t/pod/for.t
cpan/Pod-Parser/t/pod/for.xr
cpan/Pod-Parser/t/pod/headings.t
cpan/Pod-Parser/t/pod/headings.xr
cpan/Pod-Parser/t/pod/include.t
cpan/Pod-Parser/t/pod/include.xr
cpan/Pod-Parser/t/pod/included.t
cpan/Pod-Parser/t/pod/included.xr
cpan/Pod-Parser/t/pod/lref.t
cpan/Pod-Parser/t/pod/lref.xr
cpan/Pod-Parser/t/pod/multiline_items.t
cpan/Pod-Parser/t/pod/multiline_items.xr
cpan/Pod-Parser/t/pod/nested_items.t
cpan/Pod-Parser/t/pod/nested_items.xr
cpan/Pod-Parser/t/pod/nested_seqs.t
cpan/Pod-Parser/t/pod/nested_seqs.xr
cpan/Pod-Parser/t/pod/oneline_cmds.t
cpan/Pod-Parser/t/pod/oneline_cmds.xr
cpan/Pod-Parser/t/pod/podselect.t
cpan/Pod-Parser/t/pod/podselect.xr
cpan/Pod-Parser/t/pod/selfcheck.t
cpan/Pod-Parser/t/pod/special_seqs.t
cpan/Pod-Parser/t/pod/special_seqs.xr
cpan/Pod-Parser/t/pod/testcmp.pl
cpan/Pod-Parser/t/pod/testp2pt.pl
cpan/Pod-Parser/t/pod/testpchk.pl
cpan/Pod-Parser/t/pod/testpods/lib/Pod/Stuff.pm
cpan/Pod-Parser/t/pod/twice.t
cpan/Pod-Usage/.gitignore [new file with mode: 0644]
cpan/Pod-Usage/lib/Pod/Usage.pm [moved from cpan/Pod-Parser/lib/Pod/Usage.pm with 91% similarity]
cpan/Pod-Usage/scripts/pod2usage.PL [moved from cpan/Pod-Parser/scripts/pod2usage.PL with 89% similarity]
cpan/Pod-Usage/t/pod/p2u_data.pl [moved from cpan/Pod-Parser/t/pod/p2u_data.pl with 91% similarity]
cpan/Pod-Usage/t/pod/pod2usage.t [moved from cpan/Pod-Parser/t/pod/pod2usage.t with 95% similarity]
cpan/Pod-Usage/t/pod/pod2usage.xr [moved from cpan/Pod-Parser/t/pod/pod2usage.xr with 84% similarity]
cpan/Pod-Usage/t/pod/pod2usage2.t [moved from cpan/Pod-Parser/t/pod/pod2usage2.t with 96% similarity]
cpan/Pod-Usage/t/pod/testcmp.pl [new file with mode: 0644]
cpan/Pod-Usage/t/pod/testp2pt.pl [new file with mode: 0644]
cpan/Pod-Usage/t/pod/usage.pod [moved from cpan/Pod-Parser/t/pod/usage.pod with 92% similarity]
cpan/Pod-Usage/t/pod/usage2.pod [moved from cpan/Pod-Parser/t/pod/usage2.pod with 90% similarity]
t/porting/dual-life.t
utils.lst

index ba687e7..f11f404 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1929,6 +1929,17 @@ cpan/PerlIO-via-QuotedPrint/t/QuotedPrint.t                      PerlIO::via::QuotedPrint
 cpan/Perl-OSType/lib/Perl/OSType.pm                    Perl::OSType
 cpan/Perl-OSType/t/00-compile.t                        Perl::OSType
 cpan/Perl-OSType/t/OSType.t                    Perl::OSType
+cpan/Pod-Checker/lib/Pod/Checker.pm
+cpan/Pod-Checker/scripts/podchecker.PL
+cpan/Pod-Checker/t/pod/contains_bad_pod.xr
+cpan/Pod-Checker/t/pod/empty.xr
+cpan/Pod-Checker/t/pod/podchkenc.t
+cpan/Pod-Checker/t/pod/podchkenc.xr
+cpan/Pod-Checker/t/pod/poderrs.t
+cpan/Pod-Checker/t/pod/poderrs.xr
+cpan/Pod-Checker/t/pod/selfcheck.t
+cpan/Pod-Checker/t/pod/testcmp.pl
+cpan/Pod-Checker/t/pod/testpchk.pl
 cpan/Pod-Escapes/ChangeLog             ChangeLog for Pod::Escapes
 cpan/Pod-Escapes/lib/Pod/Escapes.pm    Pod::Escapes
 cpan/Pod-Escapes/README                        README for Pod::Escapes
@@ -1974,16 +1985,12 @@ cpan/podlators/t/text-perlio.t                  podlators test
 cpan/podlators/t/text.t                                podlators test
 cpan/podlators/t/text-utf8.t                   podlators test
 cpan/podlators/VERSION                         podlators distribution version
-cpan/Pod-Parser/lib/Pod/Checker.pm             Pod-Parser - check POD documents for syntax errors
 cpan/Pod-Parser/lib/Pod/Find.pm                        find POD documents in directory trees
 cpan/Pod-Parser/lib/Pod/InputObjects.pm                Pod-Parser - define objects for input streams
 cpan/Pod-Parser/lib/Pod/Parser.pm              Pod-Parser - define base class for parsing POD
 cpan/Pod-Parser/lib/Pod/ParseUtils.pm          Pod-Parser - pod utility functions
 cpan/Pod-Parser/lib/Pod/PlainText.pm           Convert POD data to formatted ASCII text
 cpan/Pod-Parser/lib/Pod/Select.pm              Pod-Parser - select portions of POD docs
-cpan/Pod-Parser/lib/Pod/Usage.pm               Pod-Parser - print usage messages
-cpan/Pod-Parser/scripts/pod2usage.PL   Pod-Parser - print usage messages from POD docs
-cpan/Pod-Parser/scripts/podchecker.PL  Pod-Parser - Pod::Checker::podchecker() CLI
 cpan/Pod-Parser/scripts/podselect.PL   Pod-Parser - Pod::Select::podselect() CLI
 cpan/Pod-Parser/t/pod/contains_bad_pod.xr      Pod-Parser test file
 cpan/Pod-Parser/t/pod/contains_pod.t           Pod-Parser test
@@ -2010,14 +2017,6 @@ cpan/Pod-Parser/t/pod/nested_seqs.t              Test nested interior sequences
 cpan/Pod-Parser/t/pod/nested_seqs.xr           Expected results for nested_seqs.t
 cpan/Pod-Parser/t/pod/oneline_cmds.t           Test single paragraph ==cmds
 cpan/Pod-Parser/t/pod/oneline_cmds.xr          Expected results for oneline_cmds.t
-cpan/Pod-Parser/t/pod/p2u_data.pl              Test Pod::Usage
-cpan/Pod-Parser/t/pod/pod2usage2.t             Test Pod::Usage
-cpan/Pod-Parser/t/pod/pod2usage.t              Test Pod::Usage
-cpan/Pod-Parser/t/pod/pod2usage.xr             Expected results for pod2usage.t
-cpan/Pod-Parser/t/pod/podchkenc.t              Validate =encoding support
-cpan/Pod-Parser/t/pod/podchkenc.xr             Expected results for the above
-cpan/Pod-Parser/t/pod/poderrs.t                        Test POD errors
-cpan/Pod-Parser/t/pod/poderrs.xr               Expected results for poderrs.t
 cpan/Pod-Parser/t/pod/podselect.t              Test Pod::Select
 cpan/Pod-Parser/t/pod/podselect.xr             Expected results for podselect.t
 cpan/Pod-Parser/t/pod/selfcheck.t
@@ -2028,8 +2027,6 @@ cpan/Pod-Parser/t/pod/testp2pt.pl         Module to test Pod::PlainText for a given fil
 cpan/Pod-Parser/t/pod/testpchk.pl              Module to test Pod::Checker for a given file
 cpan/Pod-Parser/t/pod/testpods/lib/Pod/Stuff.pm        Sample data for t/pod/find.t
 cpan/Pod-Parser/t/pod/twice.t                  Test Pod::Parser
-cpan/Pod-Parser/t/pod/usage2.pod               Test POD for pod2usage tests
-cpan/Pod-Parser/t/pod/usage.pod                        Test POD for pod2usage tests
 cpan/Pod-Perldoc/corpus/no-head.pod            test file for Pod-Perldoc
 cpan/Pod-Perldoc/corpus/perlfunc.pod           test file for Pod-Perldoc
 cpan/Pod-Perldoc/corpus/utf8.pod               test file for Pod-Perldoc
@@ -2237,6 +2234,16 @@ cpan/Pod-Simple/t/xhtml10.t                              Pod::Simple test file
 cpan/Pod-Simple/t/xhtml15.t                            Pod::Simple test file
 cpan/Pod-Simple/t/xhtml20.t                            Pod::Simple test file
 cpan/Pod-Simple/t/x_nixer.t                            Pod::Simple test file
+cpan/Pod-Usage/lib/Pod/Usage.pm
+cpan/Pod-Usage/scripts/pod2usage.PL
+cpan/Pod-Usage/t/pod/p2u_data.pl
+cpan/Pod-Usage/t/pod/pod2usage2.t
+cpan/Pod-Usage/t/pod/pod2usage.t
+cpan/Pod-Usage/t/pod/pod2usage.xr
+cpan/Pod-Usage/t/pod/testcmp.pl
+cpan/Pod-Usage/t/pod/testp2pt.pl
+cpan/Pod-Usage/t/pod/usage2.pod
+cpan/Pod-Usage/t/pod/usage.pod
 cpan/Socket/Makefile.PL                        Socket extension makefile writer
 cpan/Socket/Socket.pm                  Socket extension Perl module
 cpan/Socket/Socket.xs                  Socket extension external subroutines
index 9839875..c5607ea 100755 (executable)
@@ -1503,6 +1503,13 @@ use File::Glob qw(:case);
         'UPSTREAM'   => undef,
     },
 
+    'Pod::Checker' => {
+        'MAINTAINER' => 'marekr',
+        'DISTRIBUTION' => 'MAREKR/Pod-Checker-1.60.tar.gz',
+        'FILES'        => q[cpan/Pod-Checker],
+        'UPSTREAM'     => 'cpan',
+    },
+
     'Pod::Escapes' => {
         'MAINTAINER'   => 'arandal',
         'DISTRIBUTION' => 'SBURKE/Pod-Escapes-1.04.tar.gz',
@@ -1532,7 +1539,7 @@ use File::Glob qw(:case);
 
     'Pod::Parser' => {
         'MAINTAINER' => 'marekr',
-        'DISTRIBUTION' => 'MAREKR/Pod-Parser-1.51.tar.gz',
+        'DISTRIBUTION' => 'MAREKR/Pod-Parser-1.60.tar.gz',
         'FILES'        => q[cpan/Pod-Parser],
         'UPSTREAM'     => 'cpan',
     },
@@ -1557,6 +1564,13 @@ use File::Glob qw(:case);
         'UPSTREAM'     => 'cpan',
     },
 
+    'Pod::Usage' => {
+        'MAINTAINER' => 'marekr',
+        'DISTRIBUTION' => 'MAREKR/Pod-Usage-1.61.tar.gz',
+        'FILES'        => q[cpan/Pod-Usage],
+        'UPSTREAM'     => 'cpan',
+    },
+
     'podlators' => {
         'MAINTAINER'   => 'rra',
         'DISTRIBUTION' => 'RRA/podlators-2.5.0.tar.gz',
diff --git a/cpan/Pod-Checker/.gitignore b/cpan/Pod-Checker/.gitignore
new file mode 100644 (file)
index 0000000..48f56f3
--- /dev/null
@@ -0,0 +1 @@
+/podchecker*
similarity index 96%
rename from cpan/Pod-Parser/lib/Pod/Checker.pm
rename to cpan/Pod-Checker/lib/Pod/Checker.pm
index 25dab19..ba47e6f 100644 (file)
-#############################################################################
-# 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.51';  ## 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 * Apparent command =foo not preceded by blank line
-
-A command which has ended up in the middle of a paragraph or other command,
-such as
-
-  =item one
-  =item two <-- bad
-
-=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 =cut command
-
-A C<=cut> command was found without a preceding POD paragraph.
-
-=item * Spurious =pod command
-
-A C<=pod> command was found after a preceding POD paragraph.
-
-=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
-
-       $self->_commands_in_paragraphs($paragraph, $pod_para);
-
-        ##### 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"});
-            }
-           if($cmd eq 'cut' && (!$self->{_PREVIOUS} || $self->{_PREVIOUS} eq 'cut')) {
-                $self->poderror({ -line => $line, -file => $file,
-                      -severity => 'ERROR',
-                      -msg => "Spurious =cut command"});
-           }
-           if($cmd eq 'pod' && $self->{_PREVIOUS} && $self->{_PREVIOUS} ne 'cut') {
-                $self->poderror({ -line => $line, -file => $file,
-                      -severity => 'ERROR',
-                      -msg => "Spurious =pod command"});
-           }
-        }
-    $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(index($nestlist, $cmd) != -1) {
-            $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);
-    $self->_commands_in_paragraphs($paragraph, $pod_para);
-
-    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);
-    $self->_commands_in_paragraphs($paragraph, $pod_para);
-
-    # 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;
-        }
-    }
-}
-
-# look for =foo commands at the start of a line within a paragraph, as for
-# instance the following which prints as "* one =item two".
-#
-#     =item one
-#     =item two
-#
-# Examples of =foo written in docs are expected to be indented in a verbatim
-# or marked up C<=foo> so won't be caught.  A double-angle C<< =foo >> could
-# have the =foo at the start of a line, but that should be unlikely and is
-# easily enough dealt with by not putting a newline after the C<<.
-#
-sub _commands_in_paragraphs {
-  my ($self, $str, $pod_para) = @_;
-  while ($str =~ /[^\n]\n=([a-z][a-z0-9]+)/sg) {
-    my $cmd = $1;
-    my $pos = pos($str);
-    if ($VALID_COMMANDS{$cmd}) {
-      my ($file, $line) = $pod_para->file_line;
-      my $part = substr($str, 0, $pos);
-      $line += ($part =~ tr/\n//);  # count of newlines
-
-      $self->poderror
-        ({ -line => $line, -file => $file,
-           -severity => 'ERROR',
-           -msg => "Apparent command =$cmd not preceded by blank line"});
-    }
-  }
-}
-
-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>
-
-B<Pod::Checker> is part of the L<Pod::Parser> distribution.
-
-=cut
-
+#############################################################################\r
+# Pod/Checker.pm -- check pod documents for syntax errors\r
+#\r
+# Copyright (C) 1994-2000 by Bradford Appleton. All rights reserved.\r
+# This file is part of "PodParser". PodParser is free software;\r
+# you can redistribute it and/or modify it under the same terms\r
+# as Perl itself.\r
+#############################################################################\r
+\r
+package Pod::Checker;\r
+use strict;\r
+\r
+use vars qw($VERSION @ISA @EXPORT %VALID_COMMANDS %VALID_SEQUENCES);\r
+$VERSION = '1.60';  ## Current version of this package\r
+require  5.005;    ## requires this Perl version or later\r
+\r
+use Pod::ParseUtils; ## for hyperlinks and lists\r
+\r
+=head1 NAME\r
+\r
+Pod::Checker, podchecker() - check pod documents for syntax errors\r
+\r
+=head1 SYNOPSIS\r
+\r
+  use Pod::Checker;\r
+\r
+  $num_errors = podchecker($filepath, $outputpath, %options);\r
+\r
+  my $checker = new Pod::Checker %options;\r
+  $checker->parse_from_file($filepath, \*STDERR);\r
+\r
+=head1 OPTIONS/ARGUMENTS\r
+\r
+C<$filepath> is the input POD to read and C<$outputpath> is\r
+where to write POD syntax error messages. Either argument may be a scalar\r
+indicating a file-path, or else a reference to an open filehandle.\r
+If unspecified, the input-file it defaults to C<\*STDIN>, and\r
+the output-file defaults to C<\*STDERR>.\r
+\r
+=head2 podchecker()\r
+\r
+This function can take a hash of options:\r
+\r
+=over 4\r
+\r
+=item B<-warnings> =E<gt> I<val>\r
+\r
+Turn warnings on/off. I<val> is usually 1 for on, but higher values\r
+trigger additional warnings. See L<"Warnings">.\r
+\r
+=back\r
+\r
+=head1 DESCRIPTION\r
+\r
+B<podchecker> will perform syntax checking of Perl5 POD format documentation.\r
+\r
+Curious/ambitious users are welcome to propose additional features they wish\r
+to see in B<Pod::Checker> and B<podchecker> and verify that the checks are\r
+consistent with L<perlpod>.\r
+\r
+The following checks are currently performed:\r
+\r
+=over 4\r
+\r
+=item *\r
+\r
+Unknown '=xxxx' commands, unknown 'XE<lt>...E<gt>' interior-sequences,\r
+and unterminated interior sequences.\r
+\r
+=item *\r
+\r
+Check for proper balancing of C<=begin> and C<=end>. The contents of such\r
+a block are generally ignored, i.e. no syntax checks are performed.\r
+\r
+=item *\r
+\r
+Check for proper nesting and balancing of C<=over>, C<=item> and C<=back>.\r
+\r
+=item *\r
+\r
+Check for same nested interior-sequences (e.g.\r
+C<LE<lt>...LE<lt>...E<gt>...E<gt>>).\r
+\r
+=item *\r
+\r
+Check for malformed or non-existing entities C<EE<lt>...E<gt>>.\r
+\r
+=item *\r
+\r
+Check for correct syntax of hyperlinks C<LE<lt>...E<gt>>. See L<perlpod>\r
+for details.\r
+\r
+=item *\r
+\r
+Check for unresolved document-internal links. This check may also reveal\r
+misspelled links that seem to be internal links but should be links\r
+to something else.\r
+\r
+=back\r
+\r
+=head1 DIAGNOSTICS\r
+\r
+=head2 Errors\r
+\r
+=over 4\r
+\r
+=item * empty =headn\r
+\r
+A heading (C<=head1> or C<=head2>) without any text? That ain't no\r
+heading!\r
+\r
+=item * =over on line I<N> without closing =back\r
+\r
+The C<=over> command does not have a corresponding C<=back> before the\r
+next heading (C<=head1> or C<=head2>) or the end of the file.\r
+\r
+=item * =item without previous =over\r
+\r
+=item * =back without previous =over\r
+\r
+An C<=item> or C<=back> command has been found outside a\r
+C<=over>/C<=back> block.\r
+\r
+=item * No argument for =begin\r
+\r
+A C<=begin> command was found that is not followed by the formatter\r
+specification.\r
+\r
+=item * =end without =begin\r
+\r
+A standalone C<=end> command was found.\r
+\r
+=item * Nested =begin's\r
+\r
+There were at least two consecutive C<=begin> commands without\r
+the corresponding C<=end>. Only one C<=begin> may be active at\r
+a time.\r
+\r
+=item * =for without formatter specification\r
+\r
+There is no specification of the formatter after the C<=for> command.\r
+\r
+=item * Apparent command =foo not preceded by blank line\r
+\r
+A command which has ended up in the middle of a paragraph or other command,\r
+such as\r
+\r
+  =item one\r
+  =item two <-- bad\r
+\r
+=item * unresolved internal link I<NAME>\r
+\r
+The given link to I<NAME> does not have a matching node in the current\r
+POD. This also happened when a single word node name is not enclosed in\r
+C<"">.\r
+\r
+=item * Unknown command "I<CMD>"\r
+\r
+An invalid POD command has been found. Valid are C<=head1>, C<=head2>,\r
+C<=head3>, C<=head4>, C<=over>, C<=item>, C<=back>, C<=begin>, C<=end>,\r
+C<=for>, C<=pod>, C<=cut>\r
+\r
+=item * Unknown interior-sequence "I<SEQ>"\r
+\r
+An invalid markup command has been encountered. Valid are:\r
+C<BE<lt>E<gt>>, C<CE<lt>E<gt>>, C<EE<lt>E<gt>>, C<FE<lt>E<gt>>,\r
+C<IE<lt>E<gt>>, C<LE<lt>E<gt>>, C<SE<lt>E<gt>>, C<XE<lt>E<gt>>,\r
+C<ZE<lt>E<gt>>\r
+\r
+=item * nested commands I<CMD>E<lt>...I<CMD>E<lt>...E<gt>...E<gt>\r
+\r
+Two nested identical markup commands have been found. Generally this\r
+does not make sense.\r
+\r
+=item * garbled entity I<STRING>\r
+\r
+The I<STRING> found cannot be interpreted as a character entity.\r
+\r
+=item * Entity number out of range\r
+\r
+An entity specified by number (dec, hex, oct) is out of range (1-255).\r
+\r
+=item * malformed link LE<lt>E<gt>\r
+\r
+The link found cannot be parsed because it does not conform to the\r
+syntax described in L<perlpod>.\r
+\r
+=item * nonempty ZE<lt>E<gt>\r
+\r
+The C<ZE<lt>E<gt>> sequence is supposed to be empty.\r
+\r
+=item * empty XE<lt>E<gt>\r
+\r
+The index entry specified contains nothing but whitespace.\r
+\r
+=item * Spurious text after =pod / =cut\r
+\r
+The commands C<=pod> and C<=cut> do not take any arguments.\r
+\r
+=item * Spurious =cut command\r
+\r
+A C<=cut> command was found without a preceding POD paragraph.\r
+\r
+=item * Spurious =pod command\r
+\r
+A C<=pod> command was found after a preceding POD paragraph.\r
+\r
+=item * Spurious character(s) after =back\r
+\r
+The C<=back> command does not take any arguments.\r
+\r
+=back\r
+\r
+=head2 Warnings\r
+\r
+These may not necessarily cause trouble, but indicate mediocre style.\r
+\r
+=over 4\r
+\r
+=item * multiple occurrence of link target I<name>\r
+\r
+The POD file has some C<=item> and/or C<=head> commands that have\r
+the same text. Potential hyperlinks to such a text cannot be unique then.\r
+This warning is printed only with warning level greater than one.\r
+\r
+=item * line containing nothing but whitespace in paragraph\r
+\r
+There is some whitespace on a seemingly empty line. POD is very sensitive\r
+to such things, so this is flagged. B<vi> users switch on the B<list>\r
+option to avoid this problem.\r
+\r
+=begin _disabled_\r
+\r
+=item * file does not start with =head\r
+\r
+The file starts with a different POD directive than head.\r
+This is most probably something you do not want.\r
+\r
+=end _disabled_\r
+\r
+=item * previous =item has no contents\r
+\r
+There is a list C<=item> right above the flagged line that has no\r
+text contents. You probably want to delete empty items.\r
+\r
+=item * preceding non-item paragraph(s)\r
+\r
+A list introduced by C<=over> starts with a text or verbatim paragraph,\r
+but continues with C<=item>s. Move the non-item paragraph out of the\r
+C<=over>/C<=back> block.\r
+\r
+=item * =item type mismatch (I<one> vs. I<two>)\r
+\r
+A list started with e.g. a bullet-like C<=item> and continued with a\r
+numbered one. This is obviously inconsistent. For most translators the\r
+type of the I<first> C<=item> determines the type of the list.\r
+\r
+=item * I<N> unescaped C<E<lt>E<gt>> in paragraph\r
+\r
+Angle brackets not written as C<E<lt>ltE<gt>> and C<E<lt>gtE<gt>>\r
+can potentially cause errors as they could be misinterpreted as\r
+markup commands. This is only printed when the -warnings level is\r
+greater than 1.\r
+\r
+=item * Unknown entity\r
+\r
+A character entity was found that does not belong to the standard\r
+ISO set or the POD specials C<verbar> and C<sol>.\r
+\r
+=item * No items in =over\r
+\r
+The list opened with C<=over> does not contain any items.\r
+\r
+=item * No argument for =item\r
+\r
+C<=item> without any parameters is deprecated. It should either be followed\r
+by C<*> to indicate an unordered list, by a number (optionally followed\r
+by a dot) to indicate an ordered (numbered) list or simple text for a\r
+definition list.\r
+\r
+=item * empty section in previous paragraph\r
+\r
+The previous section (introduced by a C<=head> command) does not contain\r
+any text. This usually indicates that something is missing. Note: A\r
+C<=head1> followed immediately by C<=head2> does not trigger this warning.\r
+\r
+=item * Verbatim paragraph in NAME section\r
+\r
+The NAME section (C<=head1 NAME>) should consist of a single paragraph\r
+with the script/module name, followed by a dash `-' and a very short\r
+description of what the thing is good for.\r
+\r
+=item * =headI<n> without preceding higher level\r
+\r
+For example if there is a C<=head2> in the POD file prior to a\r
+C<=head1>.\r
+\r
+=back\r
+\r
+=head2 Hyperlinks\r
+\r
+There are some warnings with respect to malformed hyperlinks:\r
+\r
+=over 4\r
+\r
+=item * ignoring leading/trailing whitespace in link\r
+\r
+There is whitespace at the beginning or the end of the contents of\r
+LE<lt>...E<gt>.\r
+\r
+=item * (section) in '$page' deprecated\r
+\r
+There is a section detected in the page name of LE<lt>...E<gt>, e.g.\r
+C<LE<lt>passwd(2)E<gt>>. POD hyperlinks may point to POD documents only.\r
+Please write C<CE<lt>passwd(2)E<gt>> instead. Some formatters are able\r
+to expand this to appropriate code. For links to (builtin) functions,\r
+please say C<LE<lt>perlfunc/mkdirE<gt>>, without ().\r
+\r
+=item * alternative text/node '%s' contains non-escaped | or /\r
+\r
+The characters C<|> and C</> are special in the LE<lt>...E<gt> context.\r
+Although the hyperlink parser does its best to determine which "/" is\r
+text and which is a delimiter in case of doubt, one ought to escape\r
+these literal characters like this:\r
+\r
+  /     E<sol>\r
+  |     E<verbar>\r
+\r
+=back\r
+\r
+=head1 RETURN VALUE\r
+\r
+B<podchecker> returns the number of POD syntax errors found or -1 if\r
+there were no POD commands at all found in the file.\r
+\r
+=head1 EXAMPLES\r
+\r
+See L</SYNOPSIS>\r
+\r
+=head1 INTERFACE\r
+\r
+While checking, this module collects document properties, e.g. the nodes\r
+for hyperlinks (C<=headX>, C<=item>) and index entries (C<XE<lt>E<gt>>).\r
+POD translators can use this feature to syntax-check and get the nodes in\r
+a first pass before actually starting to convert. This is expensive in terms\r
+of execution time, but allows for very robust conversions.\r
+\r
+Since PodParser-1.24 the B<Pod::Checker> module uses only the B<poderror>\r
+method to print errors and warnings. The summary output (e.g.\r
+"Pod syntax OK") has been dropped from the module and has been included in\r
+B<podchecker> (the script). This allows users of B<Pod::Checker> to\r
+control completely the output behavior. Users of B<podchecker> (the script)\r
+get the well-known behavior.\r
+\r
+=cut\r
+\r
+#############################################################################\r
+\r
+#use diagnostics;\r
+use Carp qw(croak);\r
+use Exporter;\r
+use Pod::Parser;\r
+\r
+@ISA = qw(Pod::Parser);\r
+@EXPORT = qw(&podchecker);\r
+\r
+my %VALID_COMMANDS = (\r
+    'pod'    =>  1,\r
+    'cut'    =>  1,\r
+    'head1'  =>  1,\r
+    'head2'  =>  1,\r
+    'head3'  =>  1,\r
+    'head4'  =>  1,\r
+    'over'   =>  1,\r
+    'back'   =>  1,\r
+    'item'   =>  1,\r
+    'for'    =>  1,\r
+    'begin'  =>  1,\r
+    'end'    =>  1,\r
+    'encoding' =>  1,\r
+);\r
+\r
+my %VALID_SEQUENCES = (\r
+    'I'  =>  1,\r
+    'B'  =>  1,\r
+    'S'  =>  1,\r
+    'C'  =>  1,\r
+    'L'  =>  1,\r
+    'F'  =>  1,\r
+    'X'  =>  1,\r
+    'Z'  =>  1,\r
+    'E'  =>  1,\r
+);\r
+\r
+# stolen from HTML::Entities\r
+my %ENTITIES = (\r
+ # Some normal chars that have special meaning in SGML context\r
+ amp    => '&',  # ampersand\r
+'gt'    => '>',  # greater than\r
+'lt'    => '<',  # less than\r
+ quot   => '"',  # double quote\r
+\r
+ # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML\r
+ AElig  => 'Æ',  # capital AE diphthong (ligature)\r
+ Aacute => 'Á',  # capital A, acute accent\r
+ Acirc  => 'Â',  # capital A, circumflex accent\r
+ Agrave => 'À',  # capital A, grave accent\r
+ Aring  => 'Å',  # capital A, ring\r
+ Atilde => 'Ã',  # capital A, tilde\r
+ Auml   => 'Ä',  # capital A, dieresis or umlaut mark\r
+ Ccedil => 'Ç',  # capital C, cedilla\r
+ ETH    => 'Ð',  # capital Eth, Icelandic\r
+ Eacute => 'É',  # capital E, acute accent\r
+ Ecirc  => 'Ê',  # capital E, circumflex accent\r
+ Egrave => 'È',  # capital E, grave accent\r
+ Euml   => 'Ë',  # capital E, dieresis or umlaut mark\r
+ Iacute => 'Í',  # capital I, acute accent\r
+ Icirc  => 'Î',  # capital I, circumflex accent\r
+ Igrave => 'Ì',  # capital I, grave accent\r
+ Iuml   => 'Ï',  # capital I, dieresis or umlaut mark\r
+ Ntilde => 'Ñ',  # capital N, tilde\r
+ Oacute => 'Ó',  # capital O, acute accent\r
+ Ocirc  => 'Ô',  # capital O, circumflex accent\r
+ Ograve => 'Ò',  # capital O, grave accent\r
+ Oslash => 'Ø',  # capital O, slash\r
+ Otilde => 'Õ',  # capital O, tilde\r
+ Ouml   => 'Ö',  # capital O, dieresis or umlaut mark\r
+ THORN  => 'Þ',  # capital THORN, Icelandic\r
+ Uacute => 'Ú',  # capital U, acute accent\r
+ Ucirc  => 'Û',  # capital U, circumflex accent\r
+ Ugrave => 'Ù',  # capital U, grave accent\r
+ Uuml   => 'Ü',  # capital U, dieresis or umlaut mark\r
+ Yacute => 'Ý',  # capital Y, acute accent\r
+ aacute => 'á',  # small a, acute accent\r
+ acirc  => 'â',  # small a, circumflex accent\r
+ aelig  => 'æ',  # small ae diphthong (ligature)\r
+ agrave => 'à',  # small a, grave accent\r
+ aring  => 'å',  # small a, ring\r
+ atilde => 'ã',  # small a, tilde\r
+ auml   => 'ä',  # small a, dieresis or umlaut mark\r
+ ccedil => 'ç',  # small c, cedilla\r
+ eacute => 'é',  # small e, acute accent\r
+ ecirc  => 'ê',  # small e, circumflex accent\r
+ egrave => 'è',  # small e, grave accent\r
+ eth    => 'ð',  # small eth, Icelandic\r
+ euml   => 'ë',  # small e, dieresis or umlaut mark\r
+ iacute => 'í',  # small i, acute accent\r
+ icirc  => 'î',  # small i, circumflex accent\r
+ igrave => 'ì',  # small i, grave accent\r
+ iuml   => 'ï',  # small i, dieresis or umlaut mark\r
+ ntilde => 'ñ',  # small n, tilde\r
+ oacute => 'ó',  # small o, acute accent\r
+ ocirc  => 'ô',  # small o, circumflex accent\r
+ ograve => 'ò',  # small o, grave accent\r
+ oslash => 'ø',  # small o, slash\r
+ otilde => 'õ',  # small o, tilde\r
+ ouml   => 'ö',  # small o, dieresis or umlaut mark\r
+ szlig  => 'ß',  # small sharp s, German (sz ligature)\r
+ thorn  => 'þ',  # small thorn, Icelandic\r
+ uacute => 'ú',  # small u, acute accent\r
+ ucirc  => 'û',  # small u, circumflex accent\r
+ ugrave => 'ù',  # small u, grave accent\r
+ uuml   => 'ü',  # small u, dieresis or umlaut mark\r
+ yacute => 'ý',  # small y, acute accent\r
+ yuml   => 'ÿ',  # small y, dieresis or umlaut mark\r
+\r
+ # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96)\r
+ copy   => '©',  # copyright sign\r
+ reg    => '®',  # registered sign\r
+ nbsp   => "\240", # non breaking space\r
+\r
+ # Additional ISO-8859/1 entities listed in rfc1866 (section 14)\r
+ iexcl  => '¡',\r
+ cent   => '¢',\r
+ pound  => '£',\r
+ curren => '¤',\r
+ yen    => '¥',\r
+ brvbar => '¦',\r
+ sect   => '§',\r
+ uml    => '¨',\r
+ ordf   => 'ª',\r
+ laquo  => '«',\r
+'not'   => '¬',    # not is a keyword in perl\r
+ shy    => '­',\r
+ macr   => '¯',\r
+ deg    => '°',\r
+ plusmn => '±',\r
+ sup1   => '¹',\r
+ sup2   => '²',\r
+ sup3   => '³',\r
+ acute  => '´',\r
+ micro  => 'µ',\r
+ para   => '¶',\r
+ middot => '·',\r
+ cedil  => '¸',\r
+ ordm   => 'º',\r
+ raquo  => '»',\r
+ frac14 => '¼',\r
+ frac12 => '½',\r
+ frac34 => '¾',\r
+ iquest => '¿',\r
+'times' => '×',    # times is a keyword in perl\r
+ divide => '÷',\r
+\r
+# some POD special entities\r
+ verbar => '|',\r
+ sol => '/'\r
+);\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+##---------------------------------\r
+## Function definitions begin here\r
+##---------------------------------\r
+\r
+sub podchecker {\r
+    my ($infile, $outfile, %options) = @_;\r
+    local $_;\r
+\r
+    ## Set defaults\r
+    $infile  ||= \*STDIN;\r
+    $outfile ||= \*STDERR;\r
+\r
+    ## Now create a pod checker\r
+    my $checker = new Pod::Checker(%options);\r
+\r
+    ## Now check the pod document for errors\r
+    $checker->parse_from_file($infile, $outfile);\r
+\r
+    ## Return the number of errors found\r
+    return $checker->num_errors();\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+##-------------------------------\r
+## Method definitions begin here\r
+##-------------------------------\r
+\r
+##################################\r
+\r
+=over 4\r
+\r
+=item C<Pod::Checker-E<gt>new( %options )>\r
+\r
+Return a reference to a new Pod::Checker object that inherits from\r
+Pod::Parser and is used for calling the required methods later. The\r
+following options are recognized:\r
+\r
+C<-warnings =E<gt> num>\r
+  Print warnings if C<num> is true. The higher the value of C<num>,\r
+the more warnings are printed. Currently there are only levels 1 and 2.\r
+\r
+C<-quiet =E<gt> num>\r
+  If C<num> is true, do not print any errors/warnings. This is useful\r
+when Pod::Checker is used to munge POD code into plain text from within\r
+POD formatters.\r
+\r
+=cut\r
+\r
+## sub new {\r
+##     my $this = shift;\r
+##     my $class = ref($this) || $this;\r
+##     my %params = @_;\r
+##     my $self = {%params};\r
+##     bless $self, $class;\r
+##     $self->initialize();\r
+##     return $self;\r
+## }\r
+\r
+sub initialize {\r
+    my $self = shift;\r
+    ## Initialize number of errors, and setup an error function to\r
+    ## increment this number and then print to the designated output.\r
+    $self->{_NUM_ERRORS} = 0;\r
+    $self->{_NUM_WARNINGS} = 0;\r
+    $self->{-quiet} ||= 0;\r
+    # set the error handling subroutine\r
+    $self->errorsub($self->{-quiet} ? sub { 1; } : 'poderror');\r
+    $self->{_commands} = 0; # total number of POD commands encountered\r
+    $self->{_list_stack} = []; # stack for nested lists\r
+    $self->{_have_begin} = ''; # stores =begin\r
+    $self->{_links} = []; # stack for internal hyperlinks\r
+    $self->{_nodes} = []; # stack for =head/=item nodes\r
+    $self->{_index} = []; # text in X<>\r
+    # print warnings?\r
+    $self->{-warnings} = 1 unless(defined $self->{-warnings});\r
+    $self->{_current_head1} = ''; # the current =head1 block\r
+    $self->parseopts(-process_cut_cmd => 1, -warnings => $self->{-warnings});\r
+}\r
+\r
+##################################\r
+\r
+=item C<$checker-E<gt>poderror( @args )>\r
+\r
+=item C<$checker-E<gt>poderror( {%opts}, @args )>\r
+\r
+Internal method for printing errors and warnings. If no options are\r
+given, simply prints "@_". The following options are recognized and used\r
+to form the output:\r
+\r
+  -msg\r
+\r
+A message to print prior to C<@args>.\r
+\r
+  -line\r
+\r
+The line number the error occurred in.\r
+\r
+  -file\r
+\r
+The file (name) the error occurred in.\r
+\r
+  -severity\r
+\r
+The error level, should be 'WARNING' or 'ERROR'.\r
+\r
+=cut\r
+\r
+# Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args )\r
+sub poderror {\r
+    my $self = shift;\r
+    my %opts = (ref $_[0]) ? %{shift()} : ();\r
+\r
+    ## Retrieve options\r
+    chomp( my $msg  = ($opts{-msg} || '')."@_" );\r
+    my $line = (exists $opts{-line}) ? " at line $opts{-line}" : '';\r
+    my $file = (exists $opts{-file}) ? " in file $opts{-file}" : '';\r
+    unless (exists $opts{-severity}) {\r
+       ## See if can find severity in message prefix\r
+       $opts{-severity} = $1  if ( $msg =~ s/^\**\s*([A-Z]{3,}):\s+// );\r
+    }\r
+    my $severity = (exists $opts{-severity}) ? "*** $opts{-severity}: " : '';\r
+\r
+    ## Increment error count and print message "\r
+    ++($self->{_NUM_ERRORS})\r
+        if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR'));\r
+    ++($self->{_NUM_WARNINGS})\r
+        if(!%opts || ($opts{-severity} && $opts{-severity} eq 'WARNING'));\r
+    unless($self->{-quiet}) {\r
+      my $out_fh = $self->output_handle() || \*STDERR;\r
+      print $out_fh ($severity, $msg, $line, $file, "\n")\r
+        if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING');\r
+    }\r
+}\r
+\r
+##################################\r
+\r
+=item C<$checker-E<gt>num_errors()>\r
+\r
+Set (if argument specified) and retrieve the number of errors found.\r
+\r
+=cut\r
+\r
+sub num_errors {\r
+   return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS};\r
+}\r
+\r
+##################################\r
+\r
+=item C<$checker-E<gt>num_warnings()>\r
+\r
+Set (if argument specified) and retrieve the number of warnings found.\r
+\r
+=cut\r
+\r
+sub num_warnings {\r
+   return (@_ > 1) ? ($_[0]->{_NUM_WARNINGS} = $_[1]) : $_[0]->{_NUM_WARNINGS};\r
+}\r
+\r
+##################################\r
+\r
+=item C<$checker-E<gt>name()>\r
+\r
+Set (if argument specified) and retrieve the canonical name of POD as\r
+found in the C<=head1 NAME> section.\r
+\r
+=cut\r
+\r
+sub name {\r
+    return (@_ > 1 && $_[1]) ?\r
+        ($_[0]->{-name} = $_[1]) : $_[0]->{-name};\r
+}\r
+\r
+##################################\r
+\r
+=item C<$checker-E<gt>node()>\r
+\r
+Add (if argument specified) and retrieve the nodes (as defined by C<=headX>\r
+and C<=item>) of the current POD. The nodes are returned in the order of\r
+their occurrence. They consist of plain text, each piece of whitespace is\r
+collapsed to a single blank.\r
+\r
+=cut\r
+\r
+sub node {\r
+    my ($self,$text) = @_;\r
+    if(defined $text) {\r
+        $text =~ s/\s+$//s; # strip trailing whitespace\r
+        $text =~ s/\s+/ /gs; # collapse whitespace\r
+        # add node, order important!\r
+        push(@{$self->{_nodes}}, $text);\r
+        # keep also a uniqueness counter\r
+        $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s);\r
+        return $text;\r
+    }\r
+    @{$self->{_nodes}};\r
+}\r
+\r
+##################################\r
+\r
+=item C<$checker-E<gt>idx()>\r
+\r
+Add (if argument specified) and retrieve the index entries (as defined by\r
+C<XE<lt>E<gt>>) of the current POD. They consist of plain text, each piece\r
+of whitespace is collapsed to a single blank.\r
+\r
+=cut\r
+\r
+# set/return index entries of current POD\r
+sub idx {\r
+    my ($self,$text) = @_;\r
+    if(defined $text) {\r
+        $text =~ s/\s+$//s; # strip trailing whitespace\r
+        $text =~ s/\s+/ /gs; # collapse whitespace\r
+        # add node, order important!\r
+        push(@{$self->{_index}}, $text);\r
+        # keep also a uniqueness counter\r
+        $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s);\r
+        return $text;\r
+    }\r
+    @{$self->{_index}};\r
+}\r
+\r
+##################################\r
+\r
+=item C<$checker-E<gt>hyperlink()>\r
+\r
+Add (if argument specified) and retrieve the hyperlinks (as defined by\r
+C<LE<lt>E<gt>>) of the current POD. They consist of a 2-item array: line\r
+number and C<Pod::Hyperlink> object.\r
+\r
+=back\r
+\r
+=cut\r
+\r
+# set/return hyperlinks of the current POD\r
+sub hyperlink {\r
+    my $self = shift;\r
+    if($_[0]) {\r
+        push(@{$self->{_links}}, $_[0]);\r
+        return $_[0];\r
+    }\r
+    @{$self->{_links}};\r
+}\r
+\r
+## overrides for Pod::Parser\r
+\r
+sub end_pod {\r
+    ## Do some final checks and\r
+    ## print the number of errors found\r
+    my $self   = shift;\r
+    my $infile = $self->input_file();\r
+\r
+    if(@{$self->{_list_stack}}) {\r
+        my $list;\r
+        while(($list = $self->_close_list('EOF',$infile)) &&\r
+          $list->indent() ne 'auto') {\r
+            $self->poderror({ -line => 'EOF', -file => $infile,\r
+                -severity => 'ERROR', -msg => '=over on line ' .\r
+                $list->start() . ' without closing =back' });\r
+        }\r
+    }\r
+\r
+    # check validity of document internal hyperlinks\r
+    # first build the node names from the paragraph text\r
+    my %nodes;\r
+    foreach($self->node()) {\r
+        $nodes{$_} = 1;\r
+        if(/^(\S+)\s+\S/) {\r
+            # we have more than one word. Use the first as a node, too.\r
+            # This is used heavily in perlfunc.pod\r
+            $nodes{$1} ||= 2; # derived node\r
+        }\r
+    }\r
+    foreach($self->idx()) {\r
+        $nodes{$_} = 3; # index node\r
+    }\r
+    foreach($self->hyperlink()) {\r
+        my ($line,$link) = @$_;\r
+        # _TODO_ what if there is a link to the page itself by the name,\r
+        # e.g. in Tk::Pod : L<Tk::Pod/"DESCRIPTION">\r
+        if($link->node() && !$link->page() && $link->type() ne 'hyperlink') {\r
+            my $node = $self->_check_ptree($self->parse_text($link->node(),\r
+                $line), $line, $infile, 'L');\r
+            if($node && !$nodes{$node}) {\r
+                $self->poderror({ -line => $line || '', -file => $infile,\r
+                    -severity => 'ERROR',\r
+                    -msg => "unresolved internal link '$node'"});\r
+            }\r
+        }\r
+    }\r
+\r
+    # check the internal nodes for uniqueness. This pertains to\r
+    # =headX, =item and X<...>\r
+    if($self->{-warnings} && $self->{-warnings}>1) {\r
+      foreach(grep($self->{_unique_nodes}->{$_} > 1,\r
+        keys %{$self->{_unique_nodes}})) {\r
+          $self->poderror({ -line => '-', -file => $infile,\r
+            -severity => 'WARNING',\r
+            -msg => "multiple occurrence of link target '$_'"});\r
+      }\r
+    }\r
+\r
+    # no POD found here\r
+    $self->num_errors(-1) if($self->{_commands} == 0);\r
+}\r
+\r
+# check a POD command directive\r
+sub command {\r
+    my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_;\r
+    my ($file, $line) = $pod_para->file_line;\r
+    ## Check the command syntax\r
+    my $arg; # this will hold the command argument\r
+    if (! $VALID_COMMANDS{$cmd}) {\r
+       $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR',\r
+                         -msg => "Unknown command '$cmd'" });\r
+    }\r
+    else { # found a valid command\r
+        $self->{_commands}++; # delete this line if below is enabled again\r
+\r
+       $self->_commands_in_paragraphs($paragraph, $pod_para);\r
+\r
+        ##### following check disabled due to strong request\r
+        #if(!$self->{_commands}++ && $cmd !~ /^head/) {\r
+        #    $self->poderror({ -line => $line, -file => $file,\r
+        #         -severity => 'WARNING',\r
+        #         -msg => "file does not start with =head" });\r
+        #}\r
+\r
+        # check syntax of particular command\r
+        if($cmd eq 'over') {\r
+            # check for argument\r
+            $arg = $self->interpolate_and_check($paragraph, $line,$file);\r
+            my $indent = 4; # default\r
+            if($arg && $arg =~ /^\s*(\d+)\s*$/) {\r
+                $indent = $1;\r
+            }\r
+            # start a new list\r
+            $self->_open_list($indent,$line,$file);\r
+        }\r
+        elsif($cmd eq 'item') {\r
+            # are we in a list?\r
+            unless(@{$self->{_list_stack}}) {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                     -severity => 'ERROR',\r
+                     -msg => '=item without previous =over' });\r
+                # auto-open in case we encounter many more\r
+                $self->_open_list('auto',$line,$file);\r
+            }\r
+            my $list = $self->{_list_stack}->[0];\r
+            # check whether the previous item had some contents\r
+            if(defined $self->{_list_item_contents} &&\r
+              $self->{_list_item_contents} == 0) {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                     -severity => 'WARNING',\r
+                     -msg => 'previous =item has no contents' });\r
+            }\r
+            if($list->{_has_par}) {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                     -severity => 'WARNING',\r
+                     -msg => 'preceding non-item paragraph(s)' });\r
+                delete $list->{_has_par};\r
+            }\r
+            # check for argument\r
+            $arg = $self->interpolate_and_check($paragraph, $line, $file);\r
+            if($arg && $arg =~ /(\S+)/) {\r
+                $arg =~ s/[\s\n]+$//;\r
+                my $type;\r
+                if($arg =~ /^[*]\s*(\S*.*)/) {\r
+                  $type = 'bullet';\r
+                  $self->{_list_item_contents} = $1 ? 1 : 0;\r
+                  $arg = $1;\r
+                }\r
+                elsif($arg =~ /^\d+\.?\s+(\S*)/) {\r
+                  $type = 'number';\r
+                  $self->{_list_item_contents} = $1 ? 1 : 0;\r
+                  $arg = $1;\r
+                }\r
+                else {\r
+                  $type = 'definition';\r
+                  $self->{_list_item_contents} = 1;\r
+                }\r
+                my $first = $list->type();\r
+                if($first && $first ne $type) {\r
+                    $self->poderror({ -line => $line, -file => $file,\r
+                       -severity => 'WARNING',\r
+                       -msg => "=item type mismatch ('$first' vs. '$type')"});\r
+                }\r
+                else { # first item\r
+                    $list->type($type);\r
+                }\r
+            }\r
+            else {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                     -severity => 'WARNING',\r
+                     -msg => 'No argument for =item' });\r
+                $arg = ' '; # empty\r
+                $self->{_list_item_contents} = 0;\r
+            }\r
+            # add this item\r
+            $list->item($arg);\r
+            # remember this node\r
+            $self->node($arg);\r
+        }\r
+        elsif($cmd eq 'back') {\r
+            # check if we have an open list\r
+            unless(@{$self->{_list_stack}}) {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                         -severity => 'ERROR',\r
+                         -msg => '=back without previous =over' });\r
+            }\r
+            else {\r
+                # check for spurious characters\r
+                $arg = $self->interpolate_and_check($paragraph, $line,$file);\r
+                if($arg && $arg =~ /\S/) {\r
+                    $self->poderror({ -line => $line, -file => $file,\r
+                         -severity => 'ERROR',\r
+                         -msg => 'Spurious character(s) after =back' });\r
+                }\r
+                # close list\r
+                my $list = $self->_close_list($line,$file);\r
+                # check for empty lists\r
+                if(!$list->item() && $self->{-warnings}) {\r
+                    $self->poderror({ -line => $line, -file => $file,\r
+                         -severity => 'WARNING',\r
+                         -msg => 'No items in =over (at line ' .\r
+                         $list->start() . ') / =back list'});\r
+                }\r
+            }\r
+        }\r
+        elsif($cmd =~ /^head(\d+)/) {\r
+            my $hnum = $1;\r
+            $self->{"_have_head_$hnum"}++; # count head types\r
+            if($hnum > 1 && !$self->{'_have_head_'.($hnum -1)}) {\r
+              $self->poderror({ -line => $line, -file => $file,\r
+                   -severity => 'WARNING',\r
+                   -msg => "=head$hnum without preceding higher level"});\r
+            }\r
+            # check whether the previous =head section had some contents\r
+            if(defined $self->{_commands_in_head} &&\r
+              $self->{_commands_in_head} == 0 &&\r
+              defined $self->{_last_head} &&\r
+              $self->{_last_head} >= $hnum) {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                     -severity => 'WARNING',\r
+                     -msg => 'empty section in previous paragraph'});\r
+            }\r
+            $self->{_commands_in_head} = -1;\r
+            $self->{_last_head} = $hnum;\r
+            # check if there is an open list\r
+            if(@{$self->{_list_stack}}) {\r
+                my $list;\r
+                while(($list = $self->_close_list($line,$file)) &&\r
+                  $list->indent() ne 'auto') {\r
+                    $self->poderror({ -line => $line, -file => $file,\r
+                         -severity => 'ERROR',\r
+                         -msg => '=over on line '. $list->start() .\r
+                         " without closing =back (at $cmd)" });\r
+                }\r
+            }\r
+            # remember this node\r
+            $arg = $self->interpolate_and_check($paragraph, $line,$file);\r
+            $arg =~ s/[\s\n]+$//s;\r
+            $self->node($arg);\r
+            unless(length($arg)) {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                     -severity => 'ERROR',\r
+                     -msg => "empty =$cmd"});\r
+            }\r
+            if($cmd eq 'head1') {\r
+                $self->{_current_head1} = $arg;\r
+            } else {\r
+                $self->{_current_head1} = '';\r
+            }\r
+        }\r
+        elsif($cmd eq 'begin') {\r
+            if($self->{_have_begin}) {\r
+                # already have a begin\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                     -severity => 'ERROR',\r
+                     -msg => q{Nested =begin's (first at line } .\r
+                     $self->{_have_begin} . ')'});\r
+            }\r
+            else {\r
+                # check for argument\r
+                $arg = $self->interpolate_and_check($paragraph, $line,$file);\r
+                unless($arg && $arg =~ /(\S+)/) {\r
+                    $self->poderror({ -line => $line, -file => $file,\r
+                         -severity => 'ERROR',\r
+                         -msg => 'No argument for =begin'});\r
+                }\r
+                # remember the =begin\r
+                $self->{_have_begin} = "$line:$1";\r
+            }\r
+        }\r
+        elsif($cmd eq 'end') {\r
+            if($self->{_have_begin}) {\r
+                # close the existing =begin\r
+                $self->{_have_begin} = '';\r
+                # check for spurious characters\r
+                $arg = $self->interpolate_and_check($paragraph, $line,$file);\r
+                # the closing argument is optional\r
+                #if($arg && $arg =~ /\S/) {\r
+                #    $self->poderror({ -line => $line, -file => $file,\r
+                #         -severity => 'WARNING',\r
+                #         -msg => "Spurious character(s) after =end" });\r
+                #}\r
+            }\r
+            else {\r
+                # don't have a matching =begin\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                     -severity => 'ERROR',\r
+                     -msg => '=end without =begin' });\r
+            }\r
+        }\r
+        elsif($cmd eq 'for') {\r
+            unless($paragraph =~ /\s*(\S+)\s*/) {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                     -severity => 'ERROR',\r
+                     -msg => '=for without formatter specification' });\r
+            }\r
+            $arg = ''; # do not expand paragraph below\r
+        }\r
+        elsif($cmd =~ /^(pod|cut)$/) {\r
+            # check for argument\r
+            $arg = $self->interpolate_and_check($paragraph, $line,$file);\r
+            if($arg && $arg =~ /(\S+)/) {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                      -severity => 'ERROR',\r
+                      -msg => "Spurious text after =$cmd"});\r
+            }\r
+           if($cmd eq 'cut' && (!$self->{_PREVIOUS} || $self->{_PREVIOUS} eq 'cut')) {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                      -severity => 'ERROR',\r
+                      -msg => "Spurious =cut command"});\r
+           }\r
+           if($cmd eq 'pod' && $self->{_PREVIOUS} && $self->{_PREVIOUS} ne 'cut') {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                      -severity => 'ERROR',\r
+                      -msg => "Spurious =pod command"});\r
+           }\r
+        }\r
+    $self->{_commands_in_head}++;\r
+    ## Check the interior sequences in the command-text\r
+    $self->interpolate_and_check($paragraph, $line,$file)\r
+        unless(defined $arg);\r
+    }\r
+}\r
+\r
+sub _open_list\r
+{\r
+    my ($self,$indent,$line,$file) = @_;\r
+    my $list = Pod::List->new(\r
+           -indent => $indent,\r
+           -start => $line,\r
+           -file => $file);\r
+    unshift(@{$self->{_list_stack}}, $list);\r
+    undef $self->{_list_item_contents};\r
+    $list;\r
+}\r
+\r
+sub _close_list\r
+{\r
+    my ($self,$line,$file) = @_;\r
+    my $list = shift(@{$self->{_list_stack}});\r
+    if(defined $self->{_list_item_contents} &&\r
+      $self->{_list_item_contents} == 0) {\r
+        $self->poderror({ -line => $line, -file => $file,\r
+            -severity => 'WARNING',\r
+            -msg => 'previous =item has no contents' });\r
+    }\r
+    undef $self->{_list_item_contents};\r
+    $list;\r
+}\r
+\r
+# process a block of some text\r
+sub interpolate_and_check {\r
+    my ($self, $paragraph, $line, $file) = @_;\r
+    ## Check the interior sequences in the command-text\r
+    # and return the text\r
+    $self->_check_ptree(\r
+        $self->parse_text($paragraph,$line), $line, $file, '');\r
+}\r
+\r
+sub _check_ptree {\r
+    my ($self,$ptree,$line,$file,$nestlist) = @_;\r
+    local($_);\r
+    my $text = '';\r
+    # process each node in the parse tree\r
+    foreach(@$ptree) {\r
+        # regular text chunk\r
+        unless(ref) {\r
+            # count the unescaped angle brackets\r
+            # complain only when warning level is greater than 1\r
+            if($self->{-warnings} && $self->{-warnings}>1) {\r
+              my $count;\r
+              if($count = tr/<>/<>/) {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                     -severity => 'WARNING',\r
+                     -msg => "$count unescaped <> in paragraph" });\r
+                }\r
+            }\r
+            $text .= $_;\r
+            next;\r
+        }\r
+        # have an interior sequence\r
+        my $cmd = $_->cmd_name();\r
+        my $contents = $_->parse_tree();\r
+        ($file,$line) = $_->file_line();\r
+        # check for valid tag\r
+        if (! $VALID_SEQUENCES{$cmd}) {\r
+            $self->poderror({ -line => $line, -file => $file,\r
+                 -severity => 'ERROR',\r
+                 -msg => qq(Unknown interior-sequence '$cmd')});\r
+            # expand it anyway\r
+            $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");\r
+            next;\r
+        }\r
+        if(index($nestlist, $cmd) != -1) {\r
+            $self->poderror({ -line => $line, -file => $file,\r
+                 -severity => 'WARNING',\r
+                 -msg => "nested commands $cmd<...$cmd<...>...>"});\r
+            # _TODO_ should we add the contents anyway?\r
+            # expand it anyway, see below\r
+        }\r
+        if($cmd eq 'E') {\r
+            # preserve entities\r
+            if(@$contents > 1 || ref $$contents[0] || $$contents[0] !~ /^\w+$/) {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                    -severity => 'ERROR',\r
+                    -msg => 'garbled entity ' . $_->raw_text()});\r
+                next;\r
+            }\r
+            my $ent = $$contents[0];\r
+            my $val;\r
+            if($ent =~ /^0x[0-9a-f]+$/i) {\r
+                # hexadec entity\r
+                $val = hex($ent);\r
+            }\r
+            elsif($ent =~ /^0\d+$/) {\r
+                # octal\r
+                $val = oct($ent);\r
+            }\r
+            elsif($ent =~ /^\d+$/) {\r
+                # numeric entity\r
+                $val = $ent;\r
+            }\r
+            if(defined $val) {\r
+                if($val>0 && $val<256) {\r
+                    $text .= chr($val);\r
+                }\r
+                else {\r
+                    $self->poderror({ -line => $line, -file => $file,\r
+                        -severity => 'ERROR',\r
+                        -msg => 'Entity number out of range ' . $_->raw_text()});\r
+                }\r
+            }\r
+            elsif($ENTITIES{$ent}) {\r
+                # known ISO entity\r
+                $text .= $ENTITIES{$ent};\r
+            }\r
+            else {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                    -severity => 'WARNING',\r
+                    -msg => 'Unknown entity ' . $_->raw_text()});\r
+                $text .= "E<$ent>";\r
+            }\r
+        }\r
+        elsif($cmd eq 'L') {\r
+            # try to parse the hyperlink\r
+            my $link = Pod::Hyperlink->new($contents->raw_text());\r
+            unless(defined $link) {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                    -severity => 'ERROR',\r
+                    -msg => 'malformed link ' . $_->raw_text() ." : $@"});\r
+                next;\r
+            }\r
+            $link->line($line); # remember line\r
+            if($self->{-warnings}) {\r
+                foreach my $w ($link->warning()) {\r
+                    $self->poderror({ -line => $line, -file => $file,\r
+                        -severity => 'WARNING',\r
+                        -msg => $w });\r
+                }\r
+            }\r
+            # check the link text\r
+            $text .= $self->_check_ptree($self->parse_text($link->text(),\r
+                $line), $line, $file, "$nestlist$cmd");\r
+            # remember link\r
+            $self->hyperlink([$line,$link]);\r
+        }\r
+        elsif($cmd =~ /[BCFIS]/) {\r
+            # add the guts\r
+            $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");\r
+        }\r
+        elsif($cmd eq 'Z') {\r
+            if(length($contents->raw_text())) {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                    -severity => 'ERROR',\r
+                    -msg => 'Nonempty Z<>'});\r
+            }\r
+        }\r
+        elsif($cmd eq 'X') {\r
+            my $idx = $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");\r
+            if($idx =~ /^\s*$/s) {\r
+                $self->poderror({ -line => $line, -file => $file,\r
+                    -severity => 'ERROR',\r
+                    -msg => 'Empty X<>'});\r
+            }\r
+            else {\r
+                # remember this node\r
+                $self->idx($idx);\r
+            }\r
+        }\r
+        else {\r
+            # not reached\r
+            croak 'internal error';\r
+        }\r
+    }\r
+    $text;\r
+}\r
+\r
+# process a block of verbatim text\r
+sub verbatim {\r
+    ## Nothing particular to check\r
+    my ($self, $paragraph, $line_num, $pod_para) = @_;\r
+\r
+    $self->_preproc_par($paragraph);\r
+    $self->_commands_in_paragraphs($paragraph, $pod_para);\r
+\r
+    if($self->{_current_head1} eq 'NAME') {\r
+        my ($file, $line) = $pod_para->file_line;\r
+        $self->poderror({ -line => $line, -file => $file,\r
+            -severity => 'WARNING',\r
+            -msg => 'Verbatim paragraph in NAME section' });\r
+    }\r
+}\r
+\r
+# process a block of regular text\r
+sub textblock {\r
+    my ($self, $paragraph, $line_num, $pod_para) = @_;\r
+    my ($file, $line) = $pod_para->file_line;\r
+\r
+    $self->_preproc_par($paragraph);\r
+    $self->_commands_in_paragraphs($paragraph, $pod_para);\r
+\r
+    # skip this paragraph if in a =begin block\r
+    unless($self->{_have_begin}) {\r
+        my $block = $self->interpolate_and_check($paragraph, $line,$file);\r
+        if($self->{_current_head1} eq 'NAME') {\r
+            if($block =~ /^\s*(\S+?)\s*[,-]/) {\r
+                # this is the canonical name\r
+                $self->{-name} = $1 unless(defined $self->{-name});\r
+            }\r
+        }\r
+    }\r
+}\r
+\r
+sub _preproc_par\r
+{\r
+    my $self = shift;\r
+    $_[0] =~ s/[\s\n]+$//;\r
+    if($_[0]) {\r
+        $self->{_commands_in_head}++;\r
+        $self->{_list_item_contents}++ if(defined $self->{_list_item_contents});\r
+        if(@{$self->{_list_stack}} && !$self->{_list_stack}->[0]->item()) {\r
+            $self->{_list_stack}->[0]->{_has_par} = 1;\r
+        }\r
+    }\r
+}\r
+\r
+# look for =foo commands at the start of a line within a paragraph, as for\r
+# instance the following which prints as "* one =item two".\r
+#\r
+#     =item one\r
+#     =item two\r
+#\r
+# Examples of =foo written in docs are expected to be indented in a verbatim\r
+# or marked up C<=foo> so won't be caught.  A double-angle C<< =foo >> could\r
+# have the =foo at the start of a line, but that should be unlikely and is\r
+# easily enough dealt with by not putting a newline after the C<<.\r
+#\r
+sub _commands_in_paragraphs {\r
+  my ($self, $str, $pod_para) = @_;\r
+  while ($str =~ /[^\n]\n=([a-z][a-z0-9]+)/sg) {\r
+    my $cmd = $1;\r
+    my $pos = pos($str);\r
+    if ($VALID_COMMANDS{$cmd}) {\r
+      my ($file, $line) = $pod_para->file_line;\r
+      my $part = substr($str, 0, $pos);\r
+      $line += ($part =~ tr/\n//);  # count of newlines\r
+\r
+      $self->poderror\r
+        ({ -line => $line, -file => $file,\r
+           -severity => 'ERROR',\r
+           -msg => "Apparent command =$cmd not preceded by blank line"});\r
+    }\r
+  }\r
+}\r
+\r
+1;\r
+\r
+__END__\r
+\r
+=head1 AUTHOR\r
+\r
+Please report bugs using L<http://rt.cpan.org>.\r
+\r
+Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version),\r
+Marek Rouchal E<lt>marekr@cpan.orgE<gt>\r
+\r
+Based on code for B<Pod::Text::pod2text()> written by\r
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>\r
+\r
+B<Pod::Checker> is part of the Pod-Checker distribution, and is based on\r
+L<Pod::Parser>.\r
+\r
+=cut\r
+\r
similarity index 96%
rename from cpan/Pod-Parser/scripts/podchecker.PL
rename to cpan/Pod-Checker/scripts/podchecker.PL
index 75c316d..2c33e8c 100644 (file)
-#!/usr/local/bin/perl
-
-use Config;
-use File::Basename qw(&basename &dirname);
-use Cwd;
-
-# List explicitly here the variables you want Configure to
-# generate.  Metaconfig only looks for shell variables, so you
-# have to mention them as if they were shell variables, not
-# %Config entries.  Thus you write
-#  $startperl
-# to ensure Configure will look for $Config{startperl}.
-
-# This forces PL files to create target in same directory as PL file.
-# This is so that make depend always knows where to find PL derivatives.
-$origdir = cwd;
-chdir(dirname($0));
-($file = basename($0)) =~ s/\.PL$//;
-$file =~ s/\.pl$//
-        if ($^O eq 'VMS' or $^O eq 'os2' or $^O eq 'dos');  # "case-forgiving"
-$file .= '.com' if $^O eq 'VMS';
-
-open OUT,">$file" or die "Can't create $file: $!";
-
-print "Extracting $file (with variable substitutions)\n";
-
-# In this section, perl variables will be expanded during extraction.
-# You can use $Config{...} to use Configure variables.
-
-print OUT <<"!GROK!THIS!";
-$Config{'startperl'}
-    eval 'exec perl -S \$0 "\$@"'
-        if 0;
-!GROK!THIS!
-
-# In the following, perl variables are not expanded during extraction.
-
-print OUT <<'!NO!SUBS!';
-#############################################################################
-# podchecker -- command to invoke the podchecker function in Pod::Checker
-#
-# Copyright (c) 1998-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.
-#############################################################################
-
-use strict;
-#use diagnostics;
-
-=head1 NAME
-
-podchecker - check the syntax of POD format documentation files
-
-=head1 SYNOPSIS
-
-B<podchecker> [B<-help>] [B<-man>] [B<-(no)warnings>] [I<file>S< >...]
-
-=head1 OPTIONS AND ARGUMENTS
-
-=over 8
-
-=item B<-help>
-
-Print a brief help message and exit.
-
-=item B<-man>
-
-Print the manual page and exit.
-
-=item B<-warnings> B<-nowarnings>
-
-Turn on/off printing of warnings. Repeating B<-warnings> increases the
-warning level, i.e. more warnings are printed. Currently increasing to
-level two causes flagging of unescaped "E<lt>,E<gt>" characters.
-
-=item I<file>
-
-The pathname of a POD file to syntax-check (defaults to standard input).
-
-=back
-
-=head1 DESCRIPTION
-
-B<podchecker> will read the given input files looking for POD
-syntax errors in the POD documentation and will print any errors
-it find to STDERR. At the end, it will print a status message
-indicating the number of errors found.
-
-Directories are ignored, an appropriate warning message is printed.
-
-B<podchecker> invokes the B<podchecker()> function exported by B<Pod::Checker>
-Please see L<Pod::Checker/podchecker()> for more details.
-
-=head1 RETURN VALUE
-
-B<podchecker> returns a 0 (zero) exit status if all specified
-POD files are ok.
-
-=head1 ERRORS
-
-B<podchecker> returns the exit status 1 if at least one of
-the given POD files has syntax errors.
-
-The status 2 indicates that at least one of the specified 
-files does not contain I<any> POD commands.
-
-Status 1 overrides status 2. If you want unambiguous
-results, call B<podchecker> with one single argument only.
-
-=head1 SEE ALSO
-
-L<Pod::Parser> and L<Pod::Checker>
-
-=head1 AUTHORS
-
-Please report bugs using L<http://rt.cpan.org>.
-
-Brad Appleton E<lt>bradapp@enteract.comE<gt>,
-Marek Rouchal E<lt>marekr@cpan.orgE<gt>
-
-Based on code for B<Pod::Text::pod2text(1)> written by
-Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
-
-=cut
-
-
-use Pod::Checker;
-use Pod::Usage;
-use Getopt::Long;
-
-## Define options
-my %options;
-
-## Parse options
-GetOptions(\%options, qw(help man warnings+ nowarnings))  ||  pod2usage(2);
-pod2usage(1)  if ($options{help});
-pod2usage(-verbose => 2)  if ($options{man});
-
-if($options{nowarnings}) {
-  $options{warnings} = 0;
-}
-elsif(!defined $options{warnings}) {
-  $options{warnings} = 1; # default is warnings on
-}
-
-## Dont default to STDIN if connected to a terminal
-pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
-
-## Invoke podchecker()
-my $status = 0;
-@ARGV = qw(-) unless(@ARGV);
-for my $podfile (@ARGV) {
-    if($podfile eq '-') {
-      $podfile = '<&STDIN';
-    }
-    elsif(-d $podfile) {
-      warn "podchecker: Warning: Ignoring directory '$podfile'\n";
-      next;
-    }
-    my $errors =
-      podchecker($podfile, undef, '-warnings' => $options{warnings});
-    if($errors > 0) {
-        # errors occurred
-        $status = 1;
-        printf STDERR ("%s has %d pod syntax %s.\n",
-          $podfile, $errors,
-          ($errors == 1) ? 'error' : 'errors');
-    }
-    elsif($errors < 0) {
-        # no pod found
-        $status = 2 unless($status);
-        print STDERR "$podfile does not contain any pod commands.\n";
-    }
-    else {
-        print STDERR "$podfile pod syntax OK.\n";
-    }
-}
-exit $status;
-
-!NO!SUBS!
-
-close OUT or die "Can't close $file: $!";
-chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
-exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
-chdir $origdir;
+#!/usr/local/bin/perl\r
+\r
+use Config;\r
+use File::Basename qw(&basename &dirname);\r
+use Cwd;\r
+\r
+# List explicitly here the variables you want Configure to\r
+# generate.  Metaconfig only looks for shell variables, so you\r
+# have to mention them as if they were shell variables, not\r
+# %Config entries.  Thus you write\r
+#  $startperl\r
+# to ensure Configure will look for $Config{startperl}.\r
+\r
+# This forces PL files to create target in same directory as PL file.\r
+# This is so that make depend always knows where to find PL derivatives.\r
+$origdir = cwd;\r
+chdir(dirname($0));\r
+($file = basename($0)) =~ s/\.PL$//;\r
+$file =~ s/\.pl$//\r
+        if ($^O eq 'VMS' or $^O eq 'os2' or $^O eq 'dos');  # "case-forgiving"\r
+$file .= '.com' if $^O eq 'VMS';\r
+\r
+open OUT,">$file" or die "Can't create $file: $!";\r
+\r
+print "Extracting $file (with variable substitutions)\n";\r
+\r
+# In this section, perl variables will be expanded during extraction.\r
+# You can use $Config{...} to use Configure variables.\r
+\r
+print OUT <<"!GROK!THIS!";\r
+$Config{'startperl'}\r
+    eval 'exec perl -S \$0 "\$@"'\r
+        if 0;\r
+!GROK!THIS!\r
+\r
+# In the following, perl variables are not expanded during extraction.\r
+\r
+print OUT <<'!NO!SUBS!';\r
+#############################################################################\r
+# podchecker -- command to invoke the podchecker function in Pod::Checker\r
+#\r
+# Copyright (c) 1998-2000 by Bradford Appleton. All rights reserved.\r
+# This file is part of "PodParser". PodParser is free software;\r
+# you can redistribute it and/or modify it under the same terms\r
+# as Perl itself.\r
+#############################################################################\r
+\r
+use strict;\r
+#use diagnostics;\r
+\r
+=head1 NAME\r
+\r
+podchecker - check the syntax of POD format documentation files\r
+\r
+=head1 SYNOPSIS\r
+\r
+B<podchecker> [B<-help>] [B<-man>] [B<-(no)warnings>] [I<file>S< >...]\r
+\r
+=head1 OPTIONS AND ARGUMENTS\r
+\r
+=over 8\r
+\r
+=item B<-help>\r
+\r
+Print a brief help message and exit.\r
+\r
+=item B<-man>\r
+\r
+Print the manual page and exit.\r
+\r
+=item B<-warnings> B<-nowarnings>\r
+\r
+Turn on/off printing of warnings. Repeating B<-warnings> increases the\r
+warning level, i.e. more warnings are printed. Currently increasing to\r
+level two causes flagging of unescaped "E<lt>,E<gt>" characters.\r
+\r
+=item I<file>\r
+\r
+The pathname of a POD file to syntax-check (defaults to standard input).\r
+\r
+=back\r
+\r
+=head1 DESCRIPTION\r
+\r
+B<podchecker> will read the given input files looking for POD\r
+syntax errors in the POD documentation and will print any errors\r
+it find to STDERR. At the end, it will print a status message\r
+indicating the number of errors found.\r
+\r
+Directories are ignored, an appropriate warning message is printed.\r
+\r
+B<podchecker> invokes the B<podchecker()> function exported by B<Pod::Checker>\r
+Please see L<Pod::Checker/podchecker()> for more details.\r
+\r
+=head1 RETURN VALUE\r
+\r
+B<podchecker> returns a 0 (zero) exit status if all specified\r
+POD files are ok.\r
+\r
+=head1 ERRORS\r
+\r
+B<podchecker> returns the exit status 1 if at least one of\r
+the given POD files has syntax errors.\r
+\r
+The status 2 indicates that at least one of the specified \r
+files does not contain I<any> POD commands.\r
+\r
+Status 1 overrides status 2. If you want unambiguous\r
+results, call B<podchecker> with one single argument only.\r
+\r
+=head1 SEE ALSO\r
+\r
+L<Pod::Parser> and L<Pod::Checker>\r
+\r
+=head1 AUTHORS\r
+\r
+Please report bugs using L<http://rt.cpan.org>.\r
+\r
+Brad Appleton E<lt>bradapp@enteract.comE<gt>,\r
+Marek Rouchal E<lt>marekr@cpan.orgE<gt>\r
+\r
+Based on code for B<Pod::Text::pod2text(1)> written by\r
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>\r
+\r
+=cut\r
+\r
+\r
+use Pod::Checker;\r
+use Pod::Usage;\r
+use Getopt::Long;\r
+\r
+## Define options\r
+my %options;\r
+\r
+## Parse options\r
+GetOptions(\%options, qw(help man warnings+ nowarnings))  ||  pod2usage(2);\r
+pod2usage(1)  if ($options{help});\r
+pod2usage(-verbose => 2)  if ($options{man});\r
+\r
+if($options{nowarnings}) {\r
+  $options{warnings} = 0;\r
+}\r
+elsif(!defined $options{warnings}) {\r
+  $options{warnings} = 1; # default is warnings on\r
+}\r
+\r
+## Dont default to STDIN if connected to a terminal\r
+pod2usage(2) if ((@ARGV == 0) && (-t STDIN));\r
+\r
+## Invoke podchecker()\r
+my $status = 0;\r
+@ARGV = qw(-) unless(@ARGV);\r
+for my $podfile (@ARGV) {\r
+    if($podfile eq '-') {\r
+      $podfile = '<&STDIN';\r
+    }\r
+    elsif(-d $podfile) {\r
+      warn "podchecker: Warning: Ignoring directory '$podfile'\n";\r
+      next;\r
+    }\r
+    my $errors =\r
+      podchecker($podfile, undef, '-warnings' => $options{warnings});\r
+    if($errors > 0) {\r
+        # errors occurred\r
+        $status = 1;\r
+        printf STDERR ("%s has %d pod syntax %s.\n",\r
+          $podfile, $errors,\r
+          ($errors == 1) ? 'error' : 'errors');\r
+    }\r
+    elsif($errors < 0) {\r
+        # no pod found\r
+        $status = 2 unless($status);\r
+        print STDERR "$podfile does not contain any pod commands.\n";\r
+    }\r
+    else {\r
+        print STDERR "$podfile pod syntax OK.\n";\r
+    }\r
+}\r
+exit $status;\r
+\r
+!NO!SUBS!\r
+\r
+close OUT or die "Can't close $file: $!";\r
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";\r
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';\r
+chdir $origdir;\r
diff --git a/cpan/Pod-Checker/t/pod/contains_bad_pod.xr b/cpan/Pod-Checker/t/pod/contains_bad_pod.xr
new file mode 100644 (file)
index 0000000..c790796
--- /dev/null
@@ -0,0 +1,5 @@
+=head foo\r
+\r
+bar baz.\r
+\r
+=cut\r
diff --git a/cpan/Pod-Checker/t/pod/empty.xr b/cpan/Pod-Checker/t/pod/empty.xr
new file mode 100644 (file)
index 0000000..e69de29
similarity index 94%
rename from cpan/Pod-Parser/t/pod/podchkenc.t
rename to cpan/Pod-Checker/t/pod/podchkenc.t
index ccc2421..e7a5d7a 100644 (file)
@@ -1,29 +1,29 @@
-#!/usr/bin/perl
-BEGIN {
-   use File::Basename;
-   my $THISDIR = dirname $0;
-   unshift @INC, $THISDIR;
-   require "testpchk.pl";
-   import TestPodChecker;
-}
-
-# this tests Pod::Checker accepts =encoding directive
-
-my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
-my $passed  = testpodchecker \%options, $0;
-exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
-
-__END__
-
-=encoding utf8
-
-=encode utf8
-
-dummy error
-
-=head1 An example.
-
-'Twas brillig, and the slithy toves did gyre and gimble in the wabe.
-
-=cut
-
+#!/usr/bin/perl\r
+BEGIN {\r
+   use File::Basename;\r
+   my $THISDIR = dirname $0;\r
+   unshift @INC, $THISDIR;\r
+   require "testpchk.pl";\r
+   import TestPodChecker;\r
+}\r
+\r
+# this tests Pod::Checker accepts =encoding directive\r
+\r
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash\r
+my $passed  = testpodchecker \%options, $0;\r
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};\r
+\r
+__END__\r
+\r
+=encoding utf8\r
+\r
+=encode utf8\r
+\r
+dummy error\r
+\r
+=head1 An example.\r
+\r
+'Twas brillig, and the slithy toves did gyre and gimble in the wabe.\r
+\r
+=cut\r
+\r
similarity index 98%
rename from cpan/Pod-Parser/t/pod/podchkenc.xr
rename to cpan/Pod-Checker/t/pod/podchkenc.xr
index 45ec573..8a21a12 100644 (file)
@@ -1 +1 @@
-*** ERROR: Unknown command 'encode' at line 20 in file t/pod/podchkenc.t
+*** ERROR: Unknown command 'encode' at line 20 in file t/pod/podchkenc.t\r
similarity index 93%
rename from cpan/Pod-Parser/t/pod/poderrs.t
rename to cpan/Pod-Checker/t/pod/poderrs.t
index 03ecc5b..362cbb6 100644 (file)
-BEGIN {
-   use File::Basename;
-   my $THISDIR = dirname $0;
-   unshift @INC, $THISDIR;
-   require "testpchk.pl";
-   import TestPodChecker;
-}
-
-my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
-my $passed  = testpodchecker \%options, $0;
-exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
-
-### Deliberately throw in some blank but non-empty lines
-                                        
-### The above line should contain spaces
-
-
-__END__
-
-=head2 This should cause a warning
-
-=head1 NAME
-
-poderrors.t - test Pod::Checker on some pod syntax errors
-
-=unknown1 this is an unknown command with two N<unknownA>
-and D<unknownB> interior sequences.
-
-This is some paragraph text with some unknown interior sequences,
-such as Q<unknown2>,
-A<unknown3>,
-and Y<unknown4 V<unknown5>>.
-
-Now try some unterminated sequences like
-I<hello mudda!
-B<hello fadda!
-
-Here I am at C<camp granada!
-
-Camps is very,
-entertaining.
-And they say we'll have some fun if it stops raining!
-
-Okay, now use a non-empty blank line to terminate a paragraph and make
-sure we get a warning.
-                                               
-The above blank line contains tabs and spaces only
-
-=head1 Additional tests
-
-=head2 item without over
-
-=item oops
-
-=head2 back without over
-
-=back
-
-=head2 over without back
-
-=over 4
-
-=item aaps
-
-=head2 end without begin
-
-=end
-
-=head2 begin and begin
-
-=begin html
-
-=begin text
-
-=end
-
-=end
-
-second one results in end w/o begin
-
-=head2 begin w/o formatter
-
-=begin
-
-=end
-
-=head2 for w/o formatter
-
-=for
-
-something...
-
-=head2 Nested sequences of the same type
-
-C<code I<italic C<code again!>>>
-
-=head2 Garbled entities
-
-E<alea iacta est>
-E<C<auml>>
-E<abcI<bla>>
-E<0x100>
-E<07777>
-E<300>
-
-=head2 Unresolved internal links
-
-L</"begin or begin">
-L<"end with begin">
-L</OoPs>
-
-=head2 Some links with problems
-
-L<abc
-def>
-L<>
-L<   aha>
-L<oho   >
-L<"Warnings"> this one is ok
-L</unescaped> ok too, this POD has an X of the same name
-L<http://www.perl.org> this is OK
-L<The Perl Home Page|http://www.perl.org> this is also OK
-
-=head2 Warnings
-
-L<passwd(5)>
-L<some text with / in it|perlvar/$|> should give warnings as hell
-
-=over 4
-
-=item bla
-
-=back 200
-
-the 200 is evil
-
-=begin html
-
-What?
-
-=end xml
-
-X<unescaped>see these unescaped < and > in the text?
-
-=head2 Misc
-
-Z<ddd> should be empty
-
-X<> should not be empty
-
-=over four
-
-This paragrapgh is misplaced - it ought to be an item.
-
-=item four should be numeric!
-
-=item
-
-=item blah
-
-=item previous is all empty!!!
-
-=back
-
-All empty over/back:
-
-=over 4
-
-=back
-
-item w/o name
-
-=cut
-
-=pod bla
-
-bla is evil
-
-=cut blub
-
-blub is evil
-
-=head2 reoccurence
-
-=over 4
-
-=item Misc
-
-we already have a head Misc
-
-=back
-
-=head2 some heading
-
-=head2 another one
-
-=head2 the next line should be empty
-=head2 ... but there is a command instead
-
-And here is some text
-=head2 again followed by a command
-
-  verbatim
-=item line missing
-
-previous section is empty!
-
-=head1 LINK TESTS
-
-Due to bug reported by Rafael Garcia-Suarez "rgarciasuarez@free.fr":
-
-The following hyperlinks :
-L<"I/O Operators">
-L<perlop/"I/O Operators">
-trigger a podchecker warning (using bleadperl) :
-    node 'I/O Operators' contains non-escaped | or /
-
-=cut
-
-=pod
-
-=head1 ON-OFF tests
-
-The above =pod is OK. The following =cut is ok, the one after not.
-
-=cut
-
-# some comment or code here, not POD
-
-=cut
-
-# more code
-
-=head2 This opens POD
-
-=pod
-
-And the =pod above is too much.
-
-=cut
-
+BEGIN {\r
+   use File::Basename;\r
+   my $THISDIR = dirname $0;\r
+   unshift @INC, $THISDIR;\r
+   require "testpchk.pl";\r
+   import TestPodChecker;\r
+}\r
+\r
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash\r
+my $passed  = testpodchecker \%options, $0;\r
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};\r
+\r
+### Deliberately throw in some blank but non-empty lines\r
+                                        \r
+### The above line should contain spaces\r
+\r
+\r
+__END__\r
+\r
+=head2 This should cause a warning\r
+\r
+=head1 NAME\r
+\r
+poderrors.t - test Pod::Checker on some pod syntax errors\r
+\r
+=unknown1 this is an unknown command with two N<unknownA>\r
+and D<unknownB> interior sequences.\r
+\r
+This is some paragraph text with some unknown interior sequences,\r
+such as Q<unknown2>,\r
+A<unknown3>,\r
+and Y<unknown4 V<unknown5>>.\r
+\r
+Now try some unterminated sequences like\r
+I<hello mudda!\r
+B<hello fadda!\r
+\r
+Here I am at C<camp granada!\r
+\r
+Camps is very,\r
+entertaining.\r
+And they say we'll have some fun if it stops raining!\r
+\r
+Okay, now use a non-empty blank line to terminate a paragraph and make\r
+sure we get a warning.\r
+                                               \r
+The above blank line contains tabs and spaces only\r
+\r
+=head1 Additional tests\r
+\r
+=head2 item without over\r
+\r
+=item oops\r
+\r
+=head2 back without over\r
+\r
+=back\r
+\r
+=head2 over without back\r
+\r
+=over 4\r
+\r
+=item aaps\r
+\r
+=head2 end without begin\r
+\r
+=end\r
+\r
+=head2 begin and begin\r
+\r
+=begin html\r
+\r
+=begin text\r
+\r
+=end\r
+\r
+=end\r
+\r
+second one results in end w/o begin\r
+\r
+=head2 begin w/o formatter\r
+\r
+=begin\r
+\r
+=end\r
+\r
+=head2 for w/o formatter\r
+\r
+=for\r
+\r
+something...\r
+\r
+=head2 Nested sequences of the same type\r
+\r
+C<code I<italic C<code again!>>>\r
+\r
+=head2 Garbled entities\r
+\r
+E<alea iacta est>\r
+E<C<auml>>\r
+E<abcI<bla>>\r
+E<0x100>\r
+E<07777>\r
+E<300>\r
+\r
+=head2 Unresolved internal links\r
+\r
+L</"begin or begin">\r
+L<"end with begin">\r
+L</OoPs>\r
+\r
+=head2 Some links with problems\r
+\r
+L<abc\r
+def>\r
+L<>\r
+L<   aha>\r
+L<oho   >\r
+L<"Warnings"> this one is ok\r
+L</unescaped> ok too, this POD has an X of the same name\r
+L<http://www.perl.org> this is OK\r
+L<The Perl Home Page|http://www.perl.org> this is also OK\r
+\r
+=head2 Warnings\r
+\r
+L<passwd(5)>\r
+L<some text with / in it|perlvar/$|> should give warnings as hell\r
+\r
+=over 4\r
+\r
+=item bla\r
+\r
+=back 200\r
+\r
+the 200 is evil\r
+\r
+=begin html\r
+\r
+What?\r
+\r
+=end xml\r
+\r
+X<unescaped>see these unescaped < and > in the text?\r
+\r
+=head2 Misc\r
+\r
+Z<ddd> should be empty\r
+\r
+X<> should not be empty\r
+\r
+=over four\r
+\r
+This paragrapgh is misplaced - it ought to be an item.\r
+\r
+=item four should be numeric!\r
+\r
+=item\r
+\r
+=item blah\r
+\r
+=item previous is all empty!!!\r
+\r
+=back\r
+\r
+All empty over/back:\r
+\r
+=over 4\r
+\r
+=back\r
+\r
+item w/o name\r
+\r
+=cut\r
+\r
+=pod bla\r
+\r
+bla is evil\r
+\r
+=cut blub\r
+\r
+blub is evil\r
+\r
+=head2 reoccurence\r
+\r
+=over 4\r
+\r
+=item Misc\r
+\r
+we already have a head Misc\r
+\r
+=back\r
+\r
+=head2 some heading\r
+\r
+=head2 another one\r
+\r
+=head2 the next line should be empty\r
+=head2 ... but there is a command instead\r
+\r
+And here is some text\r
+=head2 again followed by a command\r
+\r
+  verbatim\r
+=item line missing\r
+\r
+previous section is empty!\r
+\r
+=head1 LINK TESTS\r
+\r
+Due to bug reported by Rafael Garcia-Suarez "rgarciasuarez@free.fr":\r
+\r
+The following hyperlinks :\r
+L<"I/O Operators">\r
+L<perlop/"I/O Operators">\r
+trigger a podchecker warning (using bleadperl) :\r
+    node 'I/O Operators' contains non-escaped | or /\r
+\r
+=cut\r
+\r
+=pod\r
+\r
+=head1 ON-OFF tests\r
+\r
+The above =pod is OK. The following =cut is ok, the one after not.\r
+\r
+=cut\r
+\r
+# some comment or code here, not POD\r
+\r
+=cut\r
+\r
+# more code\r
+\r
+=head2 This opens POD\r
+\r
+=pod\r
+\r
+And the =pod above is too much.\r
+\r
+=cut\r
+\r
similarity index 98%
rename from cpan/Pod-Parser/t/pod/poderrs.xr
rename to cpan/Pod-Checker/t/pod/poderrs.xr
index 8c16609..c1a80c6 100644 (file)
@@ -1,53 +1,53 @@
-*** WARNING: =head2 without preceding higher level at line 20 in file t/pod/poderrs.t
-*** WARNING: empty section in previous paragraph at line 22 in file t/pod/poderrs.t
-*** ERROR: Unknown command 'unknown1' at line 26 in file t/pod/poderrs.t
-*** ERROR: Unknown interior-sequence 'Q' at line 30 in file t/pod/poderrs.t
-*** ERROR: Unknown interior-sequence 'A' at line 31 in file t/pod/poderrs.t
-*** ERROR: Unknown interior-sequence 'Y' at line 32 in file t/pod/poderrs.t
-*** ERROR: Unknown interior-sequence 'V' at line 32 in file t/pod/poderrs.t
-*** ERROR: unterminated B<...> at line 36 in file t/pod/poderrs.t
-*** ERROR: unterminated I<...> at line 35 in file t/pod/poderrs.t
-*** ERROR: unterminated C<...> at line 38 in file t/pod/poderrs.t
-*** WARNING: line containing nothing but whitespace in paragraph at line 46 in file t/pod/poderrs.t
-*** ERROR: =item without previous =over at line 53 in file t/pod/poderrs.t
-*** ERROR: =back without previous =over at line 57 in file t/pod/poderrs.t
-*** ERROR: =over on line 61 without closing =back (at head2) at line 65 in file t/pod/poderrs.t
-*** ERROR: =end without =begin at line 67 in file t/pod/poderrs.t
-*** ERROR: Nested =begin's (first at line 71:html) at line 73 in file t/pod/poderrs.t
-*** ERROR: =end without =begin at line 77 in file t/pod/poderrs.t
-*** ERROR: No argument for =begin at line 83 in file t/pod/poderrs.t
-*** ERROR: =for without formatter specification at line 89 in file t/pod/poderrs.t
-*** WARNING: nested commands C<...C<...>...> at line 95 in file t/pod/poderrs.t
-*** ERROR: garbled entity E<alea iacta est> at line 99 in file t/pod/poderrs.t
-*** ERROR: garbled entity E<C<auml>> at line 100 in file t/pod/poderrs.t
-*** ERROR: garbled entity E<abcI<bla>> at line 101 in file t/pod/poderrs.t
-*** ERROR: Entity number out of range E<0x100> at line 102 in file t/pod/poderrs.t
-*** ERROR: Entity number out of range E<07777> at line 103 in file t/pod/poderrs.t
-*** ERROR: Entity number out of range E<300> at line 104 in file t/pod/poderrs.t
-*** ERROR: malformed link L<> : empty link at line 116 in file t/pod/poderrs.t
-*** WARNING: ignoring leading whitespace in link at line 117 in file t/pod/poderrs.t
-*** WARNING: ignoring trailing whitespace in link at line 118 in file t/pod/poderrs.t
-*** WARNING: (section) in 'passwd(5)' deprecated at line 126 in file t/pod/poderrs.t
-*** WARNING: node '$|' contains non-escaped | or / at line 127 in file t/pod/poderrs.t
-*** WARNING: alternative text '$|' contains non-escaped | or / at line 127 in file t/pod/poderrs.t
-*** ERROR: Spurious character(s) after =back at line 133 in file t/pod/poderrs.t
-*** ERROR: Nonempty Z<> at line 147 in file t/pod/poderrs.t
-*** ERROR: Empty X<> at line 149 in file t/pod/poderrs.t
-*** WARNING: preceding non-item paragraph(s) at line 155 in file t/pod/poderrs.t
-*** WARNING: No argument for =item at line 157 in file t/pod/poderrs.t
-*** WARNING: previous =item has no contents at line 159 in file t/pod/poderrs.t
-*** WARNING: No items in =over (at line 167) / =back list at line 169 in file t/pod/poderrs.t
-*** ERROR: Spurious text after =pod at line 175 in file t/pod/poderrs.t
-*** ERROR: Spurious text after =cut at line 179 in file t/pod/poderrs.t
-*** WARNING: empty section in previous paragraph at line 195 in file t/pod/poderrs.t
-*** ERROR: Apparent command =head2 not preceded by blank line at line 198 in file t/pod/poderrs.t
-*** WARNING: empty section in previous paragraph at line 197 in file t/pod/poderrs.t
-*** ERROR: Apparent command =head2 not preceded by blank line at line 201 in file t/pod/poderrs.t
-*** ERROR: Apparent command =item not preceded by blank line at line 204 in file t/pod/poderrs.t
-*** ERROR: Spurious =cut command at line 230 in file t/pod/poderrs.t
-*** ERROR: Spurious =pod command at line 236 in file t/pod/poderrs.t
-*** ERROR: unresolved internal link 'begin or begin' at line 108 in file t/pod/poderrs.t
-*** ERROR: unresolved internal link 'end with begin' at line 109 in file t/pod/poderrs.t
-*** ERROR: unresolved internal link 'OoPs' at line 110 in file t/pod/poderrs.t
-*** ERROR: unresolved internal link 'abc def' at line 114 in file t/pod/poderrs.t
-*** ERROR: unresolved internal link 'I/O Operators' at line 213 in file t/pod/poderrs.t
+*** WARNING: =head2 without preceding higher level at line 20 in file t/pod/poderrs.t\r
+*** WARNING: empty section in previous paragraph at line 22 in file t/pod/poderrs.t\r
+*** ERROR: Unknown command 'unknown1' at line 26 in file t/pod/poderrs.t\r
+*** ERROR: Unknown interior-sequence 'Q' at line 30 in file t/pod/poderrs.t\r
+*** ERROR: Unknown interior-sequence 'A' at line 31 in file t/pod/poderrs.t\r
+*** ERROR: Unknown interior-sequence 'Y' at line 32 in file t/pod/poderrs.t\r
+*** ERROR: Unknown interior-sequence 'V' at line 32 in file t/pod/poderrs.t\r
+*** ERROR: unterminated B<...> at line 36 in file t/pod/poderrs.t\r
+*** ERROR: unterminated I<...> at line 35 in file t/pod/poderrs.t\r
+*** ERROR: unterminated C<...> at line 38 in file t/pod/poderrs.t\r
+*** WARNING: line containing nothing but whitespace in paragraph at line 46 in file t/pod/poderrs.t\r
+*** ERROR: =item without previous =over at line 53 in file t/pod/poderrs.t\r
+*** ERROR: =back without previous =over at line 57 in file t/pod/poderrs.t\r
+*** ERROR: =over on line 61 without closing =back (at head2) at line 65 in file t/pod/poderrs.t\r
+*** ERROR: =end without =begin at line 67 in file t/pod/poderrs.t\r
+*** ERROR: Nested =begin's (first at line 71:html) at line 73 in file t/pod/poderrs.t\r
+*** ERROR: =end without =begin at line 77 in file t/pod/poderrs.t\r
+*** ERROR: No argument for =begin at line 83 in file t/pod/poderrs.t\r
+*** ERROR: =for without formatter specification at line 89 in file t/pod/poderrs.t\r
+*** WARNING: nested commands C<...C<...>...> at line 95 in file t/pod/poderrs.t\r
+*** ERROR: garbled entity E<alea iacta est> at line 99 in file t/pod/poderrs.t\r
+*** ERROR: garbled entity E<C<auml>> at line 100 in file t/pod/poderrs.t\r
+*** ERROR: garbled entity E<abcI<bla>> at line 101 in file t/pod/poderrs.t\r
+*** ERROR: Entity number out of range E<0x100> at line 102 in file t/pod/poderrs.t\r
+*** ERROR: Entity number out of range E<07777> at line 103 in file t/pod/poderrs.t\r
+*** ERROR: Entity number out of range E<300> at line 104 in file t/pod/poderrs.t\r
+*** ERROR: malformed link L<> : empty link at line 116 in file t/pod/poderrs.t\r
+*** WARNING: ignoring leading whitespace in link at line 117 in file t/pod/poderrs.t\r
+*** WARNING: ignoring trailing whitespace in link at line 118 in file t/pod/poderrs.t\r
+*** WARNING: (section) in 'passwd(5)' deprecated at line 126 in file t/pod/poderrs.t\r
+*** WARNING: node '$|' contains non-escaped | or / at line 127 in file t/pod/poderrs.t\r
+*** WARNING: alternative text '$|' contains non-escaped | or / at line 127 in file t/pod/poderrs.t\r
+*** ERROR: Spurious character(s) after =back at line 133 in file t/pod/poderrs.t\r
+*** ERROR: Nonempty Z<> at line 147 in file t/pod/poderrs.t\r
+*** ERROR: Empty X<> at line 149 in file t/pod/poderrs.t\r
+*** WARNING: preceding non-item paragraph(s) at line 155 in file t/pod/poderrs.t\r
+*** WARNING: No argument for =item at line 157 in file t/pod/poderrs.t\r
+*** WARNING: previous =item has no contents at line 159 in file t/pod/poderrs.t\r
+*** WARNING: No items in =over (at line 167) / =back list at line 169 in file t/pod/poderrs.t\r
+*** ERROR: Spurious text after =pod at line 175 in file t/pod/poderrs.t\r
+*** ERROR: Spurious text after =cut at line 179 in file t/pod/poderrs.t\r
+*** WARNING: empty section in previous paragraph at line 195 in file t/pod/poderrs.t\r
+*** ERROR: Apparent command =head2 not preceded by blank line at line 198 in file t/pod/poderrs.t\r
+*** WARNING: empty section in previous paragraph at line 197 in file t/pod/poderrs.t\r
+*** ERROR: Apparent command =head2 not preceded by blank line at line 201 in file t/pod/poderrs.t\r
+*** ERROR: Apparent command =item not preceded by blank line at line 204 in file t/pod/poderrs.t\r
+*** ERROR: Spurious =cut command at line 230 in file t/pod/poderrs.t\r
+*** ERROR: Spurious =pod command at line 236 in file t/pod/poderrs.t\r
+*** ERROR: unresolved internal link 'begin or begin' at line 108 in file t/pod/poderrs.t\r
+*** ERROR: unresolved internal link 'end with begin' at line 109 in file t/pod/poderrs.t\r
+*** ERROR: unresolved internal link 'OoPs' at line 110 in file t/pod/poderrs.t\r
+*** ERROR: unresolved internal link 'abc def' at line 114 in file t/pod/poderrs.t\r
+*** ERROR: unresolved internal link 'I/O Operators' at line 213 in file t/pod/poderrs.t\r
diff --git a/cpan/Pod-Checker/t/pod/selfcheck.t b/cpan/Pod-Checker/t/pod/selfcheck.t
new file mode 100644 (file)
index 0000000..3b6e352
--- /dev/null
@@ -0,0 +1,45 @@
+#!/usr/bin/perl\r
+use File::Basename;\r
+use File::Spec;\r
+use strict;\r
+my $THISDIR;\r
+BEGIN {\r
+   $THISDIR = dirname $0;\r
+   unshift @INC, $THISDIR;\r
+   require "testpchk.pl";\r
+   import TestPodChecker qw(testpodcheck);\r
+}\r
+\r
+# test that our POD is correct!\r
+my $path = File::Spec->catfile($THISDIR,(File::Spec->updir()) x 2, 'lib', 'Pod', '*.pm');\r
+print "THISDIR=$THISDIR PATH=$path\n";\r
+my @pods = glob($path);\r
+print "PODS=@pods\n";\r
+\r
+print "1..",scalar(@pods),"\n";\r
+\r
+my $errs = 0;\r
+my $testnum = 1;\r
+foreach my $pod (@pods) {\r
+  my $out = File::Spec->catfile($THISDIR, basename($pod));\r
+  $out =~ s{\.pm}{.OUT};\r
+  my %options = ( -Out => $out );\r
+  my $failmsg = testpodcheck(-In => $pod, -Out => $out, -Cmp => "$THISDIR/empty.xr");\r
+  if($failmsg) {\r
+    if(open(IN, "<$out")) {\r
+      while(<IN>) {\r
+        warn "podchecker: $_";\r
+      }\r
+      close(IN);\r
+    } else {\r
+      warn "Error: Cannot read output file $out: $!\n";\r
+    }\r
+    print "not ok $testnum\n";\r
+    $errs++;\r
+  } else {\r
+    print "ok $testnum\n";\r
+  }\r
+  $testnum++;\r
+}\r
+exit( ($errs == 0) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};\r
+\r
diff --git a/cpan/Pod-Checker/t/pod/testcmp.pl b/cpan/Pod-Checker/t/pod/testcmp.pl
new file mode 100644 (file)
index 0000000..b8592fc
--- /dev/null
@@ -0,0 +1,94 @@
+package TestCompare;\r
+\r
+use vars qw(@ISA @EXPORT $MYPKG);\r
+#use strict;\r
+#use diagnostics;\r
+use Carp;\r
+use Exporter;\r
+use File::Basename;\r
+use File::Spec;\r
+use FileHandle;\r
+\r
+@ISA = qw(Exporter);\r
+@EXPORT = qw(&testcmp);\r
+$MYPKG = eval { (caller)[0] };\r
+\r
+##--------------------------------------------------------------------------\r
+\r
+=head1 NAME\r
+\r
+testcmp -- compare two files line-by-line\r
+\r
+=head1 SYNOPSIS\r
+\r
+    $is_diff = testcmp($file1, $file2);\r
+\r
+or\r
+\r
+    $is_diff = testcmp({-cmplines => \&mycmp}, $file1, $file2);\r
+\r
+=head2 DESCRIPTION\r
+\r
+Compare two text files line-by-line and return 0 if they are the\r
+same, 1 if they differ. Each of $file1 and $file2 may be a filenames,\r
+or a filehandles (in which case it must already be open for reading).\r
+\r
+If the first argument is a hashref, then the B<-cmplines> key in the\r
+hash may have a subroutine reference as its corresponding value.\r
+The referenced user-defined subroutine should be a line-comparator\r
+function that takes two pre-chomped text-lines as its arguments\r
+(the first is from $file1 and the second is from $file2). It should\r
+return 0 if it considers the two lines equivalent, and non-zero\r
+otherwise.\r
+\r
+=cut\r
+\r
+##--------------------------------------------------------------------------\r
+\r
+sub testcmp( $ $ ; $) {\r
+   my %opts = ref($_[0]) eq 'HASH' ? %{shift()} : ();\r
+   my ($file1, $file2) = @_;\r
+   my ($fh1, $fh2) = ($file1, $file2);\r
+   unless (ref $fh1) {\r
+      $fh1 = FileHandle->new($file1, "r") or die "Can't open $file1: $!";\r
+   }\r
+   unless (ref $fh2) {\r
+      $fh2 = FileHandle->new($file2, "r") or die "Can't open $file2: $!";\r
+   }\r
+  \r
+   my $cmplines = $opts{'-cmplines'} || undef;\r
+   my ($f1text, $f2text) = ("", "");\r
+   my ($line, $diffs)    = (0, 0);\r
+  \r
+   while ( defined($f1text) and defined($f2text) ) {\r
+      defined($f1text = <$fh1>)  and  chomp($f1text);\r
+      defined($f2text = <$fh2>)  and  chomp($f2text);\r
+      ++$line;\r
+      last unless ( defined($f1text) and defined($f2text) );\r
+      # kill any extra line endings\r
+      $f1text =~ s/[\r\n]+$//s;\r
+      $f2text =~ s/[\r\n]+$//s;\r
+      $diffs = (ref $cmplines) ? &$cmplines($f1text, $f2text)\r
+                               : ($f1text ne $f2text);\r
+      last if $diffs;\r
+   }\r
+   close($fh1) unless (ref $file1);\r
+   close($fh2) unless (ref $file2);\r
+  \r
+   $diffs = 1  if (defined($f1text) or defined($f2text));\r
+   if ( defined($f1text) and defined($f2text) ) {\r
+      ## these two lines must be different\r
+      warn "$file1 and $file2 differ at line $line\n";\r
+   }\r
+   elsif (defined($f1text)  and  (! defined($f1text))) {\r
+      ## file1 must be shorter\r
+      warn "$file1 is shorter than $file2\n";\r
+   }\r
+   elsif (defined $f2text) {\r
+      ## file2 must be longer\r
+      warn "$file1 is shorter than $file2\n";\r
+   }\r
+   return $diffs;\r
+}\r
+\r
+1;\r
diff --git a/cpan/Pod-Checker/t/pod/testpchk.pl b/cpan/Pod-Checker/t/pod/testpchk.pl
new file mode 100644 (file)
index 0000000..0464a9a
--- /dev/null
@@ -0,0 +1,130 @@
+package TestPodChecker;\r
+\r
+BEGIN {\r
+   use File::Basename;\r
+   use File::Spec;\r
+   push @INC, '..';\r
+   my $THISDIR = dirname $0;\r
+   unshift @INC, $THISDIR;\r
+   require "testcmp.pl";\r
+   import TestCompare;\r
+   my $PARENTDIR = dirname $THISDIR;\r
+   push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR);\r
+   require VMS::Filespec if $^O eq 'VMS';\r
+}\r
+\r
+use Pod::Checker;\r
+use vars qw(@ISA @EXPORT $MYPKG);\r
+#use strict;\r
+#use diagnostics;\r
+use Carp;\r
+use Exporter;\r
+#use File::Compare;\r
+\r
+@ISA = qw(Exporter);\r
+@EXPORT = qw(&testpodchecker);\r
+@EXPORT_OK = qw(&testpodcheck);\r
+$MYPKG = eval { (caller)[0] };\r
+\r
+sub stripname( $ ) {\r
+   local $_ = shift;\r
+   return /(\w[.\w]*)\s*$/ ? $1 : $_;\r
+}\r
+\r
+sub msgcmp( $ $ ) {\r
+   ## filter out platform-dependent aspects of error messages\r
+   my ($line1, $line2) = @_;\r
+   for ($line1, $line2) {\r
+      ## remove filenames from error messages to avoid any\r
+      ## filepath naming differences between OS platforms\r
+      s/(at line \S+ in file) .*\W(\w+\.[tT])\s*$/$1 \L$2\E/;\r
+      s/.*\W(\w+\.[tT]) (has \d+ pod syntax error)/\L$1\E $2/;\r
+   }\r
+   return ($line1 ne $line2);\r
+}\r
+\r
+sub testpodcheck( @ ) {\r
+   my %args = @_;\r
+   my $infile  = $args{'-In'}  || croak "No input file given!";\r
+   my $outfile = $args{'-Out'} || croak "No output file given!";\r
+   my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!";\r
+\r
+   my $different = '';\r
+   my $testname = basename $infile, '.t', '.xr';\r
+\r
+   unless (-e $cmpfile) {\r
+      my $msg = "*** Can't find comparison file $cmpfile for testing $infile";\r
+      warn  "$msg\n";\r
+      return  $msg;\r
+   }\r
+\r
+   print "# Running podchecker for '$testname'...\n";\r
+   ## Compare the output against the expected result\r
+   if ($^O eq 'VMS') {\r
+      for ($infile, $outfile, $cmpfile) {\r
+         $_ = VMS::Filespec::unixify($_)  unless  ref;\r
+      }\r
+   }\r
+   podchecker($infile, $outfile);\r
+   if ( testcmp({'-cmplines' => \&msgcmp}, $outfile, $cmpfile) ) {\r
+       $different = "$outfile is different from $cmpfile";\r
+   }\r
+   else {\r
+       unlink($outfile);\r
+   }\r
+   return  $different;\r
+}\r
+\r
+sub testpodchecker( @ ) {\r
+   my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : ();\r
+   my @testpods = @_;\r
+   my ($testname, $testdir) = ("", "");\r
+   my ($podfile, $cmpfile) = ("", "");\r
+   my ($outfile, $errfile) = ("", "");\r
+   my $passes = 0;\r
+   my $failed = 0;\r
+   local $_;\r
+\r
+   print "1..", scalar @testpods, "\n"  unless ($opts{'-xrgen'});\r
+\r
+   for $podfile (@testpods) {\r
+      ($testname, $_) = fileparse($podfile);\r
+      $testdir ||=  $_;\r
+      $testname  =~ s/\.t$//;\r
+      $cmpfile   =  $testdir . $testname . '.xr';\r
+      $outfile   =  $testdir . $testname . '.OUT';\r
+\r
+      if ($opts{'-xrgen'}) {\r
+          if ($opts{'-force'} or ! -e $cmpfile) {\r
+             ## Create the comparison file\r
+             print "# Creating expected result for \"$testname\"" .\r
+                   " podchecker test ...\n";\r
+             podchecker($podfile, $cmpfile);\r
+          }\r
+          else {\r
+             print "# File $cmpfile already exists" .\r
+                   " (use '-force' to regenerate it).\n";\r
+          }\r
+          next;\r
+      }\r
+\r
+      my $failmsg = testpodcheck\r
+                        -In  => $podfile,\r
+                        -Out => $outfile,\r
+                        -Cmp => $cmpfile;\r
+      if ($failmsg) {\r
+          ++$failed;\r
+          print "#\tFAILED. ($failmsg)\n";\r
+         print "not ok ", $failed+$passes, "\n";\r
+      }\r
+      else {\r
+          ++$passes;\r
+          unlink($outfile);\r
+          print "#\tPASSED.\n";\r
+         print "ok ", $failed+$passes, "\n";\r
+      }\r
+   }\r
+   return  $passes;\r
+}\r
+\r
+1;\r
index 94e3999..d3b4510 100644 (file)
@@ -1,3 +1 @@
-/pod2usage*
-/podchecker*
 /podselect*
index 028a405..884062f 100644 (file)
-#############################################################################  
-# 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.51';   ## 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 qw(abs_path 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 {
-            my %seen;
-            my $curdir = File::Spec->curdir;
-           foreach(@INC) {
-                next if $_ eq $curdir;
-               my $path = abs_path($_);
-                push(@search, $path) unless $seen{$path}++;
-            }
-        }
-
-        $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
-        if ($^O eq 'VMS') {
-            $try = VMS::Filespec::unixify($try);
-        }
-        else {
-            $try = File::Spec->canonpath($try);
-        }
-        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/!;
-        $root_rx=~ s|//$|/|;  # remove trailing double slash
-        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//is;
-        $name =~ s/$SIMPLIFY_RX//is 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);
-      $fullname = VMS::Filespec::unixify($fullname) if $^O eq 'VMS';
-      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>.
-
-B<Pod::Find> is part of the L<Pod::Parser> distribution.
-
-=head1 SEE ALSO
-
-L<Pod::Parser>, L<Pod::Checker>, L<perldoc>
-
-=cut
-
-1;
-
+#############################################################################  \r
+# Pod/Find.pm -- finds files containing POD documentation\r
+#\r
+# Author: Marek Rouchal <marekr@cpan.org>\r
+# \r
+# Copyright (C) 1999-2000 by Marek Rouchal (and borrowing code\r
+# from Nick Ing-Simmon's PodToHtml). All rights reserved.\r
+# This file is part of "PodParser". Pod::Find is free software;\r
+# you can redistribute it and/or modify it under the same terms\r
+# as Perl itself.\r
+#############################################################################\r
+\r
+package Pod::Find;\r
+use strict;\r
+\r
+use vars qw($VERSION);\r
+$VERSION = '1.60';   ## Current version of this package\r
+require  5.005;   ## requires this Perl version or later\r
+use Carp;\r
+\r
+BEGIN {\r
+   if ($] < 5.006) {\r
+      require Symbol;\r
+      import Symbol;\r
+   }\r
+}\r
+\r
+#############################################################################\r
+\r
+=head1 NAME\r
+\r
+Pod::Find - find POD documents in directory trees\r
+\r
+=head1 SYNOPSIS\r
+\r
+  use Pod::Find qw(pod_find simplify_name);\r
+  my %pods = pod_find({ -verbose => 1, -inc => 1 });\r
+  foreach(keys %pods) {\r
+     print "found library POD `$pods{$_}' in $_\n";\r
+  }\r
+\r
+  print "podname=",simplify_name('a/b/c/mymodule.pod'),"\n";\r
+\r
+  $location = pod_where( { -inc => 1 }, "Pod::Find" );\r
+\r
+=head1 DESCRIPTION\r
+\r
+B<Pod::Find> provides a set of functions to locate POD files.  Note that\r
+no function is exported by default to avoid pollution of your namespace,\r
+so be sure to specify them in the B<use> statement if you need them:\r
+\r
+  use Pod::Find qw(pod_find);\r
+\r
+From this version on the typical SCM (software configuration management)\r
+files/directories like RCS, CVS, SCCS, .svn are ignored.\r
+\r
+=cut\r
+\r
+#use diagnostics;\r
+use Exporter;\r
+use File::Spec;\r
+use File::Find;\r
+use Cwd qw(abs_path cwd);\r
+\r
+use vars qw(@ISA @EXPORT_OK $VERSION);\r
+@ISA = qw(Exporter);\r
+@EXPORT_OK = qw(&pod_find &simplify_name &pod_where &contains_pod);\r
+\r
+# package global variables\r
+my $SIMPLIFY_RX;\r
+\r
+=head2 C<pod_find( { %opts } , @directories )>\r
+\r
+The function B<pod_find> searches for POD documents in a given set of\r
+files and/or directories. It returns a hash with the file names as keys\r
+and the POD name as value. The POD name is derived from the file name\r
+and its position in the directory tree.\r
+\r
+E.g. when searching in F<$HOME/perl5lib>, the file\r
+F<$HOME/perl5lib/MyModule.pm> would get the POD name I<MyModule>,\r
+whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be\r
+I<Myclass::Subclass>. The name information can be used for POD\r
+translators.\r
+\r
+Only text files containing at least one valid POD command are found.\r
+\r
+A warning is printed if more than one POD file with the same POD name\r
+is found, e.g. F<CPAN.pm> in different directories. This usually\r
+indicates duplicate occurrences of modules in the I<@INC> search path.\r
+\r
+B<OPTIONS> The first argument for B<pod_find> may be a hash reference\r
+with options. The rest are either directories that are searched\r
+recursively or files.  The POD names of files are the plain basenames\r
+with any Perl-like extension (.pm, .pl, .pod) stripped.\r
+\r
+=over 4\r
+\r
+=item C<-verbose =E<gt> 1>\r
+\r
+Print progress information while scanning.\r
+\r
+=item C<-perl =E<gt> 1>\r
+\r
+Apply Perl-specific heuristics to find the correct PODs. This includes\r
+stripping Perl-like extensions, omitting subdirectories that are numeric\r
+but do I<not> match the current Perl interpreter's version id, suppressing\r
+F<site_perl> as a module hierarchy name etc.\r
+\r
+=item C<-script =E<gt> 1>\r
+\r
+Search for PODs in the current Perl interpreter's installation \r
+B<scriptdir>. This is taken from the local L<Config|Config> module.\r
+\r
+=item C<-inc =E<gt> 1>\r
+\r
+Search for PODs in the current Perl interpreter's I<@INC> paths. This\r
+automatically considers paths specified in the C<PERL5LIB> environment\r
+as this is included in I<@INC> by the Perl interpreter itself.\r
+\r
+=back\r
+\r
+=cut\r
+\r
+# return a hash of the POD files found\r
+# first argument may be a hashref (options),\r
+# rest is a list of directories to search recursively\r
+sub pod_find\r
+{\r
+    my %opts;\r
+    if(ref $_[0]) {\r
+        %opts = %{shift()};\r
+    }\r
+\r
+    $opts{-verbose} ||= 0;\r
+    $opts{-perl}    ||= 0;\r
+\r
+    my (@search) = @_;\r
+\r
+    if($opts{-script}) {\r
+        require Config;\r
+        push(@search, $Config::Config{scriptdir})\r
+            if -d $Config::Config{scriptdir};\r
+        $opts{-perl} = 1;\r
+    }\r
+\r
+    if($opts{-inc}) {\r
+        if ($^O eq 'MacOS') {\r
+            # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS\r
+            my @new_INC = @INC;\r
+            for (@new_INC) {\r
+                if ( $_ eq '.' ) {\r
+                    $_ = ':';\r
+                } elsif ( $_ =~ s{^((?:\.\./)+)}{':' x (length($1)/3)}e ) {\r
+                    $_ = ':'. $_;\r
+                } else {\r
+                    $_ =~ s{^\./}{:};\r
+                }\r
+            }\r
+            push(@search, grep($_ ne File::Spec->curdir, @new_INC));\r
+        } else {\r
+            my %seen;\r
+            my $curdir = File::Spec->curdir;\r
+           foreach(@INC) {\r
+                next if $_ eq $curdir;\r
+               my $path = abs_path($_);\r
+                push(@search, $path) unless $seen{$path}++;\r
+            }\r
+        }\r
+\r
+        $opts{-perl} = 1;\r
+    }\r
+\r
+    if($opts{-perl}) {\r
+        require Config;\r
+        # this code simplifies the POD name for Perl modules:\r
+        # * remove "site_perl"\r
+        # * remove e.g. "i586-linux" (from 'archname')\r
+        # * remove e.g. 5.00503\r
+        # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod)\r
+\r
+        # Mac OS:\r
+        # * remove ":?site_perl:"\r
+        # * remove :?pod: if followed by *.pod (e.g. in :pod:perlfunc.pod)\r
+\r
+        if ($^O eq 'MacOS') {\r
+            $SIMPLIFY_RX =\r
+              qq!^(?i:\:?site_perl\:|\:?pod\:(?=.*?\\.pod\\z))*!;\r
+        } else {\r
+            $SIMPLIFY_RX =\r
+              qq!^(?i:site(_perl)?/|\Q$Config::Config{archname}\E/|\\d+\\.\\d+([_.]?\\d+)?/|pod/(?=.*?\\.pod\\z))*!;\r
+        }\r
+    }\r
+\r
+    my %dirs_visited;\r
+    my %pods;\r
+    my %names;\r
+    my $pwd = cwd();\r
+\r
+    foreach my $try (@search) {\r
+        unless(File::Spec->file_name_is_absolute($try)) {\r
+            # make path absolute\r
+            $try = File::Spec->catfile($pwd,$try);\r
+        }\r
+        # simplify path\r
+        # on VMS canonpath will vmsify:[the.path], but File::Find::find\r
+        # wants /unixy/paths\r
+        if ($^O eq 'VMS') {\r
+            $try = VMS::Filespec::unixify($try);\r
+        }\r
+        else {\r
+            $try = File::Spec->canonpath($try);\r
+        }\r
+        my $name;\r
+        if(-f $try) {\r
+            if($name = _check_and_extract_name($try, $opts{-verbose})) {\r
+                _check_for_duplicates($try, $name, \%names, \%pods);\r
+            }\r
+            next;\r
+        }\r
+        my $root_rx = $^O eq 'MacOS' ? qq!^\Q$try\E! : qq!^\Q$try\E/!;\r
+        $root_rx=~ s|//$|/|;  # remove trailing double slash\r
+        File::Find::find( sub {\r
+            my $item = $File::Find::name;\r
+            if(-d) {\r
+                if($item =~ m{/(?:RCS|CVS|SCCS|\.svn)$}) {\r
+                    $File::Find::prune = 1;\r
+                    return;\r
+                }\r
+                elsif($dirs_visited{$item}) {\r
+                    warn "Directory '$item' already seen, skipping.\n"\r
+                        if($opts{-verbose});\r
+                    $File::Find::prune = 1;\r
+                    return;\r
+                }\r
+                else {\r
+                    $dirs_visited{$item} = 1;\r
+                }\r
+                if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) {\r
+                    $File::Find::prune = 1;\r
+                    warn "Perl $] version mismatch on $_, skipping.\n"\r
+                        if($opts{-verbose});\r
+                }\r
+                return;\r
+            }\r
+            if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) {\r
+                _check_for_duplicates($item, $name, \%names, \%pods);\r
+            }\r
+        }, $try); # end of File::Find::find\r
+    }\r
+    chdir $pwd;\r
+    return %pods;\r
+}\r
+\r
+sub _check_for_duplicates {\r
+    my ($file, $name, $names_ref, $pods_ref) = @_;\r
+    if($$names_ref{$name}) {\r
+        warn "Duplicate POD found (shadowing?): $name ($file)\n";\r
+        warn '    Already seen in ',\r
+            join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n";\r
+    }\r
+    else {\r
+        $$names_ref{$name} = 1;\r
+    }\r
+    return $$pods_ref{$file} = $name;\r
+}\r
+\r
+sub _check_and_extract_name {\r
+    my ($file, $verbose, $root_rx) = @_;\r
+\r
+    # check extension or executable flag\r
+    # this involves testing the .bat extension on Win32!\r
+    unless(-f $file && -T $file && ($file =~ /\.(pod|pm|plx?)\z/i || -x $file )) {\r
+      return;\r
+    }\r
+\r
+    return unless contains_pod($file,$verbose);\r
+\r
+    # strip non-significant path components\r
+    # TODO what happens on e.g. Win32?\r
+    my $name = $file;\r
+    if(defined $root_rx) {\r
+        $name =~ s/$root_rx//is;\r
+        $name =~ s/$SIMPLIFY_RX//is if(defined $SIMPLIFY_RX);\r
+    }\r
+    else {\r
+        if ($^O eq 'MacOS') {\r
+            $name =~ s/^.*://s;\r
+        } else {\r
+            $name =~ s{^.*/}{}s;\r
+        }\r
+    }\r
+    _simplify($name);\r
+    $name =~ s{/+}{::}g;\r
+    if ($^O eq 'MacOS') {\r
+        $name =~ s{:+}{::}g; # : -> ::\r
+    } else {\r
+        $name =~ s{/+}{::}g; # / -> ::\r
+    }\r
+    return $name;\r
+}\r
+\r
+=head2 C<simplify_name( $str )>\r
+\r
+The function B<simplify_name> is equivalent to B<basename>, but also\r
+strips Perl-like extensions (.pm, .pl, .pod) and extensions like\r
+F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively.\r
+\r
+=cut\r
+\r
+# basic simplification of the POD name:\r
+# basename & strip extension\r
+sub simplify_name {\r
+    my ($str) = @_;\r
+    # remove all path components\r
+    if ($^O eq 'MacOS') {\r
+        $str =~ s/^.*://s;\r
+    } else {\r
+        $str =~ s{^.*/}{}s;\r
+    }\r
+    _simplify($str);\r
+    return $str;\r
+}\r
+\r
+# internal sub only\r
+sub _simplify {\r
+    # strip Perl's own extensions\r
+    $_[0] =~ s/\.(pod|pm|plx?)\z//i;\r
+    # strip meaningless extensions on Win32 and OS/2\r
+    $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /mswin|os2/i);\r
+    # strip meaningless extensions on VMS\r
+    $_[0] =~ s/\.(com)\z//i if($^O eq 'VMS');\r
+}\r
+\r
+# contribution from Tim Jenness <t.jenness@jach.hawaii.edu>\r
+\r
+=head2 C<pod_where( { %opts }, $pod )>\r
+\r
+Returns the location of a pod document given a search directory\r
+and a module (e.g. C<File::Find>) or script (e.g. C<perldoc>) name.\r
+\r
+Options:\r
+\r
+=over 4\r
+\r
+=item C<-inc =E<gt> 1>\r
+\r
+Search @INC for the pod and also the C<scriptdir> defined in the\r
+L<Config|Config> module.\r
+\r
+=item C<-dirs =E<gt> [ $dir1, $dir2, ... ]>\r
+\r
+Reference to an array of search directories. These are searched in order\r
+before looking in C<@INC> (if B<-inc>). Current directory is used if\r
+none are specified.\r
+\r
+=item C<-verbose =E<gt> 1>\r
+\r
+List directories as they are searched\r
+\r
+=back\r
+\r
+Returns the full path of the first occurrence to the file.\r
+Package names (eg 'A::B') are automatically converted to directory\r
+names in the selected directory. (eg on unix 'A::B' is converted to\r
+'A/B'). Additionally, '.pm', '.pl' and '.pod' are appended to the\r
+search automatically if required.\r
+\r
+A subdirectory F<pod/> is also checked if it exists in any of the given\r
+search directories. This ensures that e.g. L<perlfunc|perlfunc> is\r
+found.\r
+\r
+It is assumed that if a module name is supplied, that that name\r
+matches the file name. Pods are not opened to check for the 'NAME'\r
+entry.\r
+\r
+A check is made to make sure that the file that is found does \r
+contain some pod documentation.\r
+\r
+=cut\r
+\r
+sub pod_where {\r
+\r
+  # default options\r
+  my %options = (\r
+         '-inc' => 0,\r
+         '-verbose' => 0,\r
+         '-dirs' => [ File::Spec->curdir ],\r
+        );\r
+\r
+  # Check for an options hash as first argument\r
+  if (defined $_[0] && ref($_[0]) eq 'HASH') {\r
+    my $opt = shift;\r
+\r
+    # Merge default options with supplied options\r
+    %options = (%options, %$opt);\r
+  }\r
+\r
+  # Check usage\r
+  carp 'Usage: pod_where({options}, $pod)' unless (scalar(@_));\r
+\r
+  # Read argument\r
+  my $pod = shift;\r
+\r
+  # Split on :: and then join the name together using File::Spec\r
+  my @parts = split (/::/, $pod);\r
+\r
+  # Get full directory list\r
+  my @search_dirs = @{ $options{'-dirs'} };\r
+\r
+  if ($options{'-inc'}) {\r
+\r
+    require Config;\r
+\r
+    # Add @INC\r
+    if ($^O eq 'MacOS' && $options{'-inc'}) {\r
+        # tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS\r
+        my @new_INC = @INC;\r
+        for (@new_INC) {\r
+            if ( $_ eq '.' ) {\r
+                $_ = ':';\r
+            } elsif ( $_ =~ s{^((?:\.\./)+)}{':' x (length($1)/3)}e ) {\r
+                $_ = ':'. $_;\r
+            } else {\r
+                $_ =~ s{^\./}{:};\r
+            }\r
+        }\r
+        push (@search_dirs, @new_INC);\r
+    } elsif ($options{'-inc'}) {\r
+        push (@search_dirs, @INC);\r
+    }\r
+\r
+    # Add location of pod documentation for perl man pages (eg perlfunc)\r
+    # This is a pod directory in the private install tree\r
+    #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'},\r
+    #                                  'pod');\r
+    #push (@search_dirs, $perlpoddir)\r
+    #  if -d $perlpoddir;\r
+\r
+    # Add location of binaries such as pod2text\r
+    push (@search_dirs, $Config::Config{'scriptdir'})\r
+      if -d $Config::Config{'scriptdir'};\r
+  }\r
+\r
+  warn 'Search path is: '.join(' ', @search_dirs)."\n"\r
+        if $options{'-verbose'};\r
+\r
+  # Loop over directories\r
+  Dir: foreach my $dir ( @search_dirs ) {\r
+\r
+    # Don't bother if can't find the directory\r
+    if (-d $dir) {\r
+      warn "Looking in directory $dir\n"\r
+        if $options{'-verbose'};\r
+\r
+      # Now concatenate this directory with the pod we are searching for\r
+      my $fullname = File::Spec->catfile($dir, @parts);\r
+      $fullname = VMS::Filespec::unixify($fullname) if $^O eq 'VMS';\r
+      warn "Filename is now $fullname\n"\r
+        if $options{'-verbose'};\r
+\r
+      # Loop over possible extensions\r
+      foreach my $ext ('', '.pod', '.pm', '.pl') {\r
+        my $fullext = $fullname . $ext;\r
+        if (-f $fullext &&\r
+         contains_pod($fullext, $options{'-verbose'}) ) {\r
+          warn "FOUND: $fullext\n" if $options{'-verbose'};\r
+          return $fullext;\r
+        }\r
+      }\r
+    } else {\r
+      warn "Directory $dir does not exist\n"\r
+        if $options{'-verbose'};\r
+      next Dir;\r
+    }\r
+    # for some strange reason the path on MacOS/darwin/cygwin is\r
+    # 'pods' not 'pod'\r
+    # this could be the case also for other systems that\r
+    # have a case-tolerant file system, but File::Spec\r
+    # does not recognize 'darwin' yet. And cygwin also has "pods",\r
+    # but is not case tolerant. Oh well...\r
+    if((File::Spec->case_tolerant || $^O =~ /macos|darwin|cygwin/i)\r
+     && -d File::Spec->catdir($dir,'pods')) {\r
+      $dir = File::Spec->catdir($dir,'pods');\r
+      redo Dir;\r
+    }\r
+    if(-d File::Spec->catdir($dir,'pod')) {\r
+      $dir = File::Spec->catdir($dir,'pod');\r
+      redo Dir;\r
+    }\r
+  }\r
+  # No match;\r
+  return;\r
+}\r
+\r
+=head2 C<contains_pod( $file , $verbose )>\r
+\r
+Returns true if the supplied filename (not POD module) contains some pod\r
+information.\r
+\r
+=cut\r
+\r
+sub contains_pod {\r
+  my $file = shift;\r
+  my $verbose = 0;\r
+  $verbose = shift if @_;\r
+\r
+  # check for one line of POD\r
+  my $podfh;\r
+  if ($] < 5.006) {\r
+    $podfh = gensym();\r
+  }\r
+\r
+  unless(open($podfh,"<$file")) {\r
+    warn "Error: $file is unreadable: $!\n";\r
+    return;\r
+  }\r
+  \r
+  local $/ = undef;\r
+  my $pod = <$podfh>;\r
+  close($podfh) || die "Error closing $file: $!\n";\r
+  unless($pod =~ /^=(head\d|pod|over|item|cut)\b/m) {\r
+    warn "No POD in $file, skipping.\n"\r
+      if($verbose);\r
+    return 0;\r
+  }\r
+\r
+  return 1;\r
+}\r
+\r
+=head1 AUTHOR\r
+\r
+Please report bugs using L<http://rt.cpan.org>.\r
+\r
+Marek Rouchal E<lt>marekr@cpan.orgE<gt>,\r
+heavily borrowing code from Nick Ing-Simmons' PodToHtml.\r
+\r
+Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt> provided\r
+C<pod_where> and C<contains_pod>.\r
+\r
+B<Pod::Find> is part of the L<Pod::Parser> distribution.\r
+\r
+=head1 SEE ALSO\r
+\r
+L<Pod::Parser>, L<Pod::Checker>, L<perldoc>\r
+\r
+=cut\r
+\r
+1;\r
+\r
index 2ed71fa..c19d4c5 100644 (file)
-#############################################################################
-# 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.51';  ## 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:
-
-=begin __PRIVATE__
-
-=over 4
-
-=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.
-
-=back
-
-=end __PRIVATE__
-
-=over 4
-
-=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
-
-B<Pod::InputObjects> is part of the L<Pod::Parser> distribution.
-
-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;
+#############################################################################\r
+# Pod/InputObjects.pm -- package which defines objects for input streams\r
+# and paragraphs and commands when parsing POD docs.\r
+#\r
+# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.\r
+# This file is part of "PodParser". PodParser is free software;\r
+# you can redistribute it and/or modify it under the same terms\r
+# as Perl itself.\r
+#############################################################################\r
+\r
+package Pod::InputObjects;\r
+use strict;\r
+\r
+use vars qw($VERSION);\r
+$VERSION = '1.60';  ## Current version of this package\r
+require  5.005;    ## requires this Perl version or later\r
+\r
+#############################################################################\r
+\r
+=head1 NAME\r
+\r
+Pod::InputObjects - objects representing POD input paragraphs, commands, etc.\r
+\r
+=head1 SYNOPSIS\r
+\r
+    use Pod::InputObjects;\r
+\r
+=head1 REQUIRES\r
+\r
+perl5.004, Carp\r
+\r
+=head1 EXPORTS\r
+\r
+Nothing.\r
+\r
+=head1 DESCRIPTION\r
+\r
+This module defines some basic input objects used by B<Pod::Parser> when\r
+reading and parsing POD text from an input source. The following objects\r
+are defined:\r
+\r
+=begin __PRIVATE__\r
+\r
+=over 4\r
+\r
+=item package B<Pod::InputSource>\r
+\r
+An object corresponding to a source of POD input text. It is mostly a\r
+wrapper around a filehandle or C<IO::Handle>-type object (or anything\r
+that implements the C<getline()> method) which keeps track of some\r
+additional information relevant to the parsing of PODs.\r
+\r
+=back\r
+\r
+=end __PRIVATE__\r
+\r
+=over 4\r
+\r
+=item package B<Pod::Paragraph>\r
+\r
+An object corresponding to a paragraph of POD input text. It may be a\r
+plain paragraph, a verbatim paragraph, or a command paragraph (see\r
+L<perlpod>).\r
+\r
+=item package B<Pod::InteriorSequence>\r
+\r
+An object corresponding to an interior sequence command from the POD\r
+input text (see L<perlpod>).\r
+\r
+=item package B<Pod::ParseTree>\r
+\r
+An object corresponding to a tree of parsed POD text. Each "node" in\r
+a parse-tree (or I<ptree>) is either a text-string or a reference to\r
+a B<Pod::InteriorSequence> object. The nodes appear in the parse-tree\r
+in the order in which they were parsed from left-to-right.\r
+\r
+=back\r
+\r
+Each of these input objects are described in further detail in the\r
+sections which follow.\r
+\r
+=cut\r
+\r
+#############################################################################\r
+\r
+package Pod::InputSource;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin __PRIVATE__\r
+\r
+=head1 B<Pod::InputSource>\r
+\r
+This object corresponds to an input source or stream of POD\r
+documentation. When parsing PODs, it is necessary to associate and store\r
+certain context information with each input source. All of this\r
+information is kept together with the stream itself in one of these\r
+C<Pod::InputSource> objects. Each such object is merely a wrapper around\r
+an C<IO::Handle> object of some kind (or at least something that\r
+implements the C<getline()> method). They have the following\r
+methods/attributes:\r
+\r
+=end __PRIVATE__\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin __PRIVATE__\r
+\r
+=head2 B<new()>\r
+\r
+        my $pod_input1 = Pod::InputSource->new(-handle => $filehandle);\r
+        my $pod_input2 = new Pod::InputSource(-handle => $filehandle,\r
+                                              -name   => $name);\r
+        my $pod_input3 = new Pod::InputSource(-handle => \*STDIN);\r
+        my $pod_input4 = Pod::InputSource->new(-handle => \*STDIN,\r
+                                               -name => "(STDIN)");\r
+\r
+This is a class method that constructs a C<Pod::InputSource> object and\r
+returns a reference to the new input source object. It takes one or more\r
+keyword arguments in the form of a hash. The keyword C<-handle> is\r
+required and designates the corresponding input handle. The keyword\r
+C<-name> is optional and specifies the name associated with the input\r
+handle (typically a file name).\r
+\r
+=end __PRIVATE__\r
+\r
+=cut\r
+\r
+sub new {\r
+    ## Determine if we were called via an object-ref or a classname\r
+    my $this = shift;\r
+    my $class = ref($this) || $this;\r
+\r
+    ## Any remaining arguments are treated as initial values for the\r
+    ## hash that is used to represent this object. Note that we default\r
+    ## certain values by specifying them *before* the arguments passed.\r
+    ## If they are in the argument list, they will override the defaults.\r
+    my $self = { -name        => '(unknown)',\r
+                 -handle      => undef,\r
+                 -was_cutting => 0,\r
+                 @_ };\r
+\r
+    ## Bless ourselves into the desired class and perform any initialization\r
+    bless $self, $class;\r
+    return $self;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin __PRIVATE__\r
+\r
+=head2 B<name()>\r
+\r
+        my $filename = $pod_input->name();\r
+        $pod_input->name($new_filename_to_use);\r
+\r
+This method gets/sets the name of the input source (usually a filename).\r
+If no argument is given, it returns a string containing the name of\r
+the input source; otherwise it sets the name of the input source to the\r
+contents of the given argument.\r
+\r
+=end __PRIVATE__\r
+\r
+=cut\r
+\r
+sub name {\r
+   (@_ > 1)  and  $_[0]->{'-name'} = $_[1];\r
+   return $_[0]->{'-name'};\r
+}\r
+\r
+## allow 'filename' as an alias for 'name'\r
+*filename = \&name;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin __PRIVATE__\r
+\r
+=head2 B<handle()>\r
+\r
+        my $handle = $pod_input->handle();\r
+\r
+Returns a reference to the handle object from which input is read (the\r
+one used to contructed this input source object).\r
+\r
+=end __PRIVATE__\r
+\r
+=cut\r
+\r
+sub handle {\r
+   return $_[0]->{'-handle'};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=begin __PRIVATE__\r
+\r
+=head2 B<was_cutting()>\r
+\r
+        print "Yes.\n" if ($pod_input->was_cutting());\r
+\r
+The value of the C<cutting> state (that the B<cutting()> method would\r
+have returned) immediately before any input was read from this input\r
+stream. After all input from this stream has been read, the C<cutting>\r
+state is restored to this value.\r
+\r
+=end __PRIVATE__\r
+\r
+=cut\r
+\r
+sub was_cutting {\r
+   (@_ > 1)  and  $_[0]->{-was_cutting} = $_[1];\r
+   return $_[0]->{-was_cutting};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+#############################################################################\r
+\r
+package Pod::Paragraph;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<Pod::Paragraph>\r
+\r
+An object representing a paragraph of POD input text.\r
+It has the following methods/attributes:\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 Pod::Paragraph-E<gt>B<new()>\r
+\r
+        my $pod_para1 = Pod::Paragraph->new(-text => $text);\r
+        my $pod_para2 = Pod::Paragraph->new(-name => $cmd,\r
+                                            -text => $text);\r
+        my $pod_para3 = new Pod::Paragraph(-text => $text);\r
+        my $pod_para4 = new Pod::Paragraph(-name => $cmd,\r
+                                           -text => $text);\r
+        my $pod_para5 = Pod::Paragraph->new(-name => $cmd,\r
+                                            -text => $text,\r
+                                            -file => $filename,\r
+                                            -line => $line_number);\r
+\r
+This is a class method that constructs a C<Pod::Paragraph> object and\r
+returns a reference to the new paragraph object. It may be given one or\r
+two keyword arguments. The C<-text> keyword indicates the corresponding\r
+text of the POD paragraph. The C<-name> keyword indicates the name of\r
+the corresponding POD command, such as C<head1> or C<item> (it should\r
+I<not> contain the C<=> prefix); this is needed only if the POD\r
+paragraph corresponds to a command paragraph. The C<-file> and C<-line>\r
+keywords indicate the filename and line number corresponding to the\r
+beginning of the paragraph \r
+\r
+=cut\r
+\r
+sub new {\r
+    ## Determine if we were called via an object-ref or a classname\r
+    my $this = shift;\r
+    my $class = ref($this) || $this;\r
+\r
+    ## Any remaining arguments are treated as initial values for the\r
+    ## hash that is used to represent this object. Note that we default\r
+    ## certain values by specifying them *before* the arguments passed.\r
+    ## If they are in the argument list, they will override the defaults.\r
+    my $self = {\r
+          -name       => undef,\r
+          -text       => (@_ == 1) ? shift : undef,\r
+          -file       => '<unknown-file>',\r
+          -line       => 0,\r
+          -prefix     => '=',\r
+          -separator  => ' ',\r
+          -ptree => [],\r
+          @_\r
+    };\r
+\r
+    ## Bless ourselves into the desired class and perform any initialization\r
+    bless $self, $class;\r
+    return $self;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_para-E<gt>B<cmd_name()>\r
+\r
+        my $para_cmd = $pod_para->cmd_name();\r
+\r
+If this paragraph is a command paragraph, then this method will return \r
+the name of the command (I<without> any leading C<=> prefix).\r
+\r
+=cut\r
+\r
+sub cmd_name {\r
+   (@_ > 1)  and  $_[0]->{'-name'} = $_[1];\r
+   return $_[0]->{'-name'};\r
+}\r
+\r
+## let name() be an alias for cmd_name()\r
+*name = \&cmd_name;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_para-E<gt>B<text()>\r
+\r
+        my $para_text = $pod_para->text();\r
+\r
+This method will return the corresponding text of the paragraph.\r
+\r
+=cut\r
+\r
+sub text {\r
+   (@_ > 1)  and  $_[0]->{'-text'} = $_[1];\r
+   return $_[0]->{'-text'};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_para-E<gt>B<raw_text()>\r
+\r
+        my $raw_pod_para = $pod_para->raw_text();\r
+\r
+This method will return the I<raw> text of the POD paragraph, exactly\r
+as it appeared in the input.\r
+\r
+=cut\r
+\r
+sub raw_text {\r
+   return $_[0]->{'-text'}  unless (defined $_[0]->{'-name'});\r
+   return $_[0]->{'-prefix'} . $_[0]->{'-name'} .\r
+          $_[0]->{'-separator'} . $_[0]->{'-text'};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_para-E<gt>B<cmd_prefix()>\r
+\r
+        my $prefix = $pod_para->cmd_prefix();\r
+\r
+If this paragraph is a command paragraph, then this method will return \r
+the prefix used to denote the command (which should be the string "="\r
+or "==").\r
+\r
+=cut\r
+\r
+sub cmd_prefix {\r
+   return $_[0]->{'-prefix'};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_para-E<gt>B<cmd_separator()>\r
+\r
+        my $separator = $pod_para->cmd_separator();\r
+\r
+If this paragraph is a command paragraph, then this method will return\r
+the text used to separate the command name from the rest of the\r
+paragraph (if any).\r
+\r
+=cut\r
+\r
+sub cmd_separator {\r
+   return $_[0]->{'-separator'};\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_para-E<gt>B<parse_tree()>\r
+\r
+        my $ptree = $pod_parser->parse_text( $pod_para->text() );\r
+        $pod_para->parse_tree( $ptree );\r
+        $ptree = $pod_para->parse_tree();\r
+\r
+This method will get/set the corresponding parse-tree of the paragraph's text.\r
+\r
+=cut\r
+\r
+sub parse_tree {\r
+   (@_ > 1)  and  $_[0]->{'-ptree'} = $_[1];\r
+   return $_[0]->{'-ptree'};\r
+}\r
+\r
+## let ptree() be an alias for parse_tree()\r
+*ptree = \&parse_tree;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_para-E<gt>B<file_line()>\r
+\r
+        my ($filename, $line_number) = $pod_para->file_line();\r
+        my $position = $pod_para->file_line();\r
+\r
+Returns the current filename and line number for the paragraph\r
+object.  If called in a list context, it returns a list of two\r
+elements: first the filename, then the line number. If called in\r
+a scalar context, it returns a string containing the filename, followed\r
+by a colon (':'), followed by the line number.\r
+\r
+=cut\r
+\r
+sub file_line {\r
+   my @loc = ($_[0]->{'-file'} || '<unknown-file>',\r
+              $_[0]->{'-line'} || 0);\r
+   return (wantarray) ? @loc : join(':', @loc);\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+#############################################################################\r
+\r
+package Pod::InteriorSequence;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<Pod::InteriorSequence>\r
+\r
+An object representing a POD interior sequence command.\r
+It has the following methods/attributes:\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 Pod::InteriorSequence-E<gt>B<new()>\r
+\r
+        my $pod_seq1 = Pod::InteriorSequence->new(-name => $cmd\r
+                                                  -ldelim => $delimiter);\r
+        my $pod_seq2 = new Pod::InteriorSequence(-name => $cmd,\r
+                                                 -ldelim => $delimiter);\r
+        my $pod_seq3 = new Pod::InteriorSequence(-name => $cmd,\r
+                                                 -ldelim => $delimiter,\r
+                                                 -file => $filename,\r
+                                                 -line => $line_number);\r
+\r
+        my $pod_seq4 = new Pod::InteriorSequence(-name => $cmd, $ptree);\r
+        my $pod_seq5 = new Pod::InteriorSequence($cmd, $ptree);\r
+\r
+This is a class method that constructs a C<Pod::InteriorSequence> object\r
+and returns a reference to the new interior sequence object. It should\r
+be given two keyword arguments.  The C<-ldelim> keyword indicates the\r
+corresponding left-delimiter of the interior sequence (e.g. 'E<lt>').\r
+The C<-name> keyword indicates the name of the corresponding interior\r
+sequence command, such as C<I> or C<B> or C<C>. The C<-file> and\r
+C<-line> keywords indicate the filename and line number corresponding\r
+to the beginning of the interior sequence. If the C<$ptree> argument is\r
+given, it must be the last argument, and it must be either string, or\r
+else an array-ref suitable for passing to B<Pod::ParseTree::new> (or\r
+it may be a reference to a Pod::ParseTree object).\r
+\r
+=cut\r
+\r
+sub new {\r
+    ## Determine if we were called via an object-ref or a classname\r
+    my $this = shift;\r
+    my $class = ref($this) || $this;\r
+\r
+    ## See if first argument has no keyword\r
+    if (((@_ <= 2) or (@_ % 2)) and $_[0] !~ /^-\w/) {\r
+       ## Yup - need an implicit '-name' before first parameter\r
+       unshift @_, '-name';\r
+    }\r
+\r
+    ## See if odd number of args\r
+    if ((@_ % 2) != 0) {\r
+       ## Yup - need an implicit '-ptree' before the last parameter\r
+       splice @_, $#_, 0, '-ptree';\r
+    }\r
+\r
+    ## Any remaining arguments are treated as initial values for the\r
+    ## hash that is used to represent this object. Note that we default\r
+    ## certain values by specifying them *before* the arguments passed.\r
+    ## If they are in the argument list, they will override the defaults.\r
+    my $self = {\r
+          -name       => (@_ == 1) ? $_[0] : undef,\r
+          -file       => '<unknown-file>',\r
+          -line       => 0,\r
+          -ldelim     => '<',\r
+          -rdelim     => '>',\r
+          @_\r
+    };\r
+\r
+    ## Initialize contents if they havent been already\r
+    my $ptree = $self->{'-ptree'} || new Pod::ParseTree();\r
+    if ( ref $ptree =~ /^(ARRAY)?$/ ) {\r
+        ## We have an array-ref, or a normal scalar. Pass it as an\r
+        ## an argument to the ptree-constructor\r
+        $ptree = new Pod::ParseTree($1 ? [$ptree] : $ptree);\r
+    }\r
+    $self->{'-ptree'} = $ptree;\r
+\r
+    ## Bless ourselves into the desired class and perform any initialization\r
+    bless $self, $class;\r
+    return $self;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<cmd_name()>\r
+\r
+        my $seq_cmd = $pod_seq->cmd_name();\r
+\r
+The name of the interior sequence command.\r
+\r
+=cut\r
+\r
+sub cmd_name {\r
+   (@_ > 1)  and  $_[0]->{'-name'} = $_[1];\r
+   return $_[0]->{'-name'};\r
+}\r
+\r
+## let name() be an alias for cmd_name()\r
+*name = \&cmd_name;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+## Private subroutine to set the parent pointer of all the given\r
+## children that are interior-sequences to be $self\r
+\r
+sub _set_child2parent_links {\r
+   my ($self, @children) = @_;\r
+   ## Make sure any sequences know who their parent is\r
+   for (@children) {\r
+      next  unless (length  and  ref  and  ref ne 'SCALAR');\r
+      if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or\r
+          UNIVERSAL::can($_, 'nested'))\r
+      {\r
+          $_->nested($self);\r
+      }\r
+   }\r
+}\r
+\r
+## Private subroutine to unset child->parent links\r
+\r
+sub _unset_child2parent_links {\r
+   my $self = shift;\r
+   $self->{'-parent_sequence'} = undef;\r
+   my $ptree = $self->{'-ptree'};\r
+   for (@$ptree) {\r
+      next  unless (length  and  ref  and  ref ne 'SCALAR');\r
+      $_->_unset_child2parent_links()\r
+          if UNIVERSAL::isa($_, 'Pod::InteriorSequence');\r
+   }\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<prepend()>\r
+\r
+        $pod_seq->prepend($text);\r
+        $pod_seq1->prepend($pod_seq2);\r
+\r
+Prepends the given string or parse-tree or sequence object to the parse-tree\r
+of this interior sequence.\r
+\r
+=cut\r
+\r
+sub prepend {\r
+   my $self  = shift;\r
+   $self->{'-ptree'}->prepend(@_);\r
+   _set_child2parent_links($self, @_);\r
+   return $self;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<append()>\r
+\r
+        $pod_seq->append($text);\r
+        $pod_seq1->append($pod_seq2);\r
+\r
+Appends the given string or parse-tree or sequence object to the parse-tree\r
+of this interior sequence.\r
+\r
+=cut\r
+\r
+sub append {\r
+   my $self = shift;\r
+   $self->{'-ptree'}->append(@_);\r
+   _set_child2parent_links($self, @_);\r
+   return $self;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<nested()>\r
+\r
+        $outer_seq = $pod_seq->nested || print "not nested";\r
+\r
+If this interior sequence is nested inside of another interior\r
+sequence, then the outer/parent sequence that contains it is\r
+returned. Otherwise C<undef> is returned.\r
+\r
+=cut\r
+\r
+sub nested {\r
+   my $self = shift;\r
+  (@_ == 1)  and  $self->{'-parent_sequence'} = shift;\r
+   return  $self->{'-parent_sequence'} || undef;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<raw_text()>\r
+\r
+        my $seq_raw_text = $pod_seq->raw_text();\r
+\r
+This method will return the I<raw> text of the POD interior sequence,\r
+exactly as it appeared in the input.\r
+\r
+=cut\r
+\r
+sub raw_text {\r
+   my $self = shift;\r
+   my $text = $self->{'-name'} . $self->{'-ldelim'};\r
+   for ( $self->{'-ptree'}->children ) {\r
+      $text .= (ref $_) ? $_->raw_text : $_;\r
+   }\r
+   $text .= $self->{'-rdelim'};\r
+   return $text;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<left_delimiter()>\r
+\r
+        my $ldelim = $pod_seq->left_delimiter();\r
+\r
+The leftmost delimiter beginning the argument text to the interior\r
+sequence (should be "<").\r
+\r
+=cut\r
+\r
+sub left_delimiter {\r
+   (@_ > 1)  and  $_[0]->{'-ldelim'} = $_[1];\r
+   return $_[0]->{'-ldelim'};\r
+}\r
+\r
+## let ldelim() be an alias for left_delimiter()\r
+*ldelim = \&left_delimiter;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<right_delimiter()>\r
+\r
+The rightmost delimiter beginning the argument text to the interior\r
+sequence (should be ">").\r
+\r
+=cut\r
+\r
+sub right_delimiter {\r
+   (@_ > 1)  and  $_[0]->{'-rdelim'} = $_[1];\r
+   return $_[0]->{'-rdelim'};\r
+}\r
+\r
+## let rdelim() be an alias for right_delimiter()\r
+*rdelim = \&right_delimiter;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<parse_tree()>\r
+\r
+        my $ptree = $pod_parser->parse_text($paragraph_text);\r
+        $pod_seq->parse_tree( $ptree );\r
+        $ptree = $pod_seq->parse_tree();\r
+\r
+This method will get/set the corresponding parse-tree of the interior\r
+sequence's text.\r
+\r
+=cut\r
+\r
+sub parse_tree {\r
+   (@_ > 1)  and  $_[0]->{'-ptree'} = $_[1];\r
+   return $_[0]->{'-ptree'};\r
+}\r
+\r
+## let ptree() be an alias for parse_tree()\r
+*ptree = \&parse_tree;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $pod_seq-E<gt>B<file_line()>\r
+\r
+        my ($filename, $line_number) = $pod_seq->file_line();\r
+        my $position = $pod_seq->file_line();\r
+\r
+Returns the current filename and line number for the interior sequence\r
+object.  If called in a list context, it returns a list of two\r
+elements: first the filename, then the line number. If called in\r
+a scalar context, it returns a string containing the filename, followed\r
+by a colon (':'), followed by the line number.\r
+\r
+=cut\r
+\r
+sub file_line {\r
+   my @loc = ($_[0]->{'-file'}  || '<unknown-file>',\r
+              $_[0]->{'-line'}  || 0);\r
+   return (wantarray) ? @loc : join(':', @loc);\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 Pod::InteriorSequence::B<DESTROY()>\r
+\r
+This method performs any necessary cleanup for the interior-sequence.\r
+If you override this method then it is B<imperative> that you invoke\r
+the parent method from within your own method, otherwise\r
+I<interior-sequence storage will not be reclaimed upon destruction!>\r
+\r
+=cut\r
+\r
+sub DESTROY {\r
+   ## We need to get rid of all child->parent pointers throughout the\r
+   ## tree so their reference counts will go to zero and they can be\r
+   ## garbage-collected\r
+   _unset_child2parent_links(@_);\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+#############################################################################\r
+\r
+package Pod::ParseTree;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head1 B<Pod::ParseTree>\r
+\r
+This object corresponds to a tree of parsed POD text. As POD text is\r
+scanned from left to right, it is parsed into an ordered list of\r
+text-strings and B<Pod::InteriorSequence> objects (in order of\r
+appearance). A B<Pod::ParseTree> object corresponds to this list of\r
+strings and sequences. Each interior sequence in the parse-tree may\r
+itself contain a parse-tree (since interior sequences may be nested).\r
+\r
+=cut\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 Pod::ParseTree-E<gt>B<new()>\r
+\r
+        my $ptree1 = Pod::ParseTree->new;\r
+        my $ptree2 = new Pod::ParseTree;\r
+        my $ptree4 = Pod::ParseTree->new($array_ref);\r
+        my $ptree3 = new Pod::ParseTree($array_ref);\r
+\r
+This is a class method that constructs a C<Pod::Parse_tree> object and\r
+returns a reference to the new parse-tree. If a single-argument is given,\r
+it must be a reference to an array, and is used to initialize the root\r
+(top) of the parse tree.\r
+\r
+=cut\r
+\r
+sub new {\r
+    ## Determine if we were called via an object-ref or a classname\r
+    my $this = shift;\r
+    my $class = ref($this) || $this;\r
+\r
+    my $self = (@_ == 1  and  ref $_[0]) ? $_[0] : [];\r
+\r
+    ## Bless ourselves into the desired class and perform any initialization\r
+    bless $self, $class;\r
+    return $self;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $ptree-E<gt>B<top()>\r
+\r
+        my $top_node = $ptree->top();\r
+        $ptree->top( $top_node );\r
+        $ptree->top( @children );\r
+\r
+This method gets/sets the top node of the parse-tree. If no arguments are\r
+given, it returns the topmost node in the tree (the root), which is also\r
+a B<Pod::ParseTree>. If it is given a single argument that is a reference,\r
+then the reference is assumed to a parse-tree and becomes the new top node.\r
+Otherwise, if arguments are given, they are treated as the new list of\r
+children for the top node.\r
+\r
+=cut\r
+\r
+sub top {\r
+   my $self = shift;\r
+   if (@_ > 0) {\r
+      @{ $self } = (@_ == 1  and  ref $_[0]) ? ${ @_ } : @_;\r
+   }\r
+   return $self;\r
+}\r
+\r
+## let parse_tree() & ptree() be aliases for the 'top' method\r
+*parse_tree = *ptree = \&top;\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $ptree-E<gt>B<children()>\r
+\r
+This method gets/sets the children of the top node in the parse-tree.\r
+If no arguments are given, it returns the list (array) of children\r
+(each of which should be either a string or a B<Pod::InteriorSequence>.\r
+Otherwise, if arguments are given, they are treated as the new list of\r
+children for the top node.\r
+\r
+=cut\r
+\r
+sub children {\r
+   my $self = shift;\r
+   if (@_ > 0) {\r
+      @{ $self } = (@_ == 1  and  ref $_[0]) ? ${ @_ } : @_;\r
+   }\r
+   return @{ $self };\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $ptree-E<gt>B<prepend()>\r
+\r
+This method prepends the given text or parse-tree to the current parse-tree.\r
+If the first item on the parse-tree is text and the argument is also text,\r
+then the text is prepended to the first item (not added as a separate string).\r
+Otherwise the argument is added as a new string or parse-tree I<before>\r
+the current one.\r
+\r
+=cut\r
+\r
+use vars qw(@ptree);  ## an alias used for performance reasons\r
+\r
+sub prepend {\r
+   my $self = shift;\r
+   local *ptree = $self;\r
+   for (@_) {\r
+      next  unless length;\r
+      if (@ptree && !(ref $ptree[0]) && !(ref $_)) {\r
+         $ptree[0] = $_ . $ptree[0];\r
+      }\r
+      else {\r
+         unshift @ptree, $_;\r
+      }\r
+   }\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+=head2 $ptree-E<gt>B<append()>\r
+\r
+This method appends the given text or parse-tree to the current parse-tree.\r
+If the last item on the parse-tree is text and the argument is also text,\r
+then the text is appended to the last item (not added as a separate string).\r
+Otherwise the argument is added as a new string or parse-tree I<after>\r
+the current one.\r
+\r
+=cut\r
+\r
+sub append {\r
+   my $self = shift;\r
+   local *ptree = $self;\r
+   my $can_append = @ptree && !(ref $ptree[-1]);\r
+   for (@_) {\r
+      if (ref) {\r
+         push @ptree, $_;\r
+      }\r
+      elsif(!length) {\r
+         next;\r
+      }\r
+      elsif ($can_append) {\r
+         $ptree[-1] .= $_;\r
+      }\r
+      else {\r
+         push @ptree, $_;\r
+      }\r
+   }\r
+}\r
+\r
+=head2 $ptree-E<gt>B<raw_text()>\r
+\r
+        my $ptree_raw_text = $ptree->raw_text();\r
+\r
+This method will return the I<raw> text of the POD parse-tree\r
+exactly as it appeared in the input.\r
+\r
+=cut\r
+\r
+sub raw_text {\r
+   my $self = shift;\r
+   my $text = '';\r
+   for ( @$self ) {\r
+      $text .= (ref $_) ? $_->raw_text : $_;\r
+   }\r
+   return $text;\r
+}\r
+\r
+##---------------------------------------------------------------------------\r
+\r
+## Private routines to set/unset child->parent links\r
+\r
+sub _unset_child2parent_links {\r
+   my $self = shift;\r
+   local *ptree = $self;\r
+   for (@ptree) {\r
+       next  unless (defined and length  and  ref  and  ref ne 'SCALAR');\r
+       $_->_unset_child2parent_links()\r
+           if UNIVERSAL::isa($_, 'Pod::InteriorSequence');\r
+   }\r
+}\r
+\r
+sub _set_child2parent_links {\r
+    ## nothing to do, Pod::ParseTrees cant have parent pointers\r
+}\r
+\r
+=head2 Pod::ParseTree::B<DESTROY()>\r
+\r
+This method performs any necessary cleanup for the parse-tree.\r
+If you override this method then it is B<imperative>\r
+that you invoke the parent method from within your own method,\r
+otherwise I<parse-tree storage will not be reclaimed upon destruction!>\r
+\r
+=cut\r
+\r
+sub DESTROY {\r
+   ## We need to get rid of all child->parent pointers throughout the\r
+   ## tree so their reference counts will go to zero and they can be\r
+   ## garbage-collected\r
+   _unset_child2parent_links(@_);\r
+}\r
+\r
+#############################################################################\r
+\r
+=head1 SEE ALSO\r
+\r
+B<Pod::InputObjects> is part of the L<Pod::Parser> distribution.\r
+\r
+See L<Pod::Parser>, L<Pod::Select>\r
+\r
+=head1 AUTHOR\r
+\r
+Please report bugs using L<http://rt.cpan.org>.\r
+\r
+Brad Appleton E<lt>bradapp@enteract.comE<gt>\r
+\r
+=cut\r
+\r
+1;\r
index 3c74d78..fc9f3a7 100644 (file)
-#############################################################################
-# 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.51'; ## 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.
-
-B<Pod::ParseUtils> is part of the L<Pod::Parser> distribution.
-
-=head1 SEE ALSO
-
-L<pod2man>, L<pod2roff>, L<Pod::Parser>, L<Pod::Checker>,
-L<pod2html>
-
-=cut
-
-1;
+#############################################################################\r
+# Pod/ParseUtils.pm -- helpers for POD parsing and conversion\r
+#\r
+# Copyright (C) 1999-2000 by Marek Rouchal. All rights reserved.\r
+# This file is part of "PodParser". PodParser is free software;\r
+# you can redistribute it and/or modify it under the same terms\r
+# as Perl itself.\r
+#############################################################################\r
+\r
+package Pod::ParseUtils;\r
+use strict;\r
+\r
+use vars qw($VERSION);\r
+$VERSION = '1.60'; ## Current version of this package\r
+require  5.005;    ## requires this Perl version or later\r
+\r
+=head1 NAME\r
+\r
+Pod::ParseUtils - helpers for POD parsing and conversion\r
+\r
+=head1 SYNOPSIS\r
+\r
+  use Pod::ParseUtils;\r
+\r
+  my $list = new Pod::List;\r
+  my $link = Pod::Hyperlink->new('Pod::Parser');\r
+\r
+=head1 DESCRIPTION\r
+\r
+B<Pod::ParseUtils> contains a few object-oriented helper packages for\r
+POD parsing and processing (i.e. in POD formatters and translators).\r
+\r
+=cut\r
+\r
+#-----------------------------------------------------------------------------\r
+# Pod::List\r
+#\r
+# class to hold POD list info (=over, =item, =back)\r
+#-----------------------------------------------------------------------------\r
+\r
+package Pod::List;\r
+\r
+use Carp;\r
+\r
+=head2 Pod::List\r
+\r
+B<Pod::List> can be used to hold information about POD lists\r
+(written as =over ... =item ... =back) for further processing.\r
+The following methods are available:\r
+\r
+=over 4\r
+\r
+=item Pod::List-E<gt>new()\r
+\r
+Create a new list object. Properties may be specified through a hash\r
+reference like this:\r
+\r
+  my $list = Pod::List->new({ -start => $., -indent => 4 });\r
+\r
+See the individual methods/properties for details.\r
+\r
+=cut\r
+\r
+sub new {\r
+    my $this = shift;\r
+    my $class = ref($this) || $this;\r
+    my %params = @_;\r
+    my $self = {%params};\r
+    bless $self, $class;\r
+    $self->initialize();\r
+    return $self;\r
+}\r
+\r
+sub initialize {\r
+    my $self = shift;\r
+    $self->{-file} ||= 'unknown';\r
+    $self->{-start} ||= 'unknown';\r
+    $self->{-indent} ||= 4; # perlpod: "should be the default"\r
+    $self->{_items} = [];\r
+    $self->{-type} ||= '';\r
+}\r
+\r
+=item $list-E<gt>file()\r
+\r
+Without argument, retrieves the file name the list is in. This must\r
+have been set before by either specifying B<-file> in the B<new()>\r
+method or by calling the B<file()> method with a scalar argument.\r
+\r
+=cut\r
+\r
+# The POD file name the list appears in\r
+sub file {\r
+   return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};\r
+}\r
+\r
+=item $list-E<gt>start()\r
+\r
+Without argument, retrieves the line number where the list started.\r
+This must have been set before by either specifying B<-start> in the\r
+B<new()> method or by calling the B<start()> method with a scalar\r
+argument.\r
+\r
+=cut\r
+\r
+# The line in the file the node appears\r
+sub start {\r
+   return (@_ > 1) ? ($_[0]->{-start} = $_[1]) : $_[0]->{-start};\r
+}\r
+\r
+=item $list-E<gt>indent()\r
+\r
+Without argument, retrieves the indent level of the list as specified\r
+in C<=over n>. This must have been set before by either specifying\r
+B<-indent> in the B<new()> method or by calling the B<indent()> method\r
+with a scalar argument.\r
+\r
+=cut\r
+\r
+# indent level\r
+sub indent {\r
+   return (@_ > 1) ? ($_[0]->{-indent} = $_[1]) : $_[0]->{-indent};\r
+}\r
+\r
+=item $list-E<gt>type()\r
+\r
+Without argument, retrieves the list type, which can be an arbitrary value,\r
+e.g. C<OL>, C<UL>, ... when thinking the HTML way.\r
+This must have been set before by either specifying\r
+B<-type> in the B<new()> method or by calling the B<type()> method\r
+with a scalar argument.\r
+\r
+=cut\r
+\r
+# The type of the list (UL, OL, ...)\r
+sub type {\r
+   return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};\r
+}\r
+\r
+=item $list-E<gt>rx()\r
+\r
+Without argument, retrieves a regular expression for simplifying the \r
+individual item strings once the list type has been determined. Usage:\r
+E.g. when converting to HTML, one might strip the leading number in\r
+an ordered list as C<E<lt>OLE<gt>> already prints numbers itself.\r
+This must have been set before by either specifying\r
+B<-rx> in the B<new()> method or by calling the B<rx()> method\r
+with a scalar argument.\r
+\r
+=cut\r
+\r
+# The regular expression to simplify the items\r
+sub rx {\r
+   return (@_ > 1) ? ($_[0]->{-rx} = $_[1]) : $_[0]->{-rx};\r
+}\r
+\r
+=item $list-E<gt>item()\r
+\r
+Without argument, retrieves the array of the items in this list.\r
+The items may be represented by any scalar.\r
+If an argument has been given, it is pushed on the list of items.\r
+\r
+=cut\r
+\r
+# The individual =items of this list\r
+sub item {\r
+    my ($self,$item) = @_;\r
+    if(defined $item) {\r
+        push(@{$self->{_items}}, $item);\r
+        return $item;\r
+    }\r
+    else {\r
+        return @{$self->{_items}};\r
+    }\r
+}\r
+\r
+=item $list-E<gt>parent()\r
+\r
+Without argument, retrieves information about the parent holding this\r
+list, which is represented as an arbitrary scalar.\r
+This must have been set before by either specifying\r
+B<-parent> in the B<new()> method or by calling the B<parent()> method\r
+with a scalar argument.\r
+\r
+=cut\r
+\r
+# possibility for parsers/translators to store information about the\r
+# lists's parent object\r
+sub parent {\r
+   return (@_ > 1) ? ($_[0]->{-parent} = $_[1]) : $_[0]->{-parent};\r
+}\r
+\r
+=item $list-E<gt>tag()\r
+\r
+Without argument, retrieves information about the list tag, which can be\r
+any scalar.\r
+This must have been set before by either specifying\r
+B<-tag> in the B<new()> method or by calling the B<tag()> method\r
+with a scalar argument.\r
+\r
+=back\r
+\r
+=cut\r
+\r
+# possibility for parsers/translators to store information about the\r
+# list's object\r
+sub tag {\r
+   return (@_ > 1) ? ($_[0]->{-tag} = $_[1]) : $_[0]->{-tag};\r
+}\r
+\r
+#-----------------------------------------------------------------------------\r
+# Pod::Hyperlink\r
+#\r
+# class to manipulate POD hyperlinks (L<>)\r
+#-----------------------------------------------------------------------------\r
+\r
+package Pod::Hyperlink;\r
+\r
+=head2 Pod::Hyperlink\r
+\r
+B<Pod::Hyperlink> is a class for manipulation of POD hyperlinks. Usage:\r
+\r
+  my $link = Pod::Hyperlink->new('alternative text|page/"section in page"');\r
+\r
+The B<Pod::Hyperlink> class is mainly designed to parse the contents of the\r
+C<LE<lt>...E<gt>> sequence, providing a simple interface for accessing the\r
+different parts of a POD hyperlink for further processing. It can also be\r
+used to construct hyperlinks.\r
+\r
+=over 4\r
+\r
+=item Pod::Hyperlink-E<gt>new()\r
+\r
+The B<new()> method can either be passed a set of key/value pairs or a single\r
+scalar value, namely the contents of a C<LE<lt>...E<gt>> sequence. An object\r
+of the class C<Pod::Hyperlink> is returned. The value C<undef> indicates a\r
+failure, the error message is stored in C<$@>.\r
+\r
+=cut\r
+\r
+use Carp;\r
+\r
+sub new {\r
+    my $this = shift;\r
+    my $class = ref($this) || $this;\r
+    my $self = +{};\r
+    bless $self, $class;\r
+    $self->initialize();\r
+    if(defined $_[0]) {\r
+        if(ref($_[0])) {\r
+            # called with a list of parameters\r
+            %$self = %{$_[0]};\r
+            $self->_construct_text();\r
+        }\r
+        else {\r
+            # called with L<> contents\r
+            return unless($self->parse($_[0]));\r
+        }\r
+    }\r
+    return $self;\r
+}\r
+\r
+sub initialize {\r
+    my $self = shift;\r
+    $self->{-line} ||= 'undef';\r
+    $self->{-file} ||= 'undef';\r
+    $self->{-page} ||= '';\r
+    $self->{-node} ||= '';\r
+    $self->{-alttext} ||= '';\r
+    $self->{-type} ||= 'undef';\r
+    $self->{_warnings} = [];\r
+}\r
+\r
+=item $link-E<gt>parse($string)\r
+\r
+This method can be used to (re)parse a (new) hyperlink, i.e. the contents\r
+of a C<LE<lt>...E<gt>> sequence. The result is stored in the current object.\r
+Warnings are stored in the B<warnings> property.\r
+E.g. sections like C<LE<lt>open(2)E<gt>> are deprecated, as they do not point\r
+to Perl documents. C<LE<lt>DBI::foo(3p)E<gt>> is wrong as well, the manpage\r
+section can simply be dropped.\r
+\r
+=cut\r
+\r
+sub parse {\r
+    my $self = shift;\r
+    local($_) = $_[0];\r
+    # syntax check the link and extract destination\r
+    my ($alttext,$page,$node,$type,$quoted) = (undef,'','','',0);\r
+\r
+    $self->{_warnings} = [];\r
+\r
+    # collapse newlines with whitespace\r
+    s/\s*\n+\s*/ /g;\r
+\r
+    # strip leading/trailing whitespace\r
+    if(s/^[\s\n]+//) {\r
+        $self->warning('ignoring leading whitespace in link');\r
+    }\r
+    if(s/[\s\n]+$//) {\r
+        $self->warning('ignoring trailing whitespace in link');\r
+    }\r
+    unless(length($_)) {\r
+        _invalid_link('empty link');\r
+        return;\r
+    }\r
+\r
+    ## Check for different possibilities. This is tedious and error-prone\r
+    # we match all possibilities (alttext, page, section/item)\r
+    #warn "DEBUG: link=$_\n";\r
+\r
+    # only page\r
+    # problem: a lot of people use (), or (1) or the like to indicate\r
+    # man page sections. But this collides with L<func()> that is supposed\r
+    # to point to an internal funtion...\r
+    my $page_rx = '[\w.-]+(?:::[\w.-]+)*(?:[(](?:\d\w*|)[)]|)';\r
+    # page name only\r
+    if(/^($page_rx)$/o) {\r
+        $page = $1;\r
+        $type = 'page';\r
+    }\r
+    # alttext, page and "section"\r
+    elsif(m{^(.*?)\s*[|]\s*($page_rx)\s*/\s*"(.+)"$}o) {\r
+        ($alttext, $page, $node) = ($1, $2, $3);\r
+        $type = 'section';\r
+        $quoted = 1; #... therefore | and / are allowed\r
+    }\r
+    # alttext and page\r
+    elsif(/^(.*?)\s*[|]\s*($page_rx)$/o) {\r
+        ($alttext, $page) = ($1, $2);\r
+        $type = 'page';\r
+    }\r
+    # alttext and "section"\r
+    elsif(m{^(.*?)\s*[|]\s*(?:/\s*|)"(.+)"$}) {\r
+        ($alttext, $node) = ($1,$2);\r
+        $type = 'section';\r
+        $quoted = 1;\r
+    }\r
+    # page and "section"\r
+    elsif(m{^($page_rx)\s*/\s*"(.+)"$}o) {\r
+        ($page, $node) = ($1, $2);\r
+        $type = 'section';\r
+        $quoted = 1;\r
+    }\r
+    # page and item\r
+    elsif(m{^($page_rx)\s*/\s*(.+)$}o) {\r
+        ($page, $node) = ($1, $2);\r
+        $type = 'item';\r
+    }\r
+    # only "section"\r
+    elsif(m{^/?"(.+)"$}) {\r
+        $node = $1;\r
+        $type = 'section';\r
+        $quoted = 1;\r
+    }\r
+    # only item\r
+    elsif(m{^\s*/(.+)$}) {\r
+        $node = $1;\r
+        $type = 'item';\r
+    }\r
+\r
+    # non-standard: Hyperlink with alt-text - doesn't remove protocol prefix, maybe it should?\r
+    elsif(/^ \s* (.*?) \s* [|] \s* (\w+:[^:\s] [^\s|]*?) \s* $/ix) {\r
+      ($alttext,$node) = ($1,$2);\r
+      $type = 'hyperlink';\r
+    }\r
+\r
+    # non-standard: Hyperlink\r
+    elsif(/^(\w+:[^:\s]\S*)$/i) {\r
+        $node = $1;\r
+        $type = 'hyperlink';\r
+    }\r
+    # alttext, page and item\r
+    elsif(m{^(.*?)\s*[|]\s*($page_rx)\s*/\s*(.+)$}o) {\r
+        ($alttext, $page, $node) = ($1, $2, $3);\r
+        $type = 'item';\r
+    }\r
+    # alttext and item\r
+    elsif(m{^(.*?)\s*[|]\s*/(.+)$}) {\r
+        ($alttext, $node) = ($1,$2);\r
+    }\r
+    # must be an item or a "malformed" section (without "")\r
+    else {\r
+        $node = $_;\r
+        $type = 'item';\r
+    }\r
+    # collapse whitespace in nodes\r
+    $node =~ s/\s+/ /gs;\r
+\r
+    # empty alternative text expands to node name\r
+    if(defined $alttext) {\r
+        if(!length($alttext)) {\r
+          $alttext = $node || $page;\r
+        }\r
+    }\r
+    else {\r
+        $alttext = '';\r
+    }\r
+\r
+    if($page =~ /[(]\w*[)]$/) {\r
+        $self->warning("(section) in '$page' deprecated");\r
+    }\r
+    if(!$quoted && $node =~ m{[|/]} && $type ne 'hyperlink') {\r
+        $self->warning("node '$node' contains non-escaped | or /");\r
+    }\r
+    if($alttext =~ m{[|/]}) {\r
+        $self->warning("alternative text '$node' contains non-escaped | or /");\r
+    }\r
+    $self->{-page} = $page;\r
+    $self->{-node} = $node;\r
+    $self->{-alttext} = $alttext;\r
+    #warn "DEBUG: page=$page section=$section item=$item alttext=$alttext\n";\r
+    $self->{-type} = $type;\r
+    $self->_construct_text();\r
+    1;\r
+}\r
+\r
+sub _construct_text {\r
+    my $self = shift;\r
+    my $alttext = $self->alttext();\r
+    my $type = $self->type();\r
+    my $section = $self->node();\r
+    my $page = $self->page();\r
+    my $page_ext = '';\r
+    $page =~ s/([(]\w*[)])$// && ($page_ext = $1);\r
+    if($alttext) {\r
+        $self->{_text} = $alttext;\r
+    }\r
+    elsif($type eq 'hyperlink') {\r
+        $self->{_text} = $section;\r
+    }\r
+    else {\r
+        $self->{_text} = ($section || '') .\r
+            (($page && $section) ? ' in ' : '') .\r
+            "$page$page_ext";\r
+    }\r
+    # for being marked up later\r
+    # use the non-standard markers P<> and Q<>, so that the resulting\r
+    # text can be parsed by the translators. It's their job to put\r
+    # the correct hypertext around the linktext\r
+    if($alttext) {\r
+        $self->{_markup} = "Q<$alttext>";\r
+    }\r
+    elsif($type eq 'hyperlink') {\r
+        $self->{_markup} = "Q<$section>";\r
+    }\r
+    else {\r
+        $self->{_markup} = (!$section ? '' : "Q<$section>") .\r
+            ($page ? ($section ? ' in ':'') . "P<$page>$page_ext" : '');\r
+    }\r
+}\r
+\r
+=item $link-E<gt>markup($string)\r
+\r
+Set/retrieve the textual value of the link. This string contains special\r
+markers C<PE<lt>E<gt>> and C<QE<lt>E<gt>> that should be expanded by the\r
+translator's interior sequence expansion engine to the\r
+formatter-specific code to highlight/activate the hyperlink. The details\r
+have to be implemented in the translator.\r
+\r
+=cut\r
+\r
+#' retrieve/set markuped text\r
+sub markup {\r
+    return (@_ > 1) ? ($_[0]->{_markup} = $_[1]) : $_[0]->{_markup};\r
+}\r
+\r
+=item $link-E<gt>text()\r
+\r
+This method returns the textual representation of the hyperlink as above,\r
+but without markers (read only). Depending on the link type this is one of\r
+the following alternatives (the + and * denote the portions of the text\r
+that are marked up):\r
+\r
+  +perl+                    L<perl>\r
+  *$|* in +perlvar+         L<perlvar/$|>\r
+  *OPTIONS* in +perldoc+    L<perldoc/"OPTIONS">\r
+  *DESCRIPTION*             L<"DESCRIPTION">\r
+\r
+=cut\r
+\r
+# The complete link's text\r
+sub text {\r
+    return $_[0]->{_text};\r
+}\r
+\r
+=item $link-E<gt>warning()\r
+\r
+After parsing, this method returns any warnings encountered during the\r
+parsing process.\r
+\r
+=cut\r
+\r
+# Set/retrieve warnings\r
+sub warning {\r
+    my $self = shift;\r
+    if(@_) {\r
+        push(@{$self->{_warnings}}, @_);\r
+        return @_;\r
+    }\r
+    return @{$self->{_warnings}};\r
+}\r
+\r
+=item $link-E<gt>file()\r
+\r
+=item $link-E<gt>line()\r
+\r
+Just simple slots for storing information about the line and the file\r
+the link was encountered in. Has to be filled in manually.\r
+\r
+=cut\r
+\r
+# The line in the file the link appears\r
+sub line {\r
+    return (@_ > 1) ? ($_[0]->{-line} = $_[1]) : $_[0]->{-line};\r
+}\r
+\r
+# The POD file name the link appears in\r
+sub file {\r
+    return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};\r
+}\r
+\r
+=item $link-E<gt>page()\r
+\r
+This method sets or returns the POD page this link points to.\r
+\r
+=cut\r
+\r
+# The POD page the link appears on\r
+sub page {\r
+    if (@_ > 1) {\r
+        $_[0]->{-page} = $_[1];\r
+        $_[0]->_construct_text();\r
+    }\r
+    return $_[0]->{-page};\r
+}\r
+\r
+=item $link-E<gt>node()\r
+\r
+As above, but the destination node text of the link.\r
+\r
+=cut\r
+\r
+# The link destination\r
+sub node {\r
+    if (@_ > 1) {\r
+        $_[0]->{-node} = $_[1];\r
+        $_[0]->_construct_text();\r
+    }\r
+    return $_[0]->{-node};\r
+}\r
+\r
+=item $link-E<gt>alttext()\r
+\r
+Sets or returns an alternative text specified in the link.\r
+\r
+=cut\r
+\r
+# Potential alternative text\r
+sub alttext {\r
+    if (@_ > 1) {\r
+        $_[0]->{-alttext} = $_[1];\r
+        $_[0]->_construct_text();\r
+    }\r
+    return $_[0]->{-alttext};\r
+}\r
+\r
+=item $link-E<gt>type()\r
+\r
+The node type, either C<section> or C<item>. As an unofficial type,\r
+there is also C<hyperlink>, derived from e.g. C<LE<lt>http://perl.comE<gt>>\r
+\r
+=cut\r
+\r
+# The type: item or headn\r
+sub type {\r
+    return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};\r
+}\r
+\r
+=item $link-E<gt>link()\r
+\r
+Returns the link as contents of C<LE<lt>E<gt>>. Reciprocal to B<parse()>.\r
+\r
+=back\r
+\r
+=cut\r
+\r
+# The link itself\r
+sub link {\r
+    my $self = shift;\r
+    my $link = $self->page() || '';\r
+    if($self->node()) {\r
+        my $node = $self->node();\r
+        $node =~ s/\|/E<verbar>/g;\r
+        $node =~ s{/}{E<sol>}g;\r
+        if($self->type() eq 'section') {\r
+            $link .= ($link ? '/' : '') . '"' . $node . '"';\r
+        }\r
+        elsif($self->type() eq 'hyperlink') {\r
+            $link = $self->node();\r
+        }\r
+        else { # item\r
+            $link .= '/' . $node;\r
+        }\r
+    }\r
+    if($self->alttext()) {\r
+        my $text = $self->alttext();\r
+        $text =~ s/\|/E<verbar>/g;\r
+        $text =~ s{/}{E<sol>}g;\r
+        $link = "$text|$link";\r
+    }\r
+    return $link;\r
+}\r
+\r
+sub _invalid_link {\r
+    my ($msg) = @_;\r
+    # this sets @_\r
+    #eval { die "$msg\n" };\r
+    #chomp $@;\r
+    $@ = $msg; # this seems to work, too!\r
+    return;\r
+}\r
+\r
+#-----------------------------------------------------------------------------\r
+# Pod::Cache\r
+#\r
+# class to hold POD page details\r
+#-----------------------------------------------------------------------------\r
+\r
+package Pod::Cache;\r
+\r
+=head2 Pod::Cache\r
+\r
+B<Pod::Cache> holds information about a set of POD documents,\r
+especially the nodes for hyperlinks.\r
+The following methods are available:\r
+\r
+=over 4\r
+\r
+=item Pod::Cache-E<gt>new()\r
+\r
+Create a new cache object. This object can hold an arbitrary number of\r
+POD documents of class Pod::Cache::Item.\r
+\r
+=cut\r
+\r
+sub new {\r
+    my $this = shift;\r
+    my $class = ref($this) || $this;\r
+    my $self = [];\r
+    bless $self, $class;\r
+    return $self;\r
+}\r
+\r
+=item $cache-E<gt>item()\r
+\r
+Add a new item to the cache. Without arguments, this method returns a\r
+list of all cache elements.\r
+\r
+=cut\r
+\r
+sub item {\r
+    my ($self,%param) = @_;\r
+    if(%param) {\r
+        my $item = Pod::Cache::Item->new(%param);\r
+        push(@$self, $item);\r
+        return $item;\r
+    }\r
+    else {\r
+        return @{$self};\r
+    }\r
+}\r
+\r
+=item $cache-E<gt>find_page($name)\r
+\r
+Look for a POD document named C<$name> in the cache. Returns the\r
+reference to the corresponding Pod::Cache::Item object or undef if\r
+not found.\r
+\r
+=back\r
+\r
+=cut\r
+\r
+sub find_page {\r
+    my ($self,$page) = @_;\r
+    foreach(@$self) {\r
+        if($_->page() eq $page) {\r
+            return $_;\r
+        }\r
+    }\r
+    return;\r
+}\r
+\r
+package Pod::Cache::Item;\r
+\r
+=head2 Pod::Cache::Item\r
+\r
+B<Pod::Cache::Item> holds information about individual POD documents,\r
+that can be grouped in a Pod::Cache object.\r
+It is intended to hold information about the hyperlink nodes of POD\r
+documents.\r
+The following methods are available:\r
+\r
+=over 4\r
+\r
+=item Pod::Cache::Item-E<gt>new()\r
+\r
+Create a new object.\r
+\r
+=cut\r
+\r
+sub new {\r
+    my $this = shift;\r
+    my $class = ref($this) || $this;\r
+    my %params = @_;\r
+    my $self = {%params};\r
+    bless $self, $class;\r
+    $self->initialize();\r
+    return $self;\r
+}\r
+\r
+sub initialize {\r
+    my $self = shift;\r
+    $self->{-nodes} = [] unless(defined $self->{-nodes});\r
+}\r
+\r
+=item $cacheitem-E<gt>page()\r
+\r
+Set/retrieve the POD document name (e.g. "Pod::Parser").\r
+\r
+=cut\r
+\r
+# The POD page\r
+sub page {\r
+   return (@_ > 1) ? ($_[0]->{-page} = $_[1]) : $_[0]->{-page};\r
+}\r
+\r
+=item $cacheitem-E<gt>description()\r
+\r
+Set/retrieve the POD short description as found in the C<=head1 NAME>\r
+section.\r
+\r
+=cut\r
+\r
+# The POD description, taken out of NAME if present\r
+sub description {\r
+   return (@_ > 1) ? ($_[0]->{-description} = $_[1]) : $_[0]->{-description};\r
+}\r
+\r
+=item $cacheitem-E<gt>path()\r
+\r
+Set/retrieve the POD file storage path.\r
+\r
+=cut\r
+\r
+# The file path\r
+sub path {\r
+   return (@_ > 1) ? ($_[0]->{-path} = $_[1]) : $_[0]->{-path};\r
+}\r
+\r
+=item $cacheitem-E<gt>file()\r
+\r
+Set/retrieve the POD file name.\r
+\r
+=cut\r
+\r
+# The POD file name\r
+sub file {\r
+   return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};\r
+}\r
+\r
+=item $cacheitem-E<gt>nodes()\r
+\r
+Add a node (or a list of nodes) to the document's node list. Note that\r
+the order is kept, i.e. start with the first node and end with the last.\r
+If no argument is given, the current list of nodes is returned in the\r
+same order the nodes have been added.\r
+A node can be any scalar, but usually is a pair of node string and\r
+unique id for the C<find_node> method to work correctly.\r
+\r
+=cut\r
+\r
+# The POD nodes\r
+sub nodes {\r
+    my ($self,@nodes) = @_;\r
+    if(@nodes) {\r
+        push(@{$self->{-nodes}}, @nodes);\r
+        return @nodes;\r
+    }\r
+    else {\r
+        return @{$self->{-nodes}};\r
+    }\r
+}\r
+\r
+=item $cacheitem-E<gt>find_node($name)\r
+\r
+Look for a node or index entry named C<$name> in the object.\r
+Returns the unique id of the node (i.e. the second element of the array\r
+stored in the node array) or undef if not found.\r
+\r
+=cut\r
+\r
+sub find_node {\r
+    my ($self,$node) = @_;\r
+    my @search;\r
+    push(@search, @{$self->{-nodes}}) if($self->{-nodes});\r
+    push(@search, @{$self->{-idx}}) if($self->{-idx});\r
+    foreach(@search) {\r
+        if($_->[0] eq $node) {\r
+            return $_->[1]; # id\r
+        }\r
+    }\r
+    return;\r
+}\r
+\r
+=item $cacheitem-E<gt>idx()\r
+\r
+Add an index entry (or a list of them) to the document's index list. Note that\r
+the order is kept, i.e. start with the first node and end with the last.\r
+If no argument is given, the current list of index entries is returned in the\r
+same order the entries have been added.\r
+An index entry can be any scalar, but usually is a pair of string and\r
+unique id.\r
+\r
+=back\r
+\r
+=cut\r
+\r
+# The POD index entries\r
+sub idx {\r
+    my ($self,@idx) = @_;\r
+    if(@idx) {\r
+        push(@{$self->{-idx}}, @idx);\r
+        return @idx;\r
+    }\r
+    else {\r
+        return @{$self->{-idx}};\r
+    }\r
+}\r
+\r
+=head1 AUTHOR\r
+\r
+Please report bugs using L<http://rt.cpan.org>.\r
+\r
+Marek Rouchal E<lt>marekr@cpan.orgE<gt>, borrowing\r
+a lot of things from L<pod2man> and L<pod2roff> as well as other POD\r
+processing tools by Tom Christiansen, Brad Appleton and Russ Allbery.\r
+\r
+B<Pod::ParseUtils> is part of the L<Pod::Parser> distribution.\r
+\r
+=head1 SEE ALSO\r
+\r
+L<pod2man>, L<pod2roff>, L<Pod::Parser>, L<Pod::Checker>,\r
+L<pod2html>\r
+\r
+=cut\r
+\r
+1;\r
index 9a6acd6..4b4fecf 100644 (file)
-#############################################################################
-# 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.51';  ## 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 y