add Pod-Parser-1.08 (verbatim module =include tests elided owing
Gurusamy Sarathy [Tue, 23 Mar 1999 21:38:03 +0000 (21:38 +0000)]
to size and better maintainability)

p4raw-id: //depot/perl@3129

42 files changed:
AUTHORS
MAINTAIN
MANIFEST
installperl
lib/Pod/Checker.pm [new file with mode: 0644]
lib/Pod/InputObjects.pm [new file with mode: 0644]
lib/Pod/Parser.pm [new file with mode: 0644]
lib/Pod/PlainText.pm [new file with mode: 0644]
lib/Pod/Select.pm [new file with mode: 0644]
lib/Pod/Usage.pm [new file with mode: 0644]
pod/Makefile
pod/pod2usage.PL [new file with mode: 0644]
pod/podchecker.PL [new file with mode: 0644]
pod/podselect.PL [new file with mode: 0644]
t/pod/emptycmd.t [new file with mode: 0755]
t/pod/emptycmd.xr [new file with mode: 0644]
t/pod/for.t [new file with mode: 0755]
t/pod/for.xr [new file with mode: 0644]
t/pod/headings.t [new file with mode: 0755]
t/pod/headings.xr [new file with mode: 0644]
t/pod/include.t [new file with mode: 0755]
t/pod/include.xr [new file with mode: 0644]
t/pod/included.t [new file with mode: 0755]
t/pod/included.xr [new file with mode: 0644]
t/pod/lref.t [new file with mode: 0755]
t/pod/lref.xr [new file with mode: 0644]
t/pod/nested_items.t [new file with mode: 0755]
t/pod/nested_items.xr [new file with mode: 0644]
t/pod/nested_seqs.t [new file with mode: 0755]
t/pod/nested_seqs.xr [new file with mode: 0644]
t/pod/oneline_cmds.t [new file with mode: 0755]
t/pod/oneline_cmds.xr [new file with mode: 0644]
t/pod/poderrs.t [new file with mode: 0755]
t/pod/poderrs.xr [new file with mode: 0644]
t/pod/special_seqs.t [new file with mode: 0755]
t/pod/special_seqs.xr [new file with mode: 0644]
t/pod/testcmp.pl [new file with mode: 0644]
t/pod/testp2pt.pl [new file with mode: 0644]
t/pod/testpchk.pl [new file with mode: 0644]
win32/Makefile
win32/makefile.mk
win32/pod.mak

diff --git a/AUTHORS b/AUTHORS
index b2883b9..ca931cd 100644 (file)
--- a/AUTHORS
+++ b/AUTHORS
@@ -6,6 +6,7 @@
 
 alan.burlison  Alan Burlison           Alan.Burlison@UK.Sun.com
 allen          Norton T. Allen         allen@huarp.harvard.edu
+bradapp                Brad Appleton           bradapp@enteract.com
 cbail          Charles Bailey          bailey@newman.upenn.edu
 dgris          Daniel Grisinger        dgris@dimensional.com
 dmulholl       Daniel Yacob            dmulholl@cs.indiana.edu
index 51c77e1..c7b0d13 100644 (file)
--- a/MAINTAIN
+++ b/MAINTAIN
@@ -427,9 +427,15 @@ lib/Net/hostent.pm         tchrist
 lib/Net/netent.pm              tchrist
 lib/Net/protoent.pm            tchrist
 lib/Net/servent.pm             tchrist
+lib/Pod/Checker.pm             bradapp
 lib/Pod/Functions.pm   
 lib/Pod/Html.pm                        tchrist
+lib/Pod/InputObjects.pm                bradapp
+lib/Pod/Parser.pm              bradapp
+lib/Pod/PlainText.pm           bradapp
+lib/Pod/Select.pm              bradapp
 lib/Pod/Text.pm                        tchrist
+lib/Pod/Usage.pm               bradapp
 lib/Search/Dict.pm     
 lib/SelectSaver.pm     
 lib/SelfLoader.pm      
@@ -549,6 +555,9 @@ perly.fixer
 perly.h        
 perly.y        
 plan9/*                                plan9
+pod/pod2usage.PL               bradapp
+pod/podchecker.PL              bradapp
+pod/podselect.PL               bradapp
 pod/*                          doc
 pod/buildtoc   
 pod/checkpods.PL       
@@ -809,6 +818,7 @@ t/op/unshift.t
 t/op/vec.t     
 t/op/wantarray.t       
 t/op/write.t   
+t/pod/*                                bradapp
 t/pragma/constant.t    
 t/pragma/locale.t              locale
 t/pragma/overload.t            ilya
index 8aa2490..62c9ccc 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -581,9 +581,15 @@ lib/Net/hostent.pm By-name interface to Perl's builtin gethost*
 lib/Net/netent.pm      By-name interface to Perl's builtin getnet*
 lib/Net/protoent.pm    By-name interface to Perl's builtin getproto*
 lib/Net/servent.pm     By-name interface to Perl's builtin getserv*
+lib/Pod/Checker.pm     Pod-Parser - check POD documents for syntax errors
 lib/Pod/Functions.pm   used by pod/splitpod
 lib/Pod/Html.pm                Convert POD data to HTML
+lib/Pod/InputObjects.pm        Pod-Parser - define objects for input streams
+lib/Pod/Parser.pm      Pod-Parser - define base class for parsing POD
+lib/Pod/PlainText.pm   Pod-Parser - convert POD data to formatted ASCII text
+lib/Pod/Select.pm      Pod-Parser - select portions of POD docs
 lib/Pod/Text.pm                Convert POD data to formatted ASCII text
+lib/Pod/Usage.pm       Pod-Parser - print usage messages
 lib/Search/Dict.pm     Perform binary search on dictionaries
 lib/SelectSaver.pm     Enforce proper select scoping
 lib/SelfLoader.pm      Load functions only on demand
@@ -992,6 +998,9 @@ pod/pod2html.PL             Precursor for translator to turn pod into HTML
 pod/pod2latex.PL       Precursor for translator to turn pod into LaTeX
 pod/pod2man.PL         Precursor for translator to turn pod into manpage
 pod/pod2text.PL                Precursor for translator to turn pod into text
+pod/pod2usage.PL       Pod-Parser - print usage messages from POD docs
+pod/podchecker.PL      Pod-Parser - Pod::Checker::podchecker() CLI
+pod/podselect.PL       Pod-Parser - Pod::Select::podselect() CLI
 pod/roffitall          troff the whole man page set
 pod/rofftoc            Generate a table of contents in troff format
 pod/splitman           Splits perlfunc into multiple man pages
@@ -1225,6 +1234,31 @@ t/op/unshift.t           See if unshift works
 t/op/vec.t             See if vectors work
 t/op/wantarray.t       See if wantarray works
 t/op/write.t           See if write works
+t/pod/emptycmd.t       Test empty pod directives
+t/pod/emptycmd.xr      Expected results for emptycmd.t
+t/pod/for.t            Test =for directive
+t/pod/for.xr           Expected results for for.t
+t/pod/headings.t       Test =head directives
+t/pod/headings.xr      Expected results for headings.t
+t/pod/include.t                Test =include directive
+t/pod/include.xr       Expected results for include.t
+t/pod/included.t       Test =include directive
+t/pod/included.xr      Expected results for included.t
+t/pod/lref.t           Test L<...> sequences
+t/pod/lref.xr          Expected results for lref.t
+t/pod/nested_items.t   Test nested =items
+t/pod/nested_items.xr  Expected results for nested_items.t
+t/pod/nested_seqs.t    Test nested interior sequences
+t/pod/nested_seqs.xr   Expected results for nested_seqs.t
+t/pod/oneline_cmds.t   Test single paragraph ==cmds
+t/pod/oneline_cmds.xr  Expected results for oneline_cmds.t
+t/pod/poderrs.t                Test POD errors
+t/pod/poderrs.xr       Expected results for emptycmd.t
+t/pod/special_seqs.t   Test "special" interior sequences
+t/pod/special_seqs.xr  Expected results for emptycmd.t
+t/pod/testcmp.pl       Module to compare output against expected results
+t/pod/testp2pt.pl      Module to test Pod::PlainText for a given file
+t/pod/testpchk.pl      Module to test Pod::Checker for a given file
 t/pragma/constant.t    See if compile-time constants work
 t/pragma/locale.t      See if locale support (i18n and l10n) works
 t/pragma/overload.t    See if operator overloading works
index 006a550..ac2cf82 100755 (executable)
@@ -50,7 +50,8 @@ umask 022 unless $Is_VMS;
 my @scripts = qw(utils/c2ph utils/h2ph utils/h2xs utils/perlbug utils/perldoc
                utils/pl2pm utils/splain utils/perlcc
                x2p/s2p x2p/find2perl 
-               pod/pod2man pod/pod2html pod/pod2latex pod/pod2text);
+               pod/pod2man pod/pod2html pod/pod2latex pod/pod2text
+               pod/pod2usage pod/podchecker pod/podselect);
 
 if ($scr_ext) { @scripts = map { "$_$scr_ext" } @scripts; }
 
diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm
new file mode 100644 (file)
index 0000000..1eaab71
--- /dev/null
@@ -0,0 +1,224 @@
+#############################################################################
+# Pod/Checker.pm -- check pod documents for syntax errors
+#
+# Based on Tom Christiansen's Pod::Text::pod2text() function
+# (with modifications).
+#
+# Copyright (C) 1994-1999 Tom Christiansen. 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 vars qw($VERSION);
+$VERSION = 1.08;   ## Current version of this package
+require  5.004;    ## requires this Perl version or later
+
+=head1 NAME
+
+Pod::Checker, podchecker() - check pod documents for syntax errors
+
+=head1 SYNOPSIS
+
+  use Pod::Checker;
+
+  $syntax_okay = podchecker($filepath, $outputpath);
+
+=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
+indcating 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>.
+
+
+=head1 DESCRIPTION
+
+B<podchecker> will perform syntax checking of Perl5 POD format documentation.
+
+I<NOTE THAT THIS MODULE IS CURRENTLY IN THE INITIAL DEVELOPMENT STAGE!>
+As of this writing, all it does is check for unknown '=xxxx' commands,
+unknown 'X<...>' interior-sequences, and unterminated interior sequences.
+
+It is hoped that curious/ambitious user will help flesh out and add the
+additional features they wish to see in B<Pod::Checker> and B<podchecker>.
+
+=head1 EXAMPLES
+
+I<[T.B.D.]>
+
+=head1 AUTHOR
+
+Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version)
+
+Based on code for B<Pod::Text::pod2text()> written by
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
+
+=cut
+
+#############################################################################
+
+use strict;
+#use diagnostics;
+use Carp;
+use Exporter;
+use Pod::Parser;
+
+use vars qw(@ISA @EXPORT);
+@ISA = qw(Pod::Parser);
+@EXPORT = qw(&podchecker);
+
+use vars qw(%VALID_COMMANDS %VALID_SEQUENCES);
+
+my %VALID_COMMANDS = (
+    'pod'    =>  1,
+    'cut'    =>  1,
+    'head1'  =>  1,
+    'head2'  =>  1,
+    'over'   =>  1,
+    'back'   =>  1,
+    'item'   =>  1,
+    'for'    =>  1,
+    'begin'  =>  1,
+    'end'    =>  1,
+);
+
+my %VALID_SEQUENCES = (
+    'I'  =>  1,
+    'B'  =>  1,
+    'S'  =>  1,
+    'C'  =>  1,
+    'L'  =>  1,
+    'F'  =>  1,
+    'X'  =>  1,
+    'Z'  =>  1,
+    'E'  =>  1,
+);
+
+##---------------------------------------------------------------------------
+
+##---------------------------------
+## Function definitions begin here
+##---------------------------------
+
+sub podchecker( $ ; $ ) {
+    my ($infile, $outfile) = @_;
+    local $_;
+
+    ## Set defaults
+    $infile  ||= \*STDIN;
+    $outfile ||= \*STDERR;
+
+    ## Now create a pod checker
+    my $checker = new Pod::Checker();
+
+    ## 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
+##-------------------------------
+
+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->num_errors(0);
+}
+
+sub num_errors {
+   return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS};
+}
+
+sub end_pod {
+   ## Print the number of errors found
+   my $self   = shift;
+   my $infile = $self->input_file();
+   my $out_fh = $self->output_handle();
+
+   my $num_errors = $self->num_errors();
+   if ($num_errors > 0) {
+      printf $out_fh ("$infile has $num_errors pod syntax %s.\n",
+                      ($num_errors == 1) ? "error" : "errors");
+   }
+   else {
+      print $out_fh "$infile pod syntax OK.\n";
+   }
+}
+
+sub command { 
+    my ($self, $command, $paragraph, $line_num, $pod_para) = @_;
+    my ($file, $line) = $pod_para->file_line;
+    my $out_fh  = $self->output_handle();
+    ## Check the command syntax
+    if (! $VALID_COMMANDS{$command}) {
+       ++($self->{_NUM_ERRORS});
+       _invalid_cmd($out_fh, $command, $paragraph, $file, $line);
+    }
+    else {
+       ## check syntax of particular command
+    }
+    ## Check the interior sequences in the command-text
+    my $expansion = $self->interpolate($paragraph, $line_num);
+}
+
+sub verbatim { 
+    ## Nothing to check
+    ## my ($self, $paragraph, $line_num, $pod_para) = @_;
+}
+
+sub textblock { 
+    my ($self, $paragraph, $line_num, $pod_para) = @_;
+    my $out_fh  = $self->output_handle();
+    ## Check the interior sequences in the text (set $SIG{__WARN__} to
+    ## send parse_text warnings about untermnated sequences to $out_fh)
+    local  $SIG{__WARN__} = sub {
+                                ++($self->{_NUM_ERRORS});
+                                print $out_fh @_
+                            };
+    my $expansion = $self->interpolate($paragraph, $line_num);
+}
+
+sub interior_sequence { 
+    my ($self, $seq_cmd, $seq_arg, $pod_seq) = @_;
+    my ($file, $line) = $pod_seq->file_line;
+    my $out_fh  = $self->output_handle();
+    ## Check the sequence syntax
+    if (! $VALID_SEQUENCES{$seq_cmd}) {
+       ++($self->{_NUM_ERRORS});
+       _invalid_seq($out_fh, $seq_cmd, $seq_arg, $file, $line);
+    }
+    else {
+       ## check syntax of the particular sequence
+    }
+}
+
+sub _invalid_cmd {
+    my ($fh, $cmd, $text, $file, $line) = @_;
+    print $fh "*** ERROR: Unknown command \"$cmd\""
+            . " at line $line of file $file\n";
+}
+
+sub _invalid_seq {
+    my ($fh, $cmd, $text, $file, $line) = @_;
+    print $fh "*** ERROR: Unknown interior-sequence \"$cmd\""
+            . " at line $line of file $file\n";
+}
+
diff --git a/lib/Pod/InputObjects.pm b/lib/Pod/InputObjects.pm
new file mode 100644 (file)
index 0000000..9bbc6cf
--- /dev/null
@@ -0,0 +1,903 @@
+#############################################################################
+# Pod/InputObjects.pm -- package which defines objects for input streams
+# and paragraphs and commands when parsing POD docs.
+#
+# Copyright (C) 1996-1999 Tom Christiansen. 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 vars qw($VERSION);
+$VERSION = 1.08;   ## Current version of this package
+require  5.004;    ## requires this Perl version or later
+
+#############################################################################
+
+=head1 NAME
+
+Pod::InputObjects - objects representing POD input paragraphs, commands, etc.
+
+=head1 SYNOPSIS
+
+    use Pod::InputObjects;
+
+=head1 REQUIRES
+
+perl5.004, Carp
+
+=head1 EXPORTS
+
+Nothing.
+
+=head1 DESCRIPTION
+
+This module defines some basic input objects used by B<Pod::Parser> when
+reading and parsing POD text from an input source. The following objects
+are defined:
+
+=over 4
+
+=begin __PRIVATE__
+
+=item B<Pod::InputSource>
+
+An object corresponding to a source of POD input text. It is mostly a
+wrapper around a filehandle or C<IO::Handle>-type object (or anything
+that implements the C<getline()> method) which keeps track of some
+additional information relevant to the parsing of PODs.
+
+=end __PRIVATE__
+
+=item 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 B<Pod::InteriorSequence>
+
+An object corresponding to an interior sequence command from the POD
+input text (see L<perlpod>).
+
+=item 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 they 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
+
+#############################################################################
+
+use strict;
+#use diagnostics;
+#use Carp;
+
+#############################################################################
+
+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 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) ? $_[0] : 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 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 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 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 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 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 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 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 an array 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 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);
+
+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.
+
+=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       => (@_ == 1) ? $_[0] : undef,
+          -file       => '<unknown-file>',
+          -line       => 0,
+          -ldelim     => '<',
+          -rdelim     => '>',
+          -ptree => new Pod::ParseTree(),
+          @_
+    };
+
+    ## Bless ourselves into the desired class and perform any initialization
+    bless $self, $class;
+    return $self;
+}
+
+##---------------------------------------------------------------------------
+
+=head2 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 ref $_;
+      if ($_->isa('Pod::InteriorSequence') or $_->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 ($_ and ref $_ and $_->isa('Pod::InteriorSequence'));
+      $_->_unset_child2parent_links();
+   }
+}
+
+##---------------------------------------------------------------------------
+
+=head2 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 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 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 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 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 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 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 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 an array 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 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 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 mist 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 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 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 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 $_;
+      if (@ptree  and  !(ref $ptree[0])  and  !(ref $_)) {
+         $ptree[0] = $_ . $ptree[0];
+      }
+      else {
+         unshift @ptree, $_;
+      }
+   }
+}
+
+##---------------------------------------------------------------------------
+
+=head2 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;
+   for (@_) {
+      next  unless $_;
+      if (@ptree  and  !(ref $ptree[-1])  and  !(ref $_)) {
+         $ptree[-1] .= $_;
+      }
+      else {
+         push @ptree, $_;
+      }
+   }
+}
+
+=head2 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 ($_ and ref $_ and $_->isa('Pod::InteriorSequence'));
+       $_->_unset_child2parent_links();
+   }
+}
+
+sub _set_child2parent_links {
+    ## nothing to do, Pod::ParseTrees cant have parent pointers
+}
+
+=head2 B<DESTROY()>
+
+This method performs any necessary cleanup for the parse-tree.
+If you override this method then it is B<imperative>
+that you invoke the parent method from within your own method,
+otherwise I<parse-tree storage will not be reclaimed upon destruction!>
+
+=cut
+
+sub DESTROY {
+   ## We need to get rid of all child->parent pointers throughout the
+   ## tree so their reference counts will go to zero and they can be
+   ## garbage-collected
+   _unset_child2parent_links(@_);
+}
+
+#############################################################################
+
+=head1 SEE ALSO
+
+See L<Pod::Parser>, L<Pod::Select>, and L<Pod::Callbacks>.
+
+=head1 AUTHOR
+
+Brad Appleton E<lt>bradapp@enteract.comE<gt>
+
+=cut
+
+1;
diff --git a/lib/Pod/Parser.pm b/lib/Pod/Parser.pm
new file mode 100644 (file)
index 0000000..b81b080
--- /dev/null
@@ -0,0 +1,1393 @@
+#############################################################################
+# Pod/Parser.pm -- package which defines a base class for parsing POD docs.
+#
+# Based on Tom Christiansen's Pod::Text module
+# (with extensive modifications).
+#
+# Copyright (C) 1996-1999 Tom Christiansen. 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 vars qw($VERSION);
+$VERSION = 1.08;   ## Current version of this package
+require  5.004;    ## 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 = 'B');
+        return "`$seq_argument'"     if ($seq_command = 'C');
+        return "_${seq_argument}_'"  if ($seq_command = '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.004, Pod::InputObjects, Exporter, FileHandle, 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 preprocesssing 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 intepret the commands and translate the result.
+
+=cut
+
+#############################################################################
+
+use vars qw(@ISA);
+use strict;
+#use diagnostics;
+use Pod::InputObjects;
+use Carp;
+use FileHandle;
+use Exporter;
+@ISA = qw(Exporter);
+
+## These "variables" are used as local "glob aliases" for performance
+use vars qw(%myData @input_stack);
+
+#############################################################################
+
+=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 = shift;
+    my $class = ref($this) || $this;
+    ## Any remaining arguments are treated as initial values for the
+    ## hash that is used to represent this object.
+    my %params = @_;
+    my $self = { %params };
+    ## Bless ourselves into the desired class and perform any initialization
+    bless $self, $class;
+    $self->initialize();
+    return $self;
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<initialize()>
+
+            $parser->initialize();
+
+This method performs any necessary object initialization. It takes no
+arguments (other than the object instance of course, which is typically
+copied to a local variable named C<$self>). If subclasses override this
+method then they I<must> be sure to invoke C<$self-E<gt>SUPER::initialize()>.
+
+=cut
+
+sub initialize {
+    #my $self = shift;
+    #return;
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<begin_pod()>
+
+            $parser->begin_pod();
+
+This method is invoked at the beginning of processing for each POD
+document that is encountered in the input. Subclasses should override
+this method to perform any per-document initialization.
+
+=cut
+
+sub begin_pod {
+    #my $self = shift;
+    #return;
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<begin_input()>
+
+            $parser->begin_input();
+
+This method is invoked by B<parse_from_filehandle()> immediately I<before>
+processing input from a filehandle. The base class implementation does
+nothing, however, subclasses may override it to perform any per-file
+initializations.
+
+Note that if multiple files are parsed for a single POD document
+(perhaps the result of some future C<=include> directive) this method
+is invoked for every file that is parsed. If you wish to perform certain
+initializations once per document, then you should use B<begin_pod()>.
+
+=cut
+
+sub begin_input {
+    #my $self = shift;
+    #return;
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<end_input()>
+
+            $parser->end_input();
+
+This method is invoked by B<parse_from_filehandle()> immediately I<after>
+processing input from a filehandle. The base class implementation does
+nothing, however, subclasses may override it to perform any per-file
+cleanup actions.
+
+Please note that if multiple files are parsed for a single POD document
+(perhaps the result of some kind of C<=include> directive) this method
+is invoked for every file that is parsed. If you wish to perform certain
+cleanup actions once per document, then you should use B<end_pod()>.
+
+=cut
+
+sub end_input {
+    #my $self = shift;
+    #return;
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<end_pod()>
+
+            $parser->end_pod();
+
+This method is invoked at the end of processing for each POD document
+that is encountered in the input. Subclasses should override this method
+to perform any per-document finalization.
+
+=cut
+
+sub end_pod {
+    #my $self = shift;
+    #return;
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<preprocess_line()>
+
+          $textline = $parser->preprocess_line($text, $line_num);
+
+This method should be overridden by subclasses that wish to perform
+any kind of preprocessing for each I<line> of input (I<before> it has
+been determined whether or not it is part of a POD paragraph). The
+parameter C<$text> is the input line; and the parameter C<$line_num> is
+the line number of the corresponding text line.
+
+The value returned should correspond to the new text to use in its
+place.  If the empty string or an undefined value is returned then no
+further processing will be performed for this line.
+
+Please note that the B<preprocess_line()> method is invoked I<before>
+the B<preprocess_paragraph()> method. After all (possibly preprocessed)
+lines in a paragraph have been assembled together and it has been
+determined that the paragraph is part of the POD documentation from one
+of the selected sections, then B<preprocess_paragraph()> is invoked.
+
+The base class implementation of this method returns the given text.
+
+=cut
+
+sub preprocess_line {
+    my ($self, $text, $line_num) = @_;
+    return  $text;
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<preprocess_paragraph()>
+
+            $textblock = $parser->preprocess_paragraph($text, $line_num);
+
+This method should be overridden by subclasses that wish to perform any
+kind of preprocessing for each block (paragraph) of POD documentation
+that appears in the input stream. The parameter C<$text> is the POD
+paragraph from the input file; and the parameter C<$line_num> is the
+line number for the beginning of the corresponding paragraph.
+
+The value returned should correspond to the new text to use in its
+place If the empty string is returned or an undefined value is
+returned, then the given C<$text> is ignored (not processed).
+
+This method is invoked after gathering up all thelines in a paragraph
+but before trying to further parse or interpret them. After
+B<preprocess_paragraph()> returns, the current cutting state (which
+is returned by C<$self-E<gt>cutting()>) is examined. If it evaluates
+to false then input text (including the given C<$text>) is cut (not
+processed) until the next POD directive is encountered.
+
+Please note that the B<preprocess_line()> method is invoked I<before>
+the B<preprocess_paragraph()> method. After all (possibly preprocessed)
+lines in a paragraph have been assembled together and it has been
+determined that the paragraph is part of the POD documentation from one
+of the selected sections, then B<preprocess_paragraph()> is invoked.
+
+The base class implementation of this method returns the given text.
+
+=cut
+
+sub preprocess_paragraph {
+    my ($self, $text, $line_num) = @_;
+    return  $text;
+}
+
+#############################################################################
+
+=head1 METHODS FOR PARSING AND PROCESSING
+
+B<Pod::Parser> provides several methods to process input text. These
+methods typically won't need to be overridden, but subclasses may want
+to invoke them to exploit their functionality.
+
+=cut
+
+##---------------------------------------------------------------------------
+
+=head1 B<parse_text()>
+
+            $ptree1 = $parser->parse_text($text, $line_num);
+            $ptree2 = $parser->parse_text({%opts}, $text, $line_num);
+            $ptree3 = $parser->parse_text(\%opts, $text, $line_num);
+
+This method is useful if you need to perform your own interpolation 
+of interior sequences and can't rely upon B<interpolate> to expand
+them in simple bottom-up order order.
+
+The parameter C<$text> is a string or block of text to be parsed
+for interior sequences; and the parameter C<$line_num> is the
+line number curresponding to the beginning of C<$text>.
+
+B<parse_text()> will parse the given text into a parse-tree of "nodes."
+and interior-sequences.  Each "node" in the parse tree is either a
+text-string, or a B<Pod::InteriorSequence>.  The result returned is a
+parse-tree of type B<Pod::ParseTree>. Please see L<Pod::InputObjects>
+for more information about B<Pod::InteriorSequence> and B<Pod::ParseTree>.
+
+If desired, an optional hash-ref may be specified as the first argument
+to customize certain aspects of the parse-tree that is created and
+returned. The set of recognized option keywords are:
+
+=over 3
+
+=item B<-expand_seq> =E<gt> I<code-ref>|I<method-name>
+
+Normally, the parse-tree returned by B<parse_text()> will contain an
+unexpanded C<Pod::InteriorSequence> object for each interior-sequence
+encountered. Specifying B<-expand_seq> tells B<parse_text()> to "expand"
+every interior-sequence it sees by invoking the referenced function
+(or named method of the parser object) and using the return value as the
+expanded result.
+
+If a subroutine reference was given, it is invoked as:
+
+  &$code_ref( $parser, $sequence )
+
+and if a method-name was given, it is invoked as:
+
+  $parser->method_name( $sequence )
+
+where C<$parser> is a reference to the parser object, and C<$sequence>
+is a reference to the interior-sequence object.
+[I<NOTE>: If the B<interior_sequence()> method is specified, then it is
+invoked according to the interface specified in L<"interior_sequence()">].
+
+=item B<-expand_ptree> =E<gt> I<code-ref>|I<method-name>
+
+Rather than returning a C<Pod::ParseTree>, pass the parse-tree as an
+argument to the referenced subroutine (or named method of the parser
+object) and return the result instead of the parse-tree object.
+
+If a subroutine reference was given, it is invoked as:
+
+  &$code_ref( $parser, $ptree )
+
+and if a method-name was given, it is invoked as:
+
+  $parser->method_name( $ptree )
+
+where C<$parser> is a reference to the parser object, and C<$ptree>
+is a reference to the parse-tree object.
+
+=back
+
+=cut
+
+## This global regex is used to see if the text before a '>' inside
+## an interior sequence looks like '-' or '=', but not '--' or '=='
+use vars qw( $ARROW_RE );
+$ARROW_RE = join('', qw{ (?: [^=]+= | [^-]+- )$ });  
+
+sub parse_text {
+    my $self = shift;
+    local $_ = '';
+
+    ## Get options and set any defaults
+    my %opts = (ref $_[0]) ? %{ shift() } : ();
+    my $expand_seq   = $opts{'-expand_seq'}   || undef;
+    my $expand_ptree = $opts{'-expand_ptree'} || undef;
+
+    my $text = shift;
+    my $line = shift;
+    my $file = $self->input_file();
+    my ($cmd, $prev)  = ('', '');
+
+    ## Convert method calls into closures, for our convenience
+    my $xseq_sub   = $expand_seq;
+    my $xptree_sub = $expand_ptree;
+    if ($expand_seq eq 'interior_sequence') {
+        ## If 'interior_sequence' is the method to use, we have to pass
+        ## more than just the sequence object, we also need to pass the
+        ## sequence name and text.
+        $xseq_sub = sub {
+            my ($self, $iseq) = @_;
+            my $args = join("", $iseq->parse_tree->children);
+            return  $self->interior_sequence($iseq->name, $args, $iseq);
+        };
+    }
+    ref $xseq_sub    or  $xseq_sub   = sub { shift()->$expand_seq(@_) };
+    ref $xptree_sub  or  $xptree_sub = sub { shift()->$expand_ptree(@_) };
+    
+    ## Keep track of the "current" interior sequence, and maintain a stack
+    ## of "in progress" sequences.
+    ##
+    ## NOTE that we push our own "accumulator" at the very beginning of the
+    ## stack. It's really a parse-tree, not a sequence; but it implements
+    ## the methods we need so we can use it to gather-up all the sequences
+    ## and strings we parse. Thus, by the end of our parsing, it should be
+    ## the only thing left on our stack and all we have to do is return it!
+    ##
+    my $seq       = Pod::ParseTree->new();
+    my @seq_stack = ($seq);
+
+    ## Iterate over all sequence starts/stops, newlines, & text
+    ## (NOTE: split with capturing parens keeps the delimiters)
+    $_ = $text;
+    for ( split /([A-Z]<|>|\n)/ ) {
+        ## Keep track of line count
+        ++$line  if ($_ eq "\n");
+        ## Look for the beginning of a sequence
+        if ( /^([A-Z])(<)$/ ) {
+            ## Push a new sequence onto the stack on of those "in-progress"
+            $seq = Pod::InteriorSequence->new(
+                       -name   => ($cmd = $1),
+                       -ldelim => $2,     -rdelim => '',
+                       -file   => $file,  -line   => $line
+                   );
+            (@seq_stack > 1)  and  $seq->nested($seq_stack[-1]);
+            push @seq_stack, $seq;
+        }
+        ## Look for sequence ending (preclude '->' and '=>' inside C<...>)
+        elsif ( (@seq_stack > 1)  and
+                /^>$/ and ($cmd ne 'C' or $prev !~ /$ARROW_RE/o) )
+        {
+            ## End of current sequence, record terminating delimiter
+            $seq->rdelim($_);
+            ## Pop it off the stack of "in progress" sequences
+            pop @seq_stack;
+            ## Append result to its parent in current parse tree
+            $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) : $seq);
+            ## Remember the current cmd-name
+            $cmd = (@seq_stack > 1) ? $seq_stack[-1]->name : '';
+        }
+        else {
+            ## In the middle of a sequence, append this text to it
+            $seq->append($_)  if $_;
+        }
+        ## Remember the "current" sequence and the previously seen token
+        ($seq, $prev) = ( $seq_stack[-1], $_ );
+    }
+
+    ## Handle unterminated sequences
+    while (@seq_stack > 1) {
+       ($cmd, $file, $line) = ($seq->name, $seq->file_line);
+       pop @seq_stack;
+       warn "** Unterminated $cmd<...> at $file line $line\n";
+       $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) : $seq);
+       $seq = $seq_stack[-1];
+    }
+
+    ## Return the resulting parse-tree
+    my $ptree = (pop @seq_stack)->parse_tree;
+    return  $expand_ptree ? &$xptree_sub($self, $ptree) : $ptree;
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<interpolate()>
+
+            $textblock = $parser->interpolate($text, $line_num);
+
+This method translates all text (including any embedded interior sequences)
+in the given text string C<$text> and returns the interpolated result. The
+parameter C<$line_num> is the line number corresponding to the beginning
+of C<$text>.
+
+B<interpolate()> merely invokes a private method to recursively expand
+nested interior sequences in bottom-up order (innermost sequences are
+expanded first). If there is a need to expand nested sequences in
+some alternate order, use B<parse_text> instead.
+
+=cut
+
+sub interpolate {
+    my($self, $text, $line_num) = @_;
+    my %parse_opts = ( -expand_seq => 'interior_sequence' );
+    my $ptree = $self->parse_text( \%parse_opts, $text, $line_num );
+    return  join "", $ptree->children();
+}
+
+##---------------------------------------------------------------------------
+
+=begin __PRIVATE__
+
+=head1 B<parse_paragraph()>
+
+            $parser->parse_paragraph($text, $line_num);
+
+This method takes the text of a POD paragraph to be processed, along
+with its corresponding line number, and invokes the appropriate method
+(one of B<command()>, B<verbatim()>, or B<textblock()>).
+
+This method does I<not> usually need to be overridden by subclasses.
+
+=end __PRIVATE__
+
+=cut
+
+sub parse_paragraph {
+    my ($self, $text, $line_num) = @_;
+    local *myData = $self;  ## an alias to avoid deref-ing overhead
+    local $_;
+
+    ## This is the end of a non-empty paragraph
+    ## Ignore up until next POD directive if we are cutting
+    if ($myData{_CUTTING}) {
+       return  unless ($text =~ /^={1,2}\S/);
+       $myData{_CUTTING} = 0;
+    }
+
+    ## Now we know this is block of text in a POD section!
+
+    ##-----------------------------------------------------------------
+    ## This is a hook (hack ;-) for Pod::Select to do its thing without
+    ## having to override methods, but also without Pod::Parser assuming
+    ## $self is an instance of Pod::Select (if the _SELECTED_SECTIONS
+    ## field exists then we assume there is an is_selected() method for
+    ## us to invoke (calling $self->can('is_selected') could verify this
+    ## but that is more overhead than I want to incur)
+    ##-----------------------------------------------------------------
+
+    ## Ignore this block if it isnt in one of the selected sections
+    if (exists $myData{_SELECTED_SECTIONS}) {
+        $self->is_selected($text)  or  return ($myData{_CUTTING} = 1);
+    }
+
+    ## Perform any desired preprocessing and re-check the "cutting" state
+    $text = $self->preprocess_paragraph($text, $line_num);
+    return 1  unless ((defined $text) and (length $text));
+    return 1  if ($myData{_CUTTING});
+
+    ## Look for one of the three types of paragraphs
+    my ($pfx, $cmd, $arg, $sep) = ('', '', '', '');
+    my $pod_para = undef;
+    if ($text =~ /^(={1,2})(?=\S)/) {
+        ## Looks like a command paragraph. Capture the command prefix used
+        ## ("=" or "=="), as well as the command-name, its paragraph text,
+        ## and whatever sequence of characters was used to separate them
+        $pfx = $1;
+        $_ = substr($text, length $pfx);
+        $sep = /(\s+)(?=\S)/ ? $1 : '';
+        ($cmd, $text) = split(" ", $_, 2);
+        ## If this is a "cut" directive then we dont need to do anything
+        ## except return to "cutting" mode.
+        if ($cmd eq 'cut') {
+           $myData{_CUTTING} = 1;
+           return;
+        }
+    }
+    ## Save the attributes indicating how the command was specified.
+    $pod_para = new Pod::Paragraph(
+          -name      => $cmd,
+          -text      => $text,
+          -prefix    => $pfx,
+          -separator => $sep,
+          -file      => $myData{_INFILE},
+          -line      => $line_num
+    );
+    # ## Invoke appropriate callbacks
+    # if (exists $myData{_CALLBACKS}) {
+    #    ## Look through the callback list, invoke callbacks,
+    #    ## then see if we need to do the default actions
+    #    ## (invoke_callbacks will return true if we do).
+    #    return  1  unless $self->invoke_callbacks($cmd, $text, $line_num, $pod_para);
+    # }
+    if (length $cmd) {
+        ## A command paragraph
+        $self->command($cmd, $text, $line_num, $pod_para);
+    }
+    elsif ($text =~ /^\s+/) {
+        ## Indented text - must be a verbatim paragraph
+        $self->verbatim($text, $line_num, $pod_para);
+    }
+    else {
+        ## Looks like an ordinary block of text
+        $self->textblock($text, $line_num, $pod_para);
+    }
+    return  1;
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<parse_from_filehandle()>
+
+            $parser->parse_from_filehandle($in_fh,$out_fh);
+
+This method takes an input filehandle (which is assumed to already be
+opened for reading) and reads the entire input stream looking for blocks
+(paragraphs) of POD documentation to be processed. If no first argument
+is given the default input filehandle C<STDIN> is used.
+
+The C<$in_fh> parameter may be any object that provides a B<getline()>
+method to retrieve a single line of input text (hence, an appropriate
+wrapper object could be used to parse PODs from a single string or an
+array of strings).
+
+Using C<$in_fh-E<gt>getline()>, input is read line-by-line and assembled
+into paragraphs or "blocks" (which are separated by lines containing
+nothing but whitespace). For each block of POD documentation
+encountered it will invoke a method to parse the given paragraph.
+
+If a second argument is given then it should correspond to a filehandle where
+output should be sent (otherwise the default output filehandle is
+C<STDOUT> if no output filehandle is currently in use).
+
+B<NOTE:> For performance reasons, this method caches the input stream at
+the top of the stack in a local variable. Any attempts by clients to
+change the stack contents during processing when in the midst executing
+of this method I<will not affect> the input stream used by the current
+invocation of this method.
+
+This method does I<not> usually need to be overridden by subclasses.
+
+=cut
+
+sub parse_from_filehandle {
+    my $self = shift;
+    my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
+    my ($in_fh, $out_fh) = @_;
+    local $_;
+
+    ## Put this stream at the top of the stack and do beginning-of-input
+    ## processing. NOTE that $in_fh might be reset during this process.
+    my $topstream = $self->_push_input_stream($in_fh, $out_fh);
+    (exists $opts{-cutting})  and  $self->cutting( $opts{-cutting} );
+
+    ## Initialize line/paragraph
+    my ($textline, $paragraph) = ('', '');
+    my ($nlines, $plines) = (0, 0);
+
+    ## Use <$fh> instead of $fh->getline where possible (for speed)
+    $_ = ref $in_fh;
+    my $tied_fh = (/^(?:GLOB|FileHandle|IO::\w+)$/  or  tied $in_fh);
+
+    ## Read paragraphs line-by-line
+    while (defined ($textline = $tied_fh ? <$in_fh> : $in_fh->getline)) {
+        $textline = $self->preprocess_line($textline, ++$nlines);
+        next  unless ((defined $textline)  &&  (length $textline));
+        $_ = $paragraph;  ## save previous contents
+
+        if ((! length $paragraph) && ($textline =~ /^==/)) {
+            ## '==' denotes a one-line command paragraph
+            $paragraph = $textline;
+            $plines    = 1;
+            $textline  = '';
+        } else {
+            ## Append this line to the current paragraph
+            $paragraph .= $textline;
+            ++$plines;
+        }
+
+        ## See of this line is blank and ends the current paragraph.
+        ## If it isnt, then keep iterating until it is.
+        next unless (($textline =~ /^\s*$/) && (length $paragraph));
+
+        ## Now process the paragraph
+        parse_paragraph($self, $paragraph, ($nlines - $plines) + 1);
+        $paragraph = '';
+        $plines = 0;
+    }
+    ## Dont forget about the last paragraph in the file
+    if (length $paragraph) {
+       parse_paragraph($self, $paragraph, ($nlines - $plines) + 1)
+    }
+
+    ## Now pop the input stream off the top of the input stack.
+    $self->_pop_input_stream();
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<parse_from_file()>
+
+            $parser->parse_from_file($filename,$outfile);
+
+This method takes a filename and does the following:
+
+=over 2
+
+=item *
+
+opens the input and output files for reading
+(creating the appropriate filehandles)
+
+=item *
+
+invokes the B<parse_from_filehandle()> method passing it the
+corresponding input and output filehandles.
+
+=item *
+
+closes the input and output files.
+
+=back
+
+If the special input filename "-" or "<&STDIN" is given then the STDIN
+filehandle is used for input (and no open or close is performed). If no
+input filename is specified then "-" is implied.
+
+If a second argument is given then it should be the name of the desired
+output file. If the special output filename "-" or ">&STDOUT" is given
+then the STDOUT filehandle is used for output (and no open or close is
+performed). If the special output filename ">&STDERR" is given then the
+STDERR filehandle is used for output (and no open or close is
+performed). If no output filehandle is currently in use and no output
+filename is specified, then "-" is implied.
+
+This method does I<not> usually need to be overridden by subclasses.
+
+=cut
+
+sub parse_from_file {
+    my $self = shift;
+    my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
+    my ($infile, $outfile) = @_;
+    my ($in_fh,  $out_fh)  = (undef, undef);
+    my ($close_input, $close_output) = (0, 0);
+    local *myData = $self;
+    local $_;
+
+    ## Is $infile a filename or a (possibly implied) filehandle
+    $infile  = '-'  unless ((defined $infile)  && (length $infile));
+    if (($infile  eq '-') || ($infile =~ /^<&(STDIN|0)$/i)) {
+        ## Not a filename, just a string implying STDIN
+        $myData{_INFILE} = "<standard input>";
+        $in_fh = \*STDIN;
+    }
+    elsif (ref $infile) {
+        ## Must be a filehandle-ref (or else assume its a ref to an object
+        ## that supports the common IO read operations).
+        $myData{_INFILE} = ${$infile};
+        $in_fh = $infile;
+    }
+    else {
+        ## We have a filename, open it for reading
+        $myData{_INFILE} = $infile;
+        $in_fh = FileHandle->new("< $infile")  or
+             croak "Can't open $infile for reading: $!\n";
+        $close_input = 1;
+    }
+
+    ## NOTE: we need to be *very* careful when "defaulting" the output
+    ## file. We only want to use a default if this is the beginning of
+    ## the entire document (but *not* if this is an included file). We
+    ## determine this by seeing if the input stream stack has been set-up
+    ## already
+    ## 
+    unless ((defined $outfile) && (length $outfile)) {
+        (defined $myData{_TOP_STREAM}) && ($out_fh  = $myData{_OUTPUT})
+                                       || ($outfile = '-');
+    }
+    ## Is $outfile a filename or a (possibly implied) filehandle
+    if ((defined $outfile) && (length $outfile)) {
+        if (($outfile  eq '-') || ($outfile =~ /^>&?(?:STDOUT|1)$/i)) {
+            ## Not a filename, just a string implying STDOUT
+            $myData{_OUTFILE} = "<standard output>";
+            $out_fh  = \*STDOUT;
+        }
+        elsif ($outfile =~ /^>&(STDERR|2)$/i) {
+            ## Not a filename, just a string implying STDERR
+            $myData{_OUTFILE} = "<standard error>";
+            $out_fh  = \*STDERR;
+        }
+        elsif (ref $outfile) {
+            ## Must be a filehandle-ref (or else assume its a ref to an
+            ## object that supports the common IO write operations).
+            $myData{_OUTFILE} = ${$outfile};;
+            $out_fh = $outfile;
+        }
+        else {
+            ## We have a filename, open it for writing
+            $myData{_OUTFILE} = $outfile;
+            $out_fh = FileHandle->new("> $outfile")  or
+                 croak "Can't open $outfile for writing: $!\n";
+            $close_output = 1;
+        }
+    }
+
+    ## Whew! That was a lot of work to set up reasonably/robust behavior
+    ## in the case of a non-filename for reading and writing. Now we just
+    ## have to parse the input and close the handles when we're finished.
+    $self->parse_from_filehandle(\%opts, $in_fh, $out_fh);
+
+    $close_input  and 
+        close($in_fh) || croak "Can't close $infile after reading: $!\n";
+    $close_output  and
+        close($out_fh) || croak "Can't close $outfile after writing: $!\n";
+}
+
+#############################################################################
+
+=head1 ACCESSOR METHODS
+
+Clients of B<Pod::Parser> should use the following methods to access
+instance data fields:
+
+=cut
+
+##---------------------------------------------------------------------------
+
+=head1 B<cutting()>
+
+            $boolean = $parser->cutting();
+
+Returns the current C<cutting> state: a boolean-valued scalar which
+evaluates to true if text from the input file is currently being "cut"
+(meaning it is I<not> considered part of the POD document).
+
+            $parser->cutting($boolean);
+
+Sets the current C<cutting> state to the given value and returns the
+result.
+
+=cut
+
+sub cutting {
+   return (@_ > 1) ? ($_[0]->{_CUTTING} = $_[1]) : $_[0]->{_CUTTING};
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<output_file()>
+
+            $fname = $parser->output_file();
+
+Returns the name of the output file being written.
+
+=cut
+
+sub output_file {
+   return $_[0]->{_OUTFILE};
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<output_handle()>
+
+            $fhandle = $parser->output_handle();
+
+Returns the output filehandle object.
+
+=cut
+
+sub output_handle {
+   return $_[0]->{_OUTPUT};
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<input_file()>
+
+            $fname = $parser->input_file();
+
+Returns the name of the input file being read.
+
+=cut
+
+sub input_file {
+   return $_[0]->{_INFILE};
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<input_handle()>
+
+            $fhandle = $parser->input_handle();
+
+Returns the current input filehandle object.
+
+=cut
+
+sub input_handle {
+   return $_[0]->{_INPUT};
+}
+
+##---------------------------------------------------------------------------
+
+=begin __PRIVATE__
+
+=head1 B<input_streams()>
+
+            $listref = $parser->input_streams();
+
+Returns a reference to an array which corresponds to the stack of all
+the input streams that are currently in the middle of being parsed.
+
+While parsing an input stream, it is possible to invoke
+B<parse_from_file()> or B<parse_from_filehandle()> to parse a new input
+stream and then return to parsing the previous input stream. Each input
+stream to be parsed is pushed onto the end of this input stack
+before any of its input is read. The input stream that is currently
+being parsed is always at the end (or top) of the input stack. When an
+input stream has been exhausted, it is popped off the end of the
+input stack.
+
+Each element on this input stack is a reference to C<Pod::InputSource>
+object. Please see L<Pod::InputObjects> for more details.
+
+This method might be invoked when printing diagnostic messages, for example,
+to obtain the name and line number of the all input files that are currently
+being processed.
+
+=end __PRIVATE__
+
+=cut
+
+sub input_streams {
+   return $_[0]->{_INPUT_STREAMS};
+}
+
+##---------------------------------------------------------------------------
+
+=begin __PRIVATE__
+
+=head1 B<top_stream()>
+
+            $hashref = $parser->top_stream();
+
+Returns a reference to the hash-table that represents the element
+that is currently at the top (end) of the input stream stack
+(see L<"input_streams()">). The return value will be the C<undef>
+if the input stack is empty.
+
+This method might be used when printing diagnostic messages, for example,
+to obtain the name and line number of the current input file.
+
+=end __PRIVATE__
+
+=cut
+
+sub top_stream {
+   return $_[0]->{_TOP_STREAM} || undef;
+}
+
+#############################################################################
+
+=head1 PRIVATE METHODS AND DATA
+
+B<Pod::Parser> makes use of several internal methods and data fields
+which clients should not need to see or use. For the sake of avoiding
+name collisions for client data and methods, these methods and fields
+are briefly discussed here. Determined hackers may obtain further
+information about them by reading the B<Pod::Parser> source code.
+
+Private data fields are stored in the hash-object whose reference is
+returned by the B<new()> constructor for this class. The names of all
+private methods and data-fields used by B<Pod::Parser> begin with a
+prefix of "_" and match the regular expression C</^_\w+$/>.
+
+=cut
+
+##---------------------------------------------------------------------------
+
+=begin _PRIVATE_
+
+=head1 B<_push_input_stream()>
+
+            $hashref = $parser->_push_input_stream($in_fh,$out_fh);
+
+This method will push the given input stream on the input stack and
+perform any necessary beginning-of-document or beginning-of-file
+processing. The argument C<$in_fh> is the input stream filehandle to
+push, and C<$out_fh> is the corresponding output filehandle to use (if
+it is not given or is undefined, then the current output stream is used,
+which defaults to standard output if it doesnt exist yet).
+
+The value returned will be reference to the hash-table that represents
+the new top of the input stream stack. I<Please Note> that it is
+possible for this method to use default values for the input and output
+file handles. If this happens, you will need to look at the C<INPUT>
+and C<OUTPUT> instance data members to determine their new values.
+
+=end _PRIVATE_
+
+=cut
+
+sub _push_input_stream {
+    my ($self, $in_fh, $out_fh) = @_;
+    local *myData = $self;
+
+    ## Initialize stuff for the entire document if this is *not*
+    ## an included file.
+    ##
+    ## NOTE: we need to be *very* careful when "defaulting" the output
+    ## filehandle. We only want to use a default value if this is the
+    ## beginning of the entire document (but *not* if this is an included
+    ## file).
+    unless (defined  $myData{_TOP_STREAM}) {
+        $out_fh  = \*STDOUT  unless (defined $out_fh);
+        $myData{_CUTTING}       = 1;   ## current "cutting" state
+        $myData{_INPUT_STREAMS} = [];  ## stack of all input streams
+    }
+
+    ## Initialize input indicators
+    $myData{_OUTFILE} = '(unknown)'  unless (defined  $myData{_OUTFILE});
+    $myData{_OUTPUT}  = $out_fh      if (defined  $out_fh);
+    $in_fh            = \*STDIN      unless (defined  $in_fh);
+    $myData{_INFILE}  = '(unknown)'  unless (defined  $myData{_INFILE});
+    $myData{_INPUT}   = $in_fh;
+    my $input_top     = $myData{_TOP_STREAM}
+                      = new Pod::InputSource(
+                            -name        => $myData{_INFILE},
+                            -handle      => $in_fh,
+                            -was_cutting => $myData{_CUTTING}
+                        );
+    local *input_stack = $myData{_INPUT_STREAMS};
+    push(@input_stack, $input_top);
+
+    ## Perform beginning-of-document and/or beginning-of-input processing
+    $self->begin_pod()  if (@input_stack == 1);
+    $self->begin_input();
+
+    return  $input_top;
+}
+
+##---------------------------------------------------------------------------
+
+=begin _PRIVATE_
+
+=head1 B<_pop_input_stream()>
+
+            $hashref = $parser->_pop_input_stream();
+
+This takes no arguments. It will perform any necessary end-of-file or
+end-of-document processing and then pop the current input stream from
+the top of the input stack.
+
+The value returned will be reference to the hash-table that represents
+the new top of the input stream stack.
+
+=end _PRIVATE_
+
+=cut
+
+sub _pop_input_stream {
+    my ($self) = @_;
+    local *myData = $self;
+    local *input_stack = $myData{_INPUT_STREAMS};
+
+    ## Perform end-of-input and/or end-of-document processing
+    $self->end_input()  if (@input_stack > 0);
+    $self->end_pod()    if (@input_stack == 1);
+
+    ## Restore cutting state to whatever it was before we started
+    ## parsing this file.
+    my $old_top = pop(@input_stack);
+    $myData{_CUTTING} = $old_top->was_cutting();
+
+    ## Dont forget to reset the input indicators
+    my $input_top = undef;
+    if (@input_stack > 0) {
+       $input_top = $myData{_TOP_STREAM} = $input_stack[-1];
+       $myData{_INFILE}  = $input_top->name();
+       $myData{_INPUT}   = $input_top->handle();
+    } else {
+       delete $myData{_TOP_STREAM};
+       delete $myData{_INPUT_STREAMS};
+    }
+
+    return  $input_top;
+}
+
+#############################################################################
+
+=head1 SEE ALSO
+
+L<Pod::InputObjects>, L<Pod::Select>
+
+B<Pod::InputObjects> defines POD input objects corresponding to
+command paragraphs, parse-trees, and interior-sequences.
+
+B<Pod::Select> is a subclass of B<Pod::Parser> which provides the ability
+to selectively include and/or exclude sections of a POD document from being
+translated based upon the current heading, subheading, subsubheading, etc.
+
+=for __PRIVATE__
+B<Pod::Callbacks> is a subclass of B<Pod::Parser> which gives its users
+the ability the employ I<callback functions> instead of, or in addition
+to, overriding methods of the base class.
+
+=for __PRIVATE__
+B<Pod::Select> and B<Pod::Callbacks> do not override any
+methods nor do they define any new methods with the same name. Because
+of this, they may I<both> be used (in combination) as a base class of
+the same subclass in order to combine their functionality without
+causing any namespace clashes due to multiple inheritance.
+
+=head1 AUTHOR
+
+Brad Appleton E<lt>bradapp@enteract.comE<gt>
+
+Based on code for B<Pod::Text> written by
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
+
+=cut
+
+1;
diff --git a/lib/Pod/PlainText.pm b/lib/Pod/PlainText.pm
new file mode 100644 (file)
index 0000000..e629fc8
--- /dev/null
@@ -0,0 +1,650 @@
+#############################################################################
+# Pod/PlainText.pm -- convert POD data to formatted ASCII text
+#
+# Derived from Tom Christiansen's Pod::PlainText module
+# (with extensive modifications).
+#
+# Copyright (C) 1994-1999 Tom Christiansen. 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::PlainText;
+
+use vars qw($VERSION);
+$VERSION = 1.08;   ## Current version of this package
+require  5.004;    ## requires this Perl version or later
+
+=head1 NAME
+
+pod2plaintext - function to convert POD data to formatted ASCII text
+
+Pod::PlainText - a class for converting POD data to formatted ASCII text
+
+=head1 SYNOPSIS
+
+    use Pod::PlainText;
+    pod2plaintext("perlfunc.pod");
+
+or
+
+    use Pod::PlainText;
+    package MyParser;
+    @ISA = qw(Pod::PlainText);
+
+    sub new {
+       ## constructor code ...
+    }
+
+    ## implementation of appropriate subclass methods ...
+
+    package main;
+    $parser = new MyParser;
+    @ARGV = ('-')  unless (@ARGV > 0);
+    for (@ARGV) {
+       $parser->parse_from_file($_);
+    }
+
+=head1 REQUIRES
+
+perl5.004, Pod::Select, Term::Cap, Exporter, Carp
+
+=head1 EXPORTS
+
+pod2plaintext()
+
+=head1 DESCRIPTION
+
+Pod::PlainText is a module that can convert documentation in the POD
+format (such as can be found throughout the Perl distribution) into
+formatted ASCII.  Termcap is optionally supported for
+boldface/underline, and can be enabled via C<$Pod::PlainText::termcap=1>.
+If termcap has not been enabled, then backspaces will be used to
+simulate bold and underlined text.
+
+A separate F<pod2plaintext> program is included that is primarily a wrapper
+for C<Pod::PlainText::pod2plaintext()>.
+
+The single function C<pod2plaintext()> can take one or two arguments. The first
+should be the name of a file to read the pod from, or "<&STDIN" to read from
+STDIN. A second argument, if provided, should be a filehandle glob where
+output should be sent.
+
+=head1 SEE ALSO
+
+L<Pod::Parser>.
+
+=head1 AUTHOR
+
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
+
+Modified to derive from B<Pod::Parser> by
+Brad Appleton E<lt>bradapp@enteract.comE<gt>
+
+=cut
+
+#############################################################################
+
+use strict;
+#use diagnostics;
+use Carp;
+use Exporter;
+use Pod::Select;
+use Term::Cap;
+use vars qw(@ISA @EXPORT %HTML_Escapes);
+
+@ISA = qw(Exporter Pod::Select);
+@EXPORT = qw(&pod2plaintext);
+
+%HTML_Escapes = (
+    'amp'       =>        '&',        #   ampersand
+    'lt'        =>        '<',        #   left chevron, less-than
+    'gt'        =>        '>',        #   right chevron, greater-than
+    'quot'      =>        '"',        #   double quote
+
+    "Aacute"    =>        "\xC1",     #   capital A, acute accent
+    "aacute"    =>        "\xE1",     #   small a, acute accent
+    "Acirc"     =>        "\xC2",     #   capital A, circumflex accent
+    "acirc"     =>        "\xE2",     #   small a, circumflex accent
+    "AElig"     =>        "\xC6",     #   capital AE diphthong (ligature)
+    "aelig"     =>        "\xE6",     #   small ae diphthong (ligature)
+    "Agrave"    =>        "\xC0",     #   capital A, grave accent
+    "agrave"    =>        "\xE0",     #   small a, grave accent
+    "Aring"     =>        "\xC5",     #   capital A, ring
+    "aring"     =>        "\xE5",     #   small a, ring
+    "Atilde"    =>        "\xC3",     #   capital A, tilde
+    "atilde"    =>        "\xE3",     #   small a, tilde
+    "Auml"      =>        "\xC4",     #   capital A, dieresis or umlaut mark
+    "auml"      =>        "\xE4",     #   small a, dieresis or umlaut mark
+    "Ccedil"    =>        "\xC7",     #   capital C, cedilla
+    "ccedil"    =>        "\xE7",     #   small c, cedilla
+    "Eacute"    =>        "\xC9",     #   capital E, acute accent
+    "eacute"    =>        "\xE9",     #   small e, acute accent
+    "Ecirc"     =>        "\xCA",     #   capital E, circumflex accent
+    "ecirc"     =>        "\xEA",     #   small e, circumflex accent
+    "Egrave"    =>        "\xC8",     #   capital E, grave accent
+    "egrave"    =>        "\xE8",     #   small e, grave accent
+    "ETH"       =>        "\xD0",     #   capital Eth, Icelandic
+    "eth"       =>        "\xF0",     #   small eth, Icelandic
+    "Euml"      =>        "\xCB",     #   capital E, dieresis or umlaut mark
+    "euml"      =>        "\xEB",     #   small e, dieresis or umlaut mark
+    "Iacute"    =>        "\xCD",     #   capital I, acute accent
+    "iacute"    =>        "\xED",     #   small i, acute accent
+    "Icirc"     =>        "\xCE",     #   capital I, circumflex accent
+    "icirc"     =>        "\xEE",     #   small i, circumflex accent
+    "Igrave"    =>        "\xCD",     #   capital I, grave accent
+    "igrave"    =>        "\xED",     #   small i, grave accent
+    "Iuml"      =>        "\xCF",     #   capital I, dieresis or umlaut mark
+    "iuml"      =>        "\xEF",     #   small i, dieresis or umlaut mark
+    "Ntilde"    =>        "\xD1",     #   capital N, tilde
+    "ntilde"    =>        "\xF1",     #   small n, tilde
+    "Oacute"    =>        "\xD3",     #   capital O, acute accent
+    "oacute"    =>        "\xF3",     #   small o, acute accent
+    "Ocirc"     =>        "\xD4",     #   capital O, circumflex accent
+    "ocirc"     =>        "\xF4",     #   small o, circumflex accent
+    "Ograve"    =>        "\xD2",     #   capital O, grave accent
+    "ograve"    =>        "\xF2",     #   small o, grave accent
+    "Oslash"    =>        "\xD8",     #   capital O, slash
+    "oslash"    =>        "\xF8",     #   small o, slash
+    "Otilde"    =>        "\xD5",     #   capital O, tilde
+    "otilde"    =>        "\xF5",     #   small o, tilde
+    "Ouml"      =>        "\xD6",     #   capital O, dieresis or umlaut mark
+    "ouml"      =>        "\xF6",     #   small o, dieresis or umlaut mark
+    "szlig"     =>        "\xDF",     #   small sharp s, German (sz ligature)
+    "THORN"     =>        "\xDE",     #   capital THORN, Icelandic
+    "thorn"     =>        "\xFE",     #   small thorn, Icelandic
+    "Uacute"    =>        "\xDA",     #   capital U, acute accent
+    "uacute"    =>        "\xFA",     #   small u, acute accent
+    "Ucirc"     =>        "\xDB",     #   capital U, circumflex accent
+    "ucirc"     =>        "\xFB",     #   small u, circumflex accent
+    "Ugrave"    =>        "\xD9",     #   capital U, grave accent
+    "ugrave"    =>        "\xF9",     #   small u, grave accent
+    "Uuml"      =>        "\xDC",     #   capital U, dieresis or umlaut mark
+    "uuml"      =>        "\xFC",     #   small u, dieresis or umlaut mark
+    "Yacute"    =>        "\xDD",     #   capital Y, acute accent
+    "yacute"    =>        "\xFD",     #   small y, acute accent
+    "yuml"      =>        "\xFF",     #   small y, dieresis or umlaut mark
+
+    "lchevron"  =>        "\xAB",     #   left chevron (double less than)
+    "rchevron"  =>        "\xBB",     #   right chevron (double greater than)
+);
+
+##---------------------------------
+## Function definitions begin here
+##---------------------------------
+
+   ## Try to find #columns for the tty
+my %NotUnix = map {($_ => 1)} qw(MacOS MSWin32 VMS MVS);
+sub get_screen {
+    ((defined $ENV{TERMCAP}) && ($ENV{TERMCAP} =~ /co#(\d+)/)[0])
+    or ((defined $ENV{COLUMNS}) && $ENV{COLUMNS})
+    or (!$NotUnix{$^O} && (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0])
+    or 72;
+
+}
+
+sub pod2plaintext {
+    my ($infile, $outfile) = @_;
+    local $_;
+    my $text_parser = new Pod::PlainText;
+    $text_parser->parse_from_file($infile, $outfile);
+}
+
+##-------------------------------
+## Method definitions begin here
+##-------------------------------
+
+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->SUPER::initialize();
+    return;
+}
+
+sub makespace {
+    my $self = shift;
+    my $out_fh = $self->output_handle();
+    if ($self->{NEEDSPACE}) {
+        print $out_fh "\n";
+        $self->{NEEDSPACE} = 0;
+    }
+}
+
+sub bold {
+    my $self = shift;
+    my $line = shift;
+    my $map  = $self->{FONTMAP};
+    return $line if $self->{USE_FORMAT};
+    if ($self->{TERMCAP}) {
+        $line = "$map->{BOLD}$line$map->{NORM}";
+    }
+    else {
+        $line =~ s/(.)/$1\b$1/g;
+    }
+#   $line = "$map->{BOLD}$line$map->{NORM}" if $self->{ANSIFY};
+    return $line;
+}
+
+sub italic {
+    my $self = shift;
+    my $line = shift;
+    my $map  = $self->{FONTMAP};
+    return $line if $self->{USE_FORMAT};
+    if ($self->{TERMCAP}) {
+        $line = "$map->{UNDL}$line$map->{NORM}";
+    }
+    else {
+        $line =~ s/(.)/$1\b_/g;
+    }
+#   $line = "$map->{UNDL}$line$map->{NORM}" if $self->{ANSIFY};
+    return $line;
+}
+
+# Fill a paragraph including underlined and overstricken chars.
+# It's not perfect for words longer than the margin, and it's probably
+# slow, but it works.
+sub fill {
+    my $self = shift;
+    local $_ = shift;
+    my $par = "";
+    my $indent_space = " " x $self->{INDENT};
+    my $marg = $self->{SCREEN} - $self->{INDENT};
+    my $line = $indent_space;
+    my $line_length;
+    foreach (split) {
+        my $word_length = length;
+        $word_length -= 2 while /\010/g;  # Subtract backspaces
+
+        if ($line_length + $word_length > $marg) {
+            $par .= $line . "\n";
+            $line= $indent_space . $_;
+            $line_length = $word_length;
+        }
+        else {
+            if ($line_length) {
+                $line_length++;
+                $line .= " ";
+            }
+            $line_length += $word_length;
+            $line .= $_;
+        }
+    }
+    $par .= "$line\n" if $line;
+    $par .= "\n";
+    return $par;
+}
+
+## Handle a pending "item" paragraph.  The paragraph (if given) is the
+## corresponding item text.  (the item tag should be in $self->{ITEM}).
+sub item {
+    my $self = shift;
+    my $cmd  = shift;
+    local $_ = shift;
+    my $line  = shift;
+    $cmd  = ''  unless (defined $cmd);
+    $_    = ''  unless (defined $_);
+    my $out_fh  = $self->output_handle();
+    return  unless (defined  $self->{ITEM});
+    my $paratag = $self->{ITEM};
+    my $prev_indent = $self->{INDENTS}->[-1] || $self->{DEF_INDENT};
+    ## reset state
+    undef $self->{ITEM};
+    #$self->rm_callbacks('*');
+
+    my $over = $self->{INDENT};
+    $over   -= $prev_indent  if ($prev_indent < $over);
+    if (length $cmd) {  # tricked - this is another command
+        $self->output($paratag, INDENT => $prev_indent);
+        $self->command($cmd, $_);
+    }
+    elsif (/^\s+/o) {  # verbatim
+        $self->output($paratag, INDENT => $prev_indent);
+        s/\s+\Z//;
+        $self->verbatim($_);
+    }
+    else {  # plain textblock
+        $_ = $self->interpolate($_, $line);
+        s/\s+\Z//;
+        if ((length $_) && (length($paratag) <= $over)) {
+            $self->IP_output($paratag, $_);
+        }
+        else {
+            $self->output($paratag, INDENT => $prev_indent);
+            $self->output($_, REFORMAT => 1);
+        }
+    }
+}
+
+sub remap_whitespace {
+    my $self  = shift;
+    local($_) = shift;
+    tr/\000-\177/\200-\377/;
+    return $_;
+}
+
+sub unmap_whitespace {
+    my $self  = shift;
+    local($_) = shift;
+    tr/\200-\377/\000-\177/;
+    return $_;
+}
+
+sub IP_output {
+    my $self  = shift;
+    my $tag   = shift;
+    local($_) = @_;
+    my $out_fh  = $self->output_handle();
+    my $tag_indent  = $self->{INDENTS}->[-1] || $self->{DEF_INDENT};
+    my $tag_cols = $self->{SCREEN} - $tag_indent;
+    my $cols = $self->{SCREEN} - $self->{INDENT};
+    $tag =~ s/\s*$//;
+    s/\s+/ /g;
+    s/^ //;
+    my $fmt_name = '_Pod_Text_IP_output_format_';
+    my $str = "format $fmt_name = \n"
+        . (" " x ($tag_indent))
+        . '@' . ('<' x ($self->{INDENT} - $tag_indent - 1))
+        . "^" .  ("<" x ($cols - 1)) . "\n"
+        . '$tag, $_'
+        . "\n~~"
+        . (" " x ($self->{INDENT} - 2))
+        . "^" .  ("<" x ($cols - 5)) . "\n"
+        . '$_' . "\n\n.\n1";
+    #warn $str; warn "tag is $tag, _ is $_";
+    {
+        ## reset format (turn off warning about redefining a format)
+        local($^W) = 0;
+        eval $str;
+        croak if ($@);
+    }
+    select((select($out_fh), $~ = $fmt_name)[0]);
+    local($:) = ($self->curr_headings(1) eq 'SYNOPSIS') ? "\n " : $: ;
+    write $out_fh;
+}
+
+sub output {
+    my $self = shift;
+    local $_ = shift;
+    $_    = ''  unless (defined $_);
+    return  unless (length $_);
+    my $out_fh = $self->output_handle();
+    my %options;
+    if (@_ > 1) {
+        ## usage was $self->output($text, NAME=>VALUE, ...);
+        %options = @_;
+    }
+    elsif (@_ == 1) {
+        if (ref $_[0]) {
+           ## usage was $self->output($text, { NAME=>VALUE, ... } );
+           %options = %{$_[0]};
+        }
+        else {
+           ## usage was $self->output($text, $number);
+           $options{"REFORMAT"} = shift;
+        }
+    }
+    $options{"INDENT"} = $self->{INDENT}  unless (defined $options{"INDENT"});
+    if ((defined $options{"REFORMAT"}) && $options{"REFORMAT"}) {
+        my $cols = $self->{SCREEN} - $options{"INDENT"};
+        s/\s+/ /g;
+        s/^ //;
+        my $fmt_name = '_Pod_Text_output_format_';
+        my $str = "format $fmt_name = \n~~"
+            . (" " x ($options{"INDENT"} - 2))
+            . "^" .  ("<" x ($cols - 5)) . "\n"
+            . '$_' . "\n\n.\n1";
+        {
+            ## reset format (turn off warning about redefining a format)
+            local($^W) = 0;
+            eval $str;
+            croak if ($@);
+        }
+        select((select($out_fh), $~ = $fmt_name)[0]);
+        local($:) = ($self->curr_headings(1) eq 'SYNOPSIS') ? "\n " : $: ;
+        write $out_fh;
+    }
+    else {
+        s/^/' ' x $options{"INDENT"}/gem;
+        s/^\s+\n$/\n/gm;
+        print $out_fh $_;
+    }
+}
+
+sub internal_lrefs {
+    my $self = shift;
+    local $_ = shift;
+    s{L</([^>]+)>}{$1}g;
+    my(@items) = split( /(?:,?\s+(?:and\s+)?)/ );
+    my $retstr = "the ";
+    my $i;
+    for ($i = 0; $i <= $#items; $i++) {
+        $retstr .= "C<$items[$i]>";
+        $retstr .= ", " if @items > 2 && $i != $#items;
+        $retstr .= " and " if $i+2 == @items;
+    }
+
+   $retstr .= " entr" . ( @items > 1  ? "ies" : "y" )
+                      .  " elsewhere in this document ";
+
+   return $retstr;
+}
+
+sub begin_pod {
+    my $self = shift;
+
+    $self->{BEGUN} = [];
+    $self->{TERMCAP} = 0;
+    #$self->{USE_FORMAT} = 1;
+
+    $self->{FONTMAP} = {
+        UNDL => "\x1b[4m",
+        INV  => "\x1b[7m",
+        BOLD => "\x1b[1m",
+        NORM => "\x1b[0m",
+    };
+    if ($self->{TERMCAP} and (! defined $self->{SETUPTERMCAP})) {
+        $self->{SETUPTERMCAP} = 1;
+        my ($term) = Tgetent Term::Cap { TERM => undef, OSPEED => 9600 };
+        $self->{FONTMAP}->{UNDL} = $term->{'_us'};
+        $self->{FONTMAP}->{INV}  = $term->{'_mr'};
+        $self->{FONTMAP}->{BOLD} = $term->{'_md'};
+        $self->{FONTMAP}->{NORM} = $term->{'_me'};
+    }
+   
+    $self->{SCREEN}     = &get_screen;
+    $self->{FANCY}      = 0;
+    $self->{DEF_INDENT} = 4;
+    $self->{INDENTS}    = [];
+    $self->{INDENT}     = $self->{DEF_INDENT};
+    $self->{NEEDSPACE}  = 0;
+}
+
+sub end_pod {
+    my $self = shift;
+    $self->item('', '', '', 0)  if (defined $self->{ITEM});
+}
+
+sub begun_excluded {
+    my $self = shift;
+    my @begun = @{ $self->{BEGUN} };
+    return (@begun > 0) ? ($begun[-1] ne 'text') : 0;
+}
+
+sub command {
+    my $self = shift;
+    my $cmd  = shift;
+    local $_ = shift;
+    my $line = shift;
+    $cmd  = ''  unless (defined $cmd);
+    $_    = ''  unless (defined $_);
+    my $out_fh  = $self->output_handle();
+
+    return  if (($cmd ne 'end') and $self->begun_excluded());
+    return  $self->item($cmd, $_, $line)  if (defined $self->{ITEM});
+    $_ = $self->interpolate($_, $line);
+    s/\s+\Z/\n/;
+
+    return  if ($cmd eq 'pod');
+    if ($cmd eq 'head1') {
+        $self->makespace();
+        print $out_fh $_;
+        # print $out_fh uc($_);
+    }
+    elsif ($cmd eq 'head2') {
+        $self->makespace();
+        # s/(\w+)/\u\L$1/g;
+        #print ' ' x $self->{DEF_INDENT}, $_;
+        # print "\xA7";
+        s/(\w)/\xA7 $1/ if $self->{FANCY};
+        print $out_fh ' ' x ($self->{DEF_INDENT}/2), $_, "\n";
+    }
+    elsif ($cmd eq 'over') {
+        /^[-+]?\d+$/  or  $_ = $self->{DEF_INDENT};
+        push(@{$self->{INDENTS}}, $self->{INDENT});
+        $self->{INDENT} += ($_ + 0);
+    }
+    elsif ($cmd eq 'back') {
+        $self->{INDENT} = pop(@{$self->{INDENTS}});
+        unless (defined $self->{INDENT}) {
+            carp "Unmatched =back\n";
+            $self->{INDENT} = $self->{DEF_INDENT};
+        }
+    }
+    elsif ($cmd eq 'begin') {
+       my ($kind) = /^(\S*)/;
+       push( @{ $self->{BEGUN} }, $kind );
+    }
+    elsif ($cmd eq 'end') {
+       pop( @{ $self->{BEGUN} } );
+    }
+    elsif ($cmd eq 'for') {
+       $self->textblock($1)  if /^text\b\s*(.*)$/s;
+    }
+    elsif ($cmd eq 'item') {
+        $self->makespace();
+        # s/\A(\s*)\*/$1\xb7/ if $self->{FANCY};
+        # s/^(\s*\*\s+)/$1 /;
+        $self->{ITEM} = $_;
+        #$self->add_callbacks('*', SUB => \&item);
+    }
+    else {
+        carp "Unrecognized directive: $cmd\n";
+    }
+}
+
+sub verbatim {
+    my $self = shift;
+    local $_ = shift;
+    my $line = shift;
+    return  if $self->begun_excluded();
+    return  $self->item('', $_, $line)  if (defined $self->{ITEM});
+    $self->output($_);
+    #$self->{NEEDSPACE} = 1;
+}
+
+sub textblock {
+    my $self  = shift;
+    my $text  = shift;
+    my $line  = shift;
+    return  if $self->begun_excluded();
+    return  $self->item('', $text, $line)  if (defined $self->{ITEM});
+    local($_) = $self->interpolate($text, $line);
+    s/\s*\Z/\n/;
+    $self->makespace();
+    $self->output($_, REFORMAT => 1);
+}
+
+sub interior_sequence {
+    my $self = shift;
+    my $cmd  = shift;
+    my $arg  = shift;
+    local($_) = $arg;
+    if ($cmd eq 'C') {
+        my ($pre, $post) = ("`", "'");
+        ($pre, $post) = ($HTML_Escapes{"lchevron"}, $HTML_Escapes{"rchevron"})
+                if ((defined $self->{FANCY}) && $self->{FANCY});
+        $_ = $pre . $_ . $post;
+    }
+    elsif ($cmd eq 'E') {
+        if (defined $HTML_Escapes{$_}) {
+            $_ = $HTML_Escapes{$_};
+        }
+        else {
+            carp "Unknown escape: E<$_>";
+            $_ = "E<$_>";
+        }
+    # }
+    # elsif ($cmd eq 'B') {
+    #     $_ = $self->bold($_);
+    }
+    elsif ($cmd eq 'I') {
+        # $_ = $self->italic($_);
+        $_ = "*" . $_ . "*";
+    }
+    elsif (($cmd eq 'X') || ($cmd eq 'Z')) {
+        $_ = '';
+    }
+    elsif ($cmd eq 'S') {
+        # Escape whitespace until we are ready to print
+        #$_ = $self->remap_whitespace($_);
+    }
+    elsif ($cmd eq 'L') {
+        s/\s+/ /g;
+        my ($text, $manpage, $sec, $ref) = ('', $_, '', '');
+        if (/\A(.*?)\|(.*)\Z/) {
+            $text = $1;
+            $manpage = $_ = $2;
+        }
+        if (/^\s*"\s*(.*)\s*"\s*$/o) {
+            ($manpage, $sec) = ('', "\"$1\"");
+        }
+        elsif (m|\s*/\s*|s) {
+            ($manpage, $sec) = split(/\s*\/\s*/, $_, 2);
+        }
+        if (! length $sec) {
+            $ref .= "the $manpage manpage"  if (length $manpage);
+        }
+        elsif ($sec =~ /^\s*"\s*(.*)\s*"\s*$/o) {
+            $ref .= "the section on \"$1\"";
+            $ref .= " in the $manpage manpage"  if (length $manpage);
+        }
+        else {
+             $ref .= "the \"$sec\" entry";
+             $ref .= (length $manpage) ? " in the $manpage manpage"
+                                       : " in this manpage"
+        }
+        $_ = $text || $ref;
+        #if ( m{^ ([a-zA-Z][^\s\/]+) (\([^\)]+\))? $}x ) {
+        #    ## LREF: a manpage(3f)
+        #    $_ = "the $1$2 manpage";
+        #}
+        #elsif ( m{^ ([^/]+) / ([:\w]+(\(\))?) $}x ) {
+        #    ## LREF: an =item on another manpage
+        #    $_ = "the \"$2\" entry in the $1 manpage";
+        #}
+        #elsif ( m{^ / ([:\w]+(\(\))?) $}x ) {
+        #    ## LREF: an =item on this manpage
+        #    $_ = $self->internal_lrefs($1);
+        #}
+        #elsif ( m{^ (?: ([a-zA-Z]\S+?) / )? "?(.*?)"? $}x ) {
+        #    ## LREF: a =head2 (head1?), maybe on a manpage, maybe right here
+        #    ## the "func" can disambiguate
+        #    $_ = ((defined $1) && $1)
+        #            ? "the section on \"$2\" in the $1 manpage"
+        #            : "the section on \"$2\"";
+        #}
+    }
+    return  $_;
+}
+
+1;
diff --git a/lib/Pod/Select.pm b/lib/Pod/Select.pm
new file mode 100644 (file)
index 0000000..96377d4
--- /dev/null
@@ -0,0 +1,748 @@
+#############################################################################
+# Pod/Select.pm -- function to select portions of POD docs
+#
+# Based on Tom Christiansen's pod2text() function
+# (with extensive modifications).
+#
+# Copyright (C) 1996-1999 Tom Christiansen. All rights reserved.
+# This file is part of "PodParser". PodParser is free software;
+# you can redistribute it and/or modify it under the same terms
+# as Perl itself.
+#############################################################################
+
+package Pod::Select;
+
+use vars qw($VERSION);
+$VERSION = 1.08;   ## Current version of this package
+require  5.004;    ## requires this Perl version or later
+
+#############################################################################
+
+=head1 NAME
+
+Pod::Select, podselect() - extract selected sections of POD from input
+
+=head1 SYNOPSIS
+
+    use Pod::Select;
+
+    ## Select all the POD sections for each file in @filelist
+    ## and print the result on standard output.
+    podselect(@filelist);
+
+    ## Same as above, but write to tmp.out
+    podselect({-output => "tmp.out"}, @filelist):
+
+    ## Select from the given filelist, only those POD sections that are
+    ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.
+    podselect({-sections => ["NAME|SYNOPSIS", "OPTIONS"]}, @filelist):
+
+    ## Select the "DESCRIPTION" section of the PODs from STDIN and write
+    ## the result to STDERR.
+    podselect({-output => ">&STDERR", -sections => ["DESCRIPTION"]}, \*STDIN);
+
+or
+
+    use Pod::Select;
+
+    ## Create a parser object for selecting POD sections from the input
+    $parser = new Pod::Select();
+
+    ## Select all the POD sections for each file in @filelist
+    ## and print the result to tmp.out.
+    $parser->parse_from_file("<&STDIN", "tmp.out");
+
+    ## Select from the given filelist, only those POD sections that are
+    ## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.
+    $parser->select("NAME|SYNOPSIS", "OPTIONS");
+    for (@filelist) { $parser->parse_from_file($_); }
+
+    ## Select the "DESCRIPTION" and "SEE ALSO" sections of the PODs from
+    ## STDIN and write the result to STDERR.
+    $parser->select("DESCRIPTION");
+    $parser->add_selection("SEE ALSO");
+    $parser->parse_from_filehandle(\*STDIN, \*STDERR);
+
+=head1 REQUIRES
+
+perl5.004, Pod::Parser, Exporter, FileHandle, Carp
+
+=head1 EXPORTS
+
+podselect()
+
+=head1 DESCRIPTION
+
+B<podselect()> is a function which will extract specified sections of
+pod documentation from an input stream. This ability is provided by the
+B<Pod::Select> module which is a subclass of B<Pod::Parser>.
+B<Pod::Select> provides a method named B<select()> to specify the set of
+POD sections to select for processing/printing. B<podselect()> merely
+creates a B<Pod::Select> object and then invokes the B<podselect()>
+followed by B<parse_from_file()>.
+
+=head1 SECTION SPECIFICATIONS
+
+B<podselect()> and B<Pod::Select::select()> may be given one or more
+"section specifications" to restrict the text processed to only the
+desired set of sections and their corresponding subsections.  A section
+specification is a string containing one or more Perl-style regular
+expressions separated by forward slashes ("/").  If you need to use a
+forward slash literally within a section title you can escape it with a
+backslash ("\/").
+
+The formal syntax of a section specification is:
+
+=over 4
+
+=item
+
+I<head1-title-regex>/I<head2-title-regex>/...
+
+=back
+
+Any omitted or empty regular expressions will default to ".*".
+Please note that each regular expression given is implicitly
+anchored by adding "^" and "$" to the beginning and end.  Also, if a
+given regular expression starts with a "!" character, then the
+expression is I<negated> (so C<!foo> would match anything I<except>
+C<foo>).
+
+Some example section specifications follow.
+
+=over 4
+
+=item
+Match the C<NAME> and C<SYNOPSIS> sections and all of their subsections:
+
+C<NAME|SYNOPSIS>
+
+=item
+Match only the C<Question> and C<Answer> subsections of the C<DESCRIPTION>
+section:
+
+C<DESCRIPTION/Question|Answer>
+
+=item
+Match the C<Comments> subsection of I<all> sections:
+
+C</Comments>
+
+=item
+Match all subsections of C<DESCRIPTION> I<except> for C<Comments>:
+
+C<DESCRIPTION/!Comments>
+
+=item
+Match the C<DESCRIPTION> section but do I<not> match any of its subsections:
+
+C<DESCRIPTION/!.+>
+
+=item
+Match all top level sections but none of their subsections:
+
+C</!.+>
+
+=back 
+
+=begin _NOT_IMPLEMENTED_
+
+=head1 RANGE SPECIFICATIONS
+
+B<podselect()> and B<Pod::Select::select()> may be given one or more
+"range specifications" to restrict the text processed to only the
+desired ranges of paragraphs in the desired set of sections. A range
+specification is a string containing a single Perl-style regular
+expression (a regex), or else two Perl-style regular expressions
+(regexs) separated by a ".." (Perl's "range" operator is "..").
+The regexs in a range specification are delimited by forward slashes
+("/").  If you need to use a forward slash literally within a regex you
+can escape it with a backslash ("\/").
+
+The formal syntax of a range specification is:
+
+=over 4
+
+=item
+
+/I<start-range-regex>/[../I<end-range-regex>/]
+
+=back
+
+Where each the item inside square brackets (the ".." followed by the
+end-range-regex) is optional. Each "range-regex" is of the form:
+
+    =cmd-expr text-expr
+
+Where I<cmd-expr> is intended to match the name of one or more POD
+commands, and I<text-expr> is intended to match the paragraph text for
+the command. If a range-regex is supposed to match a POD command, then
+the first character of the regex (the one after the initial '/')
+absolutely I<must> be an single '=' character; it may not be anything
+else (not even a regex meta-character) if it is supposed to match
+against the name of a POD command.
+
+If no I<=cmd-expr> is given then the text-expr will be matched against
+plain textblocks unless it is preceded by a space, in which case it is
+matched against verbatim text-blocks. If no I<text-expr> is given then
+only the command-portion of the paragraph is matched against.
+
+Note that these two expressions are each implicitly anchored. This
+means that when matching against the command-name, there will be an
+implicit '^' and '$' around the given I<=cmd-expr>; and when matching
+against the paragraph text there will be an implicit '\A' and '\Z'
+around the given I<text-expr>.
+
+Unlike with section-specs, the '!' character does I<not> have any special
+meaning (negation or otherwise) at the beginning of a range-spec!
+
+Some example range specifications follow.
+
+=over 4
+
+=item
+Match all C<=for html> paragraphs:
+
+C</=for html/>
+
+=item
+Match all paragraphs between C<=begin html> and C<=end html>
+(note that this will I<not> work correctly if such sections
+are nested):
+
+C</=begin html/../=end html/>
+
+=item
+Match all paragraphs between the given C<=item> name until the end of the
+current section:
+
+C</=item mine/../=head\d/>
+
+=item
+Match all paragraphs between the given C<=item> until the next item, or
+until the end of the itemized list (note that this will I<not> work as
+desired if the item contains an itemized list nested within it):
+
+C</=item mine/../=(item|back)/>
+
+=back 
+
+=end _NOT_IMPLEMENTED_
+
+=cut
+
+#############################################################################
+
+use strict;
+#use diagnostics;
+use Carp;
+use Pod::Parser 1.04;
+use vars qw(@ISA @EXPORT $MAX_HEADING_LEVEL);
+
+@ISA = qw(Pod::Parser);
+@EXPORT = qw(&podselect);
+
+## Maximum number of heading levels supported for '=headN' directives
+*MAX_HEADING_LEVEL = \3;
+
+#############################################################################
+
+=head1 OBJECT METHODS
+
+The following methods are provided in this module. Each one takes a
+reference to the object itself as an implicit first parameter.
+
+=cut
+
+##---------------------------------------------------------------------------
+
+## =begin _PRIVATE_
+## 
+## =head1 B<_init_headings()>
+## 
+## Initialize the current set of active section headings.
+## 
+## =cut
+## 
+## =end _PRIVATE_
+
+use vars qw(%myData @section_headings);
+
+sub _init_headings {
+    my $self = shift;
+    local *myData = $self;
+
+    ## Initialize current section heading titles if necessary
+    unless (defined $myData{_SECTION_HEADINGS}) {
+        local *section_headings = $myData{_SECTION_HEADINGS} = [];
+        for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
+            $section_headings[$i] = '';
+        }
+    }
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<curr_headings()>
+
+            ($head1, $head2, $head3, ...) = $parser->curr_headings();
+            $head1 = $parser->curr_headings(1);
+
+This method returns a list of the currently active section headings and
+subheadings in the document being parsed. The list of headings returned
+corresponds to the most recently parsed paragraph of the input.
+
+If an argument is given, it must correspond to the desired section
+heading number, in which case only the specified section heading is
+returned. If there is no current section heading at the specified
+level, then C<undef> is returned.
+
+=cut
+
+sub curr_headings {
+    my $self = shift;
+    $self->_init_headings()  unless (defined $self->{_SECTION_HEADINGS});
+    my @headings = @{ $self->{_SECTION_HEADINGS} };
+    return (@_ > 0  and  $_[0] =~ /^\d+$/) ? $headings[$_[0] - 1] : @headings;
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<select()>
+
+            $parser->select($section_spec1,$section_spec2,...);
+
+This method is used to select the particular sections and subsections of
+POD documentation that are to be printed and/or processed. The existing
+set of selected sections is I<replaced> with the given set of sections.
+See B<add_selection()> for adding to the current set of selected
+sections.
+
+Each of the C<$section_spec> arguments should be a section specification
+as described in L<"SECTION SPECIFICATIONS">.  The section specifications
+are parsed by this method and the resulting regular expressions are
+stored in the invoking object.
+
+If no C<$section_spec> arguments are given, then the existing set of
+selected sections is cleared out (which means C<all> sections will be
+processed).
+
+This method should I<not> normally be overridden by subclasses.
+
+=cut
+
+use vars qw(@selected_sections);
+
+sub select {
+    my $self = shift;
+    my @sections = @_;
+    local *myData = $self;
+    local $_;
+
+### NEED TO DISCERN A SECTION-SPEC FROM A RANGE-SPEC (look for m{^/.+/$}?)
+
+    ##---------------------------------------------------------------------
+    ## The following is a blatant hack for backward compatibility, and for
+    ## implementing add_selection(). If the *first* *argument* is the
+    ## string "+", then the remaining section specifications are *added*
+    ## to the current set of selections; otherwise the given section
+    ## specifications will *replace* the current set of selections.
+    ##
+    ## This should probably be fixed someday, but for the present time,
+    ## it seems incredibly unlikely that "+" would ever correspond to
+    ## a legitimate section heading
+    ##---------------------------------------------------------------------
+    my $add = ($sections[0] eq "+") ? shift(@sections) : "";
+
+    ## Reset the set of sections to use
+    unless (@sections > 0) {
+        delete $myData{_SELECTED_SECTIONS}  unless ($add);
+        return;
+    }
+    $myData{_SELECTED_SECTIONS} = []
+        unless ($add  &&  exists $myData{_SELECTED_SECTIONS});
+    local *selected_sections = $myData{_SELECTED_SECTIONS};
+
+    ## Compile each spec
+    my $spec;
+    for $spec (@sections) {
+        if ( defined($_ = &_compile_section_spec($spec)) ) {
+            ## Store them in our sections array
+            push(@selected_sections, $_);
+        }
+        else {
+            carp "Ignoring section spec \"$spec\"!\n";
+        }
+    }
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<add_selection()>
+
+            $parser->add_selection($section_spec1,$section_spec2,...);
+
+This method is used to add to the currently selected sections and
+subsections of POD documentation that are to be printed and/or
+processed. See <select()> for replacing the currently selected sections.
+
+Each of the C<$section_spec> arguments should be a section specification
+as described in L<"SECTION SPECIFICATIONS">. The section specifications
+are parsed by this method and the resulting regular expressions are
+stored in the invoking object.
+
+This method should I<not> normally be overridden by subclasses.
+
+=cut
+
+sub add_selection {
+    my $self = shift;
+    $self->select("+", @_);
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<clear_selections()>
+
+            $parser->clear_selections();
+
+This method takes no arguments, it has the exact same effect as invoking
+<select()> with no arguments.
+
+=cut
+
+sub clear_selections {
+    my $self = shift;
+    $self->select();
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<match_section()>
+
+            $boolean = $parser->match_section($heading1,$heading2,...);
+
+Returns a value of true if the given section and subsection heading
+titles match any of the currently selected section specifications in
+effect from prior calls to B<select()> and B<add_selection()> (or if
+there are no explictly selected/deselected sections).
+
+The arguments C<$heading1>, C<$heading2>, etc. are the heading titles of
+the corresponding sections, subsections, etc. to try and match.  If
+C<$headingN> is omitted then it defaults to the current corresponding
+section heading title in the input.
+
+This method should I<not> normally be overridden by subclasses.
+
+=cut
+
+sub match_section {
+    my $self = shift;
+    my (@headings) = @_;
+    local *myData = $self;
+
+    ## Return true if no restrictions were explicitly specified
+    my $selections = (exists $myData{_SELECTED_SECTIONS})
+                       ?  $myData{_SELECTED_SECTIONS}  :  undef;
+    return  1  unless ((defined $selections) && (@{$selections} > 0));
+
+    ## Default any unspecified sections to the current one
+    my @current_headings = $self->curr_headings();
+    for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
+        (defined $headings[$i])  or  $headings[$i] = $current_headings[$i];
+    }
+
+    ## Look for a match against the specified section expressions
+    my ($section_spec, $regex, $negated, $match);
+    for $section_spec ( @{$selections} ) {
+        ##------------------------------------------------------
+        ## Each portion of this spec must match in order for
+        ## the spec to be matched. So we will start with a 
+        ## match-value of 'true' and logically 'and' it with
+        ## the results of matching a given element of the spec.
+        ##------------------------------------------------------
+        $match = 1;
+        for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
+            $regex   = $section_spec->[$i];
+            $negated = ($regex =~ s/^\!//);
+            $match  &= ($negated ? ($headings[$i] !~ /${regex}/)
+                                 : ($headings[$i] =~ /${regex}/));
+            last unless ($match);
+        }
+        return  1  if ($match);
+    }
+    return  0;  ## no match
+}
+
+##---------------------------------------------------------------------------
+
+=head1 B<is_selected()>
+
+            $boolean = $parser->is_selected($paragraph);
+
+This method is used to determine if the block of text given in
+C<$paragraph> falls within the currently selected set of POD sections
+and subsections to be printed or processed. This method is also
+responsible for keeping track of the current input section and
+subsections. It is assumed that C<$paragraph> is the most recently read
+(but not yet processed) input paragraph.
+
+The value returned will be true if the C<$paragraph> and the rest of the
+text in the same section as C<$paragraph> should be selected (included)
+for processing; otherwise a false value is returned.
+
+=cut
+
+sub is_selected {
+    my ($self, $paragraph) = @_;
+    local $_;
+    local *myData = $self;
+
+    $self->_init_headings()  unless (defined $myData{_SECTION_HEADINGS});
+
+    ## Keep track of current sections levels and headings
+    $_ = $paragraph;
+    if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*)\s*$/) {
+        ## This is a section heading command
+        my ($level, $heading) = ($2, $3);
+        $level = 1 + (length($1) / 3)  if ((! length $level) || (length $1));
+        ## Reset the current section heading at this level
+        $myData{_SECTION_HEADINGS}->[$level - 1] = $heading;
+        ## Reset subsection headings of this one to empty
+        for (my $i = $level; $i < $MAX_HEADING_LEVEL; ++$i) {
+            $myData{_SECTION_HEADINGS}->[$i] = '';
+        }
+    }
+
+    return  $self->match_section();
+}
+
+#############################################################################
+
+=head1 EXPORTED FUNCTIONS
+
+The following functions are exported by this module. Please note that
+these are functions (not methods) and therefore C<do not> take an
+implicit first argument.
+
+=cut
+
+##---------------------------------------------------------------------------
+
+=head1 B<podselect()>
+
+            podselect(\%options,@filelist);
+
+B<podselect> will print the raw (untranslated) POD paragraphs of all
+POD sections in the given input files specified by C<@filelist>
+according to the given options.
+
+If any argument to B<podselect> is a reference to a hash
+(associative array) then the values with the following keys are
+processed as follows:
+
+=over 4
+
+=item B<-output>
+
+A string corresponding to the desired output file (or ">&STDOUT"
+or ">&STDERR"). The default is to use standard output.
+
+=item B<-sections>
+
+A reference to an array of sections specifications (as described in
+L<"SECTION SPECIFICATIONS">) which indicate the desired set of POD
+sections and subsections to be selected from input. If no section
+specifications are given, then all sections of the PODs are used.
+
+=begin _NOT_IMPLEMENTED_
+
+=item B<-ranges>
+
+A reference to an array of range specifications (as described in
+L<"RANGE SPECIFICATIONS">) which indicate the desired range of POD
+paragraphs to be selected from the desired input sections. If no range
+specifications are given, then all paragraphs of the desired sections
+are used.
+
+=end _NOT_IMPLEMENTED_
+
+=back
+
+All other arguments should correspond to the names of input files
+containing POD sections. A file name of "-" or "<&STDIN" will
+be interpeted to mean standard input (which is the default if no
+filenames are given).
+
+=cut 
+
+sub podselect {
+    my(@argv) = @_;
+    my %defaults   = ();
+    my $pod_parser = new Pod::Select(%defaults);
+    my $num_inputs = 0;
+    my $output = ">&STDOUT";
+    my %opts = ();
+    local $_;
+    for (@argv) {
+        if (ref($_)) {
+            next unless (ref($_) eq 'HASH');
+            %opts = (%defaults, %{$_});
+
+            ##-------------------------------------------------------------
+            ## Need this for backward compatibility since we formerly used
+            ## options that were all uppercase words rather than ones that
+            ## looked like Unix command-line options.
+            ## to be uppercase keywords)
+            ##-------------------------------------------------------------
+            %opts = map {
+                my ($key, $val) = (lc $_, $opts{$_});
+                $key =~ s/^(?=\w)/-/;
+                $key =~ /^-se[cl]/  and  $key  = '-sections';
+                #! $key eq '-range'    and  $key .= 's';
+                ($key => $val);    
+            } (keys %opts);
+
+            ## Process the options
+            (exists $opts{'-output'})  and  $output = $opts{'-output'};
+
+            ## Select the desired sections
+            $pod_parser->select(@{ $opts{'-sections'} })
+                if ( (defined $opts{'-sections'})
+                     && ((ref $opts{'-sections'}) eq 'ARRAY') );
+
+            #! ## Select the desired paragraph ranges
+            #! $pod_parser->select(@{ $opts{'-ranges'} })
+            #!     if ( (defined $opts{'-ranges'})
+            #!          && ((ref $opts{'-ranges'}) eq 'ARRAY') );
+        }
+        else {
+            $pod_parser->parse_from_file($_, $output);
+            ++$num_inputs;
+        }
+    }
+    $pod_parser->parse_from_file("-")  unless ($num_inputs > 0);
+}
+
+#############################################################################
+
+=head1 PRIVATE METHODS AND DATA
+
+B<Pod::Select> makes uses a number of internal methods and data fields
+which clients should not need to see or use. For the sake of avoiding
+name collisions with client data and methods, these methods and fields
+are briefly discussed here. Determined hackers may obtain further
+information about them by reading the B<Pod::Select> source code.
+
+Private data fields are stored in the hash-object whose reference is
+returned by the B<new()> constructor for this class. The names of all
+private methods and data-fields used by B<Pod::Select> begin with a
+prefix of "_" and match the regular expression C</^_\w+$/>.
+
+=cut
+
+##---------------------------------------------------------------------------
+
+=begin _PRIVATE_
+
+=head1 B<_compile_section_spec()>
+
+            $listref = $parser->_compile_section_spec($section_spec);
+
+This function (note it is a function and I<not> a method) takes a
+section specification (as described in L<"SECTION SPECIFICATIONS">)
+given in C<$section_sepc>, and compiles it into a list of regular
+expressions. If C<$section_spec> has no syntax errors, then a reference
+to the list (array) of corresponding regular expressions is returned;
+otherwise C<undef> is returned and an error message is printed (using
+B<carp>) for each invalid regex.
+
+=end _PRIVATE_
+
+=cut
+
+sub _compile_section_spec {
+    my ($section_spec) = @_;
+    my (@regexs, $negated);
+
+    ## Compile the spec into a list of regexs
+    local $_ = $section_spec;
+    s|\\\\|\001|g;  ## handle escaped backward slashes
+    s|\\/|\002|g;   ## handle escaped forward slashes
+
+    ## Parse the regexs for the heading titles
+    @regexs = split('/', $_, $MAX_HEADING_LEVEL);
+
+    ## Set default regex for ommitted levels
+    for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
+        $regexs[$i]  = '.*'  unless ((defined $regexs[$i])
+                                     && (length $regexs[$i]));
+    }
+    ## Modify the regexs as needed and validate their syntax
+    my $bad_regexs = 0;
+    for (@regexs) {
+        $_ .= '.+'  if ($_ eq '!');
+        s|\001|\\\\|g;       ## restore escaped backward slashes
+        s|\002|\\/|g;        ## restore escaped forward slashes
+        $negated = s/^\!//;  ## check for negation
+        eval "/$_/";         ## check regex syntax
+        if ($@) {
+            ++$bad_regexs;
+            carp "Bad regular expression /$_/ in \"$section_spec\": $@\n";
+        }
+        else {
+            ## Add the forward and rear anchors (and put the negator back)
+            $_ = '^' . $_  unless (/^\^/);
+            $_ = $_ . '$'  unless (/\$$/);
+            $_ = '!' . $_  if ($negated);
+        }
+    }
+    return  (! $bad_regexs) ? [ @regexs ] : undef;
+}
+
+##---------------------------------------------------------------------------
+
+=begin _PRIVATE_
+
+=head2 $self->{_SECTION_HEADINGS}
+
+A reference to an array of the current section heading titles for each
+heading level (note that the first heading level title is at index 0).
+
+=end _PRIVATE_
+
+=cut
+
+##---------------------------------------------------------------------------
+
+=begin _PRIVATE_
+
+=head2 $self->{_SELECTED_SECTIONS}
+
+A reference to an array of references to arrays. Each subarray is a list
+of anchored regular expressions (preceded by a "!" if the expression is to
+be negated). The index of the expression in the subarray should correspond
+to the index of the heading title in C<$self-E<gt>{_SECTION_HEADINGS}>
+that it is to be matched against.
+
+=end _PRIVATE_
+
+=cut
+
+#############################################################################
+
+=head1 SEE ALSO
+
+L<Pod::Parser>
+
+=head1 AUTHOR
+
+Brad Appleton E<lt>bradapp@enteract.comE<gt>
+
+Based on code for B<pod2text> written by
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
+
+=cut
+
+1;
+
diff --git a/lib/Pod/Usage.pm b/lib/Pod/Usage.pm
new file mode 100644 (file)
index 0000000..855dbf0
--- /dev/null
@@ -0,0 +1,502 @@
+#############################################################################
+# Pod/Usage.pm -- print usage messages for the running script.
+#
+# Based on Tom Christiansen's Pod::Text::pod2text() function
+# (with modifications).
+#
+# Copyright (C) 1994-1999 Tom Christiansen. All rights reserved.
+# This file is part of "PodParser". PodParser is free software;
+# you can redistribute it and/or modify it under the same terms
+# as Perl itself.
+#############################################################################
+
+package Pod::Usage;
+
+use vars qw($VERSION);
+$VERSION = 1.08;   ## Current version of this package
+require  5.004;    ## requires this Perl version or later
+
+=head1 NAME
+
+Pod::Usage, pod2usage() - print a usage message from embedded pod documentation
+
+=head1 SYNOPSIS
+
+  use Pod::Usage
+
+  my $message_text  = "This text precedes the usage message.";
+  my $exit_status   = 2;          ## The exit status to use
+  my $verbose_level = 0;          ## The verbose level to use
+  my $filehandle    = \*STDERR;   ## The filehandle to write to
+
+  pod2usage($message_text);
+
+  pod2usage($exit_status);
+
+  pod2usage( { -message => $message_text ,
+               -exitval => $exit_status  ,  
+               -verbose => $verbose_level,  
+               -output  => $filehandle } );
+
+  pod2usage(   -msg     => $message_text ,
+               -exitval => $exit_status  ,  
+               -verbose => $verbose_level,  
+               -output  => $filehandle   );
+
+=head1 ARGUMENTS
+
+B<pod2usage> should be given either a single argument, or a list of
+arguments corresponding to an associative array (a "hash"). When a single
+argument is given, it should correspond to exactly one of the following:
+
+=over
+
+=item *
+
+A string containing the text of a message to print I<before> printing
+the usage message
+
+=item *
+
+A numeric value corresponding to the desired exit status
+
+=item *
+
+A reference to a hash
+
+=back
+
+If more than one argument is given then the entire argument list is
+assumed to be a hash.  If a hash is supplied (either as a reference or
+as a list) it should contain one or more elements with the following
+keys:
+
+=over
+
+=item C<-message>
+
+=item C<-msg>
+
+The text of a message to print immediately prior to printing the
+program's usage message. 
+
+=item C<-exitval>
+
+The desired exit status to pass to the B<exit()> function.
+
+=item C<-verbose>
+
+The desired level of "verboseness" to use when printing the usage
+message. If the corresponding value is 0, then only the "SYNOPSIS"
+section of the pod documentation is printed. If the corresponding value
+is 1, then the "SYNOPSIS" section, along with any section entitled
+"OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is printed.  If the
+corresponding value is 2 or more then the entire manpage is printed.
+
+=item C<-output>
+
+A reference to a filehandle, or the pathname of a file to which the
+usage message should be written. The default is C<\*STDERR> unless the
+exit value is less than 2 (in which case the default is C<\*STDOUT>).
+
+=item C<-input>
+
+A reference to a filehandle, or the pathname of a file from which the
+invoking script's pod documentation should be read.  It defaults to the
+file indicated by C<$0> (C<$PROGRAM_NAME> for users of F<English.pm>).
+
+=item C<-pathlist>
+
+A list of directory paths. If the input file does not exist, then it
+will be searched for in the given directory list (in the order the
+directories appear in the list). It defaults to the list of directories
+implied by C<$ENV{PATH}>. The list may be specified either by a reference
+to an array, or by a string of directory paths which use the same path
+separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
+MSWin32 and DOS).
+
+=back
+
+=head1 DESCRIPTION
+
+B<pod2usage> will print a usage message for the invoking script (using
+its embedded pod documentation) and then exit the script with the
+desired exit status. The usage message printed may have any one of three
+levels of "verboseness": If the verbose level is 0, then only a synopsis
+is printed. If the verbose level is 1, then the synopsis is printed
+along with a description (if present) of the command line options and
+arguments. If the verbose level is 2, then the entire manual page is
+printed.
+
+Unless they are explicitly specified, the default values for the exit
+status, verbose level, and output stream to use are determined as
+follows:
+
+=over
+
+=item *
+
+If neither the exit status nor the verbose level is specified, then the
+default is to use an exit status of 2 with a verbose level of 0.
+
+=item *
+
+If an exit status I<is> specified but the verbose level is I<not>, then the
+verbose level will default to 1 if the exit status is less than 2 and
+will default to 0 otherwise.
+
+=item *
+
+If an exit status is I<not> specified but verbose level I<is> given, then
+the exit status will default to 2 if the verbose level is 0 and will
+default to 1 otherwise.
+
+=item *
+
+If the exit status used is less than 2, then output is printed on
+C<STDOUT>.  Otherwise output is printed on C<STDERR>.
+
+=back
+
+Although the above may seem a bit confusing at first, it generally does
+"the right thing" in most situations.  This determination of the default
+values to use is based upon the following typical Unix conventions:
+
+=over
+
+=item *
+
+An exit status of 0 implies "success". For example, B<diff(1)> exits
+with a status of 0 if the two files have the same contents.
+
+=item *
+
+An exit status of 1 implies possibly abnormal, but non-defective, program
+termination.  For example, B<grep(1)> exits with a status of 1 if
+it did I<not> find a matching line for the given regular expression.
+
+=item *
+
+An exit status of 2 or more implies a fatal error. For example, B<ls(1)>
+exits with a status of 2 if you specify an illegal (unknown) option on
+the command line.
+
+=item *
+
+Usage messages issued as a result of bad command-line syntax should go
+to C<STDERR>.  However, usage messages issued due to an explicit request
+to print usage (like specifying B<-help> on the command line) should go
+to C<STDOUT>, just in case the user wants to pipe the output to a pager
+(such as B<more(1)>).
+
+=item *
+
+If program usage has been explicitly requested by the user, it is often
+desireable to exit with a status of 1 (as opposed to 0) after issuing
+the user-requested usage message.  It is also desireable to give a
+more verbose description of program usage in this case.
+
+=back
+
+B<pod2usage> doesn't force the above conventions upon you, but it will
+use them by default if you don't expressly tell it to do otherwise.  The
+ability of B<pod2usage()> to accept a single number or a string makes it
+convenient to use as an innocent looking error message handling function:
+
+    use Pod::Usage;
+    use Getopt::Long;
+
+    ## Parse options
+    GetOptions("help", "man", "flag1")  ||  pod2usage(2);
+    pod2usage(1)  if ($opt_help);
+    pod2usage(-verbose => 2)  if ($opt_man);
+
+    ## Check for too many filenames
+    pod2usage("$0: Too many files given.\n")  if (@ARGV > 1);
+
+Some user's however may feel that the above "economy of expression" is
+not particularly readable nor consistent and may instead choose to do
+something more like the following:
+
+    use Pod::Usage;
+    use Getopt::Long;
+
+    ## Parse options
+    GetOptions("help", "man", "flag1")  ||  pod2usage(-verbose => 0);
+    pod2usage(-verbose => 1)  if ($opt_help);
+    pod2usage(-verbose => 2)  if ($opt_man);
+
+    ## Check for too many filenames
+    pod2usage(-verbose => 2, -message => "$0: Too many files given.\n")
+        if (@ARGV > 1);
+
+As with all things in Perl, I<there's more than one way to do it>, and
+B<pod2usage()> adheres to this philosophy.  If you are interested in
+seeing a number of different ways to invoke B<pod2usage> (although by no
+means exhaustive), please refer to L<"EXAMPLES">.
+
+=head1 EXAMPLES
+
+Each of the following invocations of C<pod2usage()> will print just the
+"SYNOPSIS" section to C<STDERR> and will exit with a status of 2:
+
+    pod2usage();
+
+    pod2usage(2);
+
+    pod2usage(-verbose => 0);
+
+    pod2usage(-exitval => 2);
+
+    pod2usage({-exitval => 2, -output => \*STDERR});
+
+    pod2usage({-verbose => 0, -output  => \*STDERR});
+
+    pod2usage(-exitval => 2, -verbose => 0);
+
+    pod2usage(-exitval => 2, -verbose => 0, -output => \*STDERR);
+
+Each of the following invocations of C<pod2usage()> will print a message
+of "Syntax error." (followed by a newline) to C<STDERR>, immediately
+followed by just the "SYNOPSIS" section (also printed to C<STDERR>) and
+will exit with a status of 2:
+
+    pod2usage("Syntax error.");
+
+    pod2usage(-message => "Syntax error.", -verbose => 0);
+
+    pod2usage(-msg  => "Syntax error.", -exitval => 2);
+
+    pod2usage({-msg => "Syntax error.", -exitval => 2, -output => \*STDERR});
+
+    pod2usage({-msg => "Syntax error.", -verbose => 0, -output => \*STDERR});
+
+    pod2usage(-msg  => "Syntax error.", -exitval => 2, -verbose => 0);
+
+    pod2usage(-message => "Syntax error.",
+              -exitval => 2,
+              -verbose => 0,
+              -output  => \*STDERR);
+
+Each of the following invocations of C<pod2usage()> will print the
+"SYNOPSIS" section and any "OPTIONS" and/or "ARGUMENTS" sections to
+C<STDOUT> and will exit with a status of 1:
+
+    pod2usage(1);
+
+    pod2usage(-verbose => 1);
+
+    pod2usage(-exitval => 1);
+
+    pod2usage({-exitval => 1, -output => \*STDOUT});
+
+    pod2usage({-verbose => 1, -output => \*STDOUT});
+
+    pod2usage(-exitval => 1, -verbose => 1);
+
+    pod2usage(-exitval => 1, -verbose => 1, -output => \*STDOUT});
+
+Each of the following invocations of C<pod2usage()> will print the
+entire manual page to C<STDOUT> and will exit with a status of 1:
+
+    pod2usage(-verbose  => 2);
+
+    pod2usage({-verbose => 2, -output => \*STDOUT});
+
+    pod2usage(-exitval  => 1, -verbose => 2);
+
+    pod2usage({-exitval => 1, -verbose => 2, -output => \*STDOUT});
+
+=head2 Recommended Use
+
+Most scripts should print some type of usage message to C<STDERR> when a
+command line syntax error is detected. They should also provide an
+option (usually C<-H> or C<-help>) to print a (possibly more verbose)
+usage message to C<STDOUT>. Some scripts may even wish to go so far as to
+provide a means of printing their complete documentation to C<STDOUT>
+(perhaps by allowing a C<-man> option). The following example uses
+B<Pod::Usage> in combination with B<Getopt::Long> to do all of these
+things:
+
+    use Getopt::Long;
+    use Pod::Usage;
+
+    ## Parse options and print usage if there is a syntax error,
+    ## or if usage was explicitly requested.
+    GetOptions("help", "man", "flag1")  ||  pod2usage(2);
+    pod2usage(1)  if ($opt_help);
+    pod2usage(-verbose => 2)  if ($opt_man);
+
+    ## If no arguments were given, then allow STDIN to be used only
+    ## if it's not connected to a terminal (otherwise print usage)
+    pod2usage("$0: No files given.")  if ((@ARGV == 0) && (-t STDIN));
+
+=head1 CAVEATS
+
+By default, B<pod2usage()> will use C<$0> as the path to the pod input
+file.  Unfortunately, not all systems on which Perl runs will set C<$0>
+properly (although if C<$0> isn't found, B<pod2usage()> will search
+C<$ENV{PATH}> or else the list specified by the C<-pathlist> option).
+If this is the case for your system, you may need to explicitly specify
+the path to the pod docs for the invoking script using something
+similar to the following:
+
+    pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
+
+=head1 AUTHOR
+
+Brad Appleton E<lt>bradapp@enteract.comE<gt>
+
+Based on code for B<Pod::Text::pod2text()> written by
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
+
+=head1 ACKNOWLEDGEMENTS
+
+Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience
+with re-writing this manpage.
+
+=cut
+
+#############################################################################
+
+use strict;
+#use diagnostics;
+use Carp;
+use Exporter;
+use Pod::PlainText;
+use File::Spec;
+
+use vars qw(@ISA @EXPORT);
+@ISA = qw(Pod::PlainText);
+@EXPORT = qw(&pod2usage);
+
+##---------------------------------------------------------------------------
+
+##---------------------------------
+## Function definitions begin here
+##---------------------------------
+
+sub pod2usage {
+    local($_) = shift || "";
+    my %opts;
+    ## Collect arguments
+    if (@_ > 0) {
+        ## Too many arguments - assume that this is a hash and
+        ## the user forgot to pass a reference to it.
+        %opts = ($_, @_);
+    }
+    elsif (ref $_) {
+        ## User passed a ref to a hash
+        %opts = %{$_}  if (ref($_) eq 'HASH');
+    }
+    elsif (/^[-+]?\d+$/o) {
+        ## User passed in the exit value to use
+        $opts{"-exitval"} =  $_;
+    }
+    else {
+        ## User passed in a message to print before issuing usage.
+        $_  and  $opts{"-message"} = $_;
+    }
+
+    ## Need this for backward compatibility since we formerly used
+    ## options that were all uppercase words rather than ones that
+    ## looked like Unix command-line options.
+    ## to be uppercase keywords)
+    %opts = map {
+        my $val = $opts{$_};
+        s/^(?=\w)/-/;
+        /^-msg/i   and  $_ = '-message';
+        /^-exit/i  and  $_ = '-exitval';
+        lc($_) => $val;    
+    } (keys %opts);
+
+    ## Now determine default -exitval and -verbose values to use
+    if ((! defined $opts{"-exitval"}) && (! defined $opts{"-verbose"})) {
+        $opts{"-exitval"} = 2;
+        $opts{"-verbose"} = 0;
+    }
+    elsif (! defined $opts{"-exitval"}) {
+        $opts{"-exitval"} = ($opts{"-verbose"} > 0) ? 1 : 2;
+    }
+    elsif (! defined $opts{"-verbose"}) {
+        $opts{"-verbose"} = ($opts{"-exitval"} < 2);
+    }
+
+    ## Default the output file
+    $opts{"-output"} = ($opts{"-exitval"} < 2) ? \*STDOUT : \*STDERR
+            unless (defined $opts{"-output"});
+    ## Default the input file
+    $opts{"-input"} = $0  unless (defined $opts{"-input"});
+
+    ## Look up input file in path if it doesnt exist.
+    unless ((ref $opts{"-input"}) || (-e $opts{"-input"})) {
+        my ($dirname, $basename) = ('', $opts{"-input"});
+        my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/) ? ";"
+                            : (($^O eq 'MacOS') ? ',' :  ":");
+        my $pathspec = $opts{"-pathlist"} || $ENV{PATH} || $ENV{PERL5LIB};
+
+        my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
+        for $dirname (@paths) {
+            $_ = File::Spec->catfile($dirname, $basename)  if length;
+            last if (-e $_) && ($opts{"-input"} = $_);
+        }
+    }
+
+    ## Now create a pod reader and constrain it to the desired sections.
+    my $parser = new Pod::Usage(USAGE_OPTIONS => \%opts);
+    if ($opts{"-verbose"} == 0) {
+        $parser->select("SYNOPSIS");
+    }
+    elsif ($opts{"-verbose"} == 1) {
+        my $opt_re = '(?i)' .
+                     '(?:OPTIONS|ARGUMENTS)' .
+                     '(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?';
+        $parser->select( 'SYNOPSIS', $opt_re, "DESCRIPTION/$opt_re" );
+    }
+
+    ## Now translate the pod document and then exit with the desired status
+    $parser->parse_from_file($opts{"-input"}, $opts{"-output"});
+    exit($opts{"-exitval"});
+}
+
+##---------------------------------------------------------------------------
+
+##-------------------------------
+## Method definitions begin here
+##-------------------------------
+
+sub new {
+    my $this = shift;
+    my $class = ref($this) || $this;
+    my %params = @_;
+    my $self = {%params};
+    bless $self, $class;
+    $self->initialize();
+    return $self;
+}
+
+sub begin_pod {
+    my $self = shift;
+    $self->SUPER::begin_pod();  ## Have to call superclass
+    my $msg = $self->{USAGE_OPTIONS}->{-message}  or  return 1;
+    my $out_fh = $self->output_handle();
+    print $out_fh "$msg\n";
+}
+
+sub preprocess_paragraph {
+    my $self = shift;
+    local $_ = shift;
+    my $line = shift;
+    ## See if this is a heading and we arent printing the entire manpage.
+    if (($self->{USAGE_OPTIONS}->{-verbose} < 2) && /^=head/o) {
+        ## Change the title of the SYNOPSIS section to USAGE
+        s/^=head1\s+SYNOPSIS\s*$/=head1 USAGE/o;
+        ## Try to do some lowercasing instead of all-caps in headings
+        s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
+        ## Use a colon to end all headings
+        s/\s*$/:/o  unless (/:\s*$/o);
+        $_ .= "\n";
+    }
+    return  $self->SUPER::preprocess_paragraph($_);
+}
+
index 77a181e..f70c11b 100644 (file)
@@ -1,4 +1,5 @@
-CONVERTERS = pod2html pod2latex pod2man pod2text checkpods
+CONVERTERS = pod2html pod2latex pod2man pod2text checkpods \
+               pod2usage podchecker podselect
 
 HTMLROOT = /   # Change this to fix cross-references in HTML
 POD2HTML = pod2html \
@@ -308,6 +309,15 @@ pod2text:  pod2text.PL ../lib/Config.pm
 checkpods:     checkpods.PL ../lib/Config.pm
        $(PERL) -I ../lib checkpods.PL
 
+pod2usage:     pod2usage.PL ../lib/Config.pm
+       $(PERL) -I ../lib pod2usage.PL
+
+podchecker:    podchecker.PL ../lib/Config.pm
+       $(PERL) -I ../lib podchecker.PL
+
+podselect:     podselect.PL ../lib/Config.pm
+       $(PERL) -I ../lib podselect.PL
+
 compile: all
        $(REALPERL) -I../lib ../utils/perlcc -regex 's/$$/.exe/' pod2latex pod2man pod2text checkpods -prog -verbose dcf -log ../compilelog;
 
diff --git a/pod/pod2usage.PL b/pod/pod2usage.PL
new file mode 100644 (file)
index 0000000..fdaa955
--- /dev/null
@@ -0,0 +1,179 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# 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.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+        if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
+
+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!';
+
+#############################################################################
+# pod2usage -- command to print usage messages from embedded pod docs
+#
+# Derived from Tom Christiansen's pod2text script.
+# (with extensive modifications)
+#
+# Copyright (c) 1996 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
+
+pod2usage - print usage messages from embedded pod docs in files
+
+=head1 SYNOPSIS
+
+=over 12
+
+=item B<pod2usage>
+
+[B<-help>]
+[B<-man>]
+[B<-exit>S< >I<exitval>]
+[B<-output>S< >I<outfile>]
+[B<-verbose> I<level>]
+[B<-pathlist> I<dirlist>]
+I<file>
+
+=back
+
+=head1 OPTIONS AND ARGUMENTS
+
+=over 8
+
+=item B<-help>
+
+Print a brief help message and exit.
+
+=item B<-man>
+
+Print this command's manual page and exit.
+
+=item B<-exit> I<exitval>
+
+The exit status value to return.
+
+=item B<-output> I<outfile>
+
+The output file to print to. If the special names "-" or ">&1" or ">&STDOUT"
+are used then standard output is used. If ">&2" or ">&STDERR" is used then
+standard error is used.
+
+=item B<-verbose> I<level>
+
+The desired level of verbosity to use:
+
+    1 : print SYNOPSIS only
+    2 : print SYNOPSIS sections and any OPTIONS/ARGUMENTS sections
+    3 : print the entire manpage (similar to running pod2text)
+
+=item B<-pathlist> I<dirlist>
+
+Specifies one or more directories to search for the input file if it
+was not supplied with an absolute path. Each directory path in the given
+list should be separated by a ':' on Unix (';' on MSWin32 and DOS).
+
+=item I<file>
+
+The pathname of a file containing pod documentation to be output in
+usage mesage format (defaults to standard input).
+
+=back
+
+=head1 DESCRIPTION
+
+B<pod2usage> will read the given input file looking for pod
+documentation and will print the corresponding usage message.
+If no input file is specifed than standard input is read.
+
+B<pod2usage> invokes the B<pod2usage()> function in the B<Pod::Usage>
+module. Please see L<Pod::Usage/pod2usage()>.
+
+=head1 SEE ALSO
+
+L<Pod::Usage>, L<pod2text(1)>
+
+=head1 AUTHOR
+
+Brad Appleton E<lt>bradapp@enteract.comE<gt>
+
+Based on code for B<pod2text(1)> written by
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
+
+=cut
+
+use Pod::Usage;
+use Getopt::Long;
+
+## Define options
+my %options = ();
+my @opt_specs = (
+    "help",
+    "man",
+    "exit=i",
+    "output=s",
+    "pathlist=s",
+    "verbose=i",
+);
+
+## Parse options
+GetOptions(\%options, @opt_specs)  ||  pod2usage(2);
+pod2usage(1)  if ($options{help});
+pod2usage(VERBOSE => 2)  if ($options{man});
+
+## Dont default to STDIN if connected to a terminal
+pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
+
+@ARGV = ("-")  unless (@ARGV > 0);
+if (@ARGV > 1) {
+    print STDERR "pod2usage: Too many filenames given\n\n";
+    pod2usage(2);
+}
+
+my %usage = ();
+$usage{-input}    = shift(@ARGV);
+$usage{-exitval}  = $options{"exit"}      if (defined $options{"exit"});
+$usage{-output}   = $options{"output"}    if (defined $options{"output"});
+$usage{-verbose}  = $options{"verbose"}   if (defined $options{"verbose"});
+$usage{-pathlist} = $options{"pathlist"}  if (defined $options{"pathlist"});
+
+pod2usage(\%usage);
+
+
+!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 ':';
diff --git a/pod/podchecker.PL b/pod/podchecker.PL
new file mode 100644 (file)
index 0000000..1ca0d79
--- /dev/null
@@ -0,0 +1,130 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# 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.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+        if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
+
+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
+#
+# Derived from Tom Christiansen's pod2text script.
+# (with extensive modifications)
+#
+# Copyright (c) 1998 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>] [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 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.
+
+B<podchecker> invokes the B<podchecker()> function exported by B<Pod::Checker>
+Please see L<Pod::Checker/podchecker()> for more details.
+
+=head1 SEE ALSO
+
+L<Pod::Parser> and L<Pod::Checker>
+
+=head1 AUTHOR
+
+Brad Appleton E<lt>bradapp@enteract.comE<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 = (
+        "help"     => 0,
+        "man"      => 0,
+);
+
+## Parse options
+GetOptions(\%options, "help", "man")  ||  pod2usage(2);
+pod2usage(1)  if ($options{help});
+pod2usage(-verbose => 2)  if ($options{man});
+
+## Dont default to STDIN if connected to a terminal
+pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
+
+## Invoke podchecker()
+if(@ARGV) {
+   for (@ARGV) { podchecker($_) };
+} else {
+       podchecker("<&STDIN");
+}
+
+!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 ':';
diff --git a/pod/podselect.PL b/pod/podselect.PL
new file mode 100644 (file)
index 0000000..0df8304
--- /dev/null
@@ -0,0 +1,142 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+
+# 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.
+chdir(dirname($0));
+($file = basename($0)) =~ s/\.PL$//;
+$file =~ s/\.pl$//
+        if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"
+
+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!';
+
+#############################################################################
+# podselect -- command to invoke the podselect function in Pod::Select
+#
+# Derived from Tom Christiansen's pod2text script.
+# (with extensive modifications)
+#
+# Copyright (c) 1996 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
+
+podselect - print selected sections of pod documentation on standard output
+
+=head1 SYNOPSIS
+
+B<podselect> [B<-help>] [B<-man>] [B<-section>S< >I<section-spec>]
+[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<-section>S< >I<section-spec>
+
+Specify a section to include in the output.
+See L<Pod::Parser/"SECTION SPECIFICATIONS">
+for the format to use for I<section-spec>.
+This option may be given multiple times on the command line.
+
+=item I<file>
+
+The pathname of a file from which to select sections of pod
+documentation (defaults to standard input).
+
+=back
+
+=head1 DESCRIPTION
+
+B<podselect> will read the given input files looking for pod
+documentation and will print out (in raw pod format) all sections that
+match one ore more of the given section specifications. If no section
+specifications are given than all pod sections encountered are output.
+
+B<podselect> invokes the B<podselect()> function exported by B<Pod::Select>
+Please see L<Pod::Select/podselect()> for more details.
+
+=head1 SEE ALSO
+
+L<Pod::Parser> and L<Pod::Select>
+
+=head1 AUTHOR
+
+Brad Appleton E<lt>bradapp@enteract.comE<gt>
+
+Based on code for B<Pod::Text::pod2text(1)> written by
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
+
+=cut
+
+use Pod::Select;
+use Pod::Usage;
+use Getopt::Long;
+
+## Define options
+my %options = (
+        "help"     => 0,
+        "man"      => 0,
+        "sections" => [],
+);
+
+## Parse options
+GetOptions(\%options, "help", "man", "sections|select=s@")  ||  pod2usage(2);
+pod2usage(1)  if ($options{help});
+pod2usage(-verbose => 2)  if ($options{man});
+
+## Dont default to STDIN if connected to a terminal
+pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
+
+## Invoke podselect().
+if (@{ $options{"sections"} } > 0) {
+    podselect({ -sections => $options{"sections"} }, @ARGV);
+}
+else {
+    podselect(@ARGV);
+}
+
+
+!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 ':';
diff --git a/t/pod/emptycmd.t b/t/pod/emptycmd.t
new file mode 100755 (executable)
index 0000000..59e395e
--- /dev/null
@@ -0,0 +1,21 @@
+BEGIN {
+   use File::Basename;
+   my $THISDIR = dirname $0;
+   unshift @INC, $THISDIR;
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+__END__
+
+=pod
+
+= this is a test
+of the emergency
+broadcast system
+
+=cut
diff --git a/t/pod/emptycmd.xr b/t/pod/emptycmd.xr
new file mode 100644 (file)
index 0000000..f06d2db
--- /dev/null
@@ -0,0 +1,2 @@
+    = this is a test of the emergency broadcast system
+
diff --git a/t/pod/for.t b/t/pod/for.t
new file mode 100755 (executable)
index 0000000..44af44f
--- /dev/null
@@ -0,0 +1,59 @@
+BEGIN {
+   use File::Basename;
+   my $THISDIR = dirname $0;
+   unshift @INC, $THISDIR;
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+=pod
+
+This is a test
+
+=for theloveofpete
+You shouldn't see this
+or this
+or this
+
+=for text
+pod2text should see this
+and this
+and this
+
+and everything should see this!
+
+=begin text
+
+Similarly, this line ...
+
+and this one ...
+
+as well this one,
+
+should all be in pod2text output
+
+=end text
+
+Tweedley-deedley-dee, Im as happy as can be!
+Tweedley-deedley-dum, cuz youre my honey sugar plum!
+
+=begin atthebeginning
+
+But I expect to see neither hide ...
+
+nor tail ...
+
+of this text
+
+=end atthebeginning
+
+The rest of this should show up in everything.
+
diff --git a/t/pod/for.xr b/t/pod/for.xr
new file mode 100644 (file)
index 0000000..25794ab
--- /dev/null
@@ -0,0 +1,19 @@
+    This is a test
+
+    pod2text should see this and this and this
+
+    and everything should see this!
+
+    Similarly, this line ...
+
+    and this one ...
+
+    as well this one,
+
+    should all be in pod2text output
+
+    Tweedley-deedley-dee, Im as happy as can be! Tweedley-deedley-
+    dum, cuz youre my honey sugar plum!
+
+    The rest of this should show up in everything.
+
diff --git a/t/pod/headings.t b/t/pod/headings.t
new file mode 100755 (executable)
index 0000000..78608d0
--- /dev/null
@@ -0,0 +1,140 @@
+BEGIN {
+   use File::Basename;
+   my $THISDIR = dirname $0;
+   unshift @INC, $THISDIR;
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+#################################################################
+  use Pod::Usage;
+  pod2usage( VERBOSE => 2, EXIT => 1 );
+
+=pod
+
+=head1 NAME
+
+B<rdb2pg> - insert an rdb table into a PostgreSQL database
+
+=head1 SYNOPSIS
+
+B<rdb2pg>  [I<param>=I<value> ...]
+
+=head1 PARAMETERS
+
+B<rdb2pg> uses an IRAF-compatible parameter interface.  
+A template parameter file is in F</proj/axaf/simul/lib/uparm/rdb2pg.par>.
+
+=over 4
+
+=item B<input> I<file>
+
+The B<RDB> file to insert into the database. If the given name
+is the string C<stdin>, it reads from the UNIX standard input stream.
+
+
+=back
+
+=head1 DESCRIPTION
+
+B<rdb2pg> will enter the data from an B<RDB> database into a
+PostgreSQL database table, optionally creating the database and the
+table if they do not exist.  It automatically determines the
+PostgreSQL data type from the column definition in the B<RDB> file,
+but may be overriden via a series of definition files or directly
+via one of its parameters.
+
+The target database and table are specified by the C<db> and C<table>
+parameters.  If they do not exist, and the C<createdb> parameter is
+set, they will be created.  Table field definitions are determined
+in the following order:
+
+=cut
+
+#################################################################
+
+results in:
+
+
+#################################################################
+
+    rdb2pg - insert an rdb table into a PostgreSQL database
+
+    rdb2pg [*param*=*value* ...]
+
+    rdb2pg uses an IRAF-compatible parameter interface. A template
+    parameter file is in /proj/axaf/simul/lib/uparm/rdb2pg.par.
+
+    The RDB file to insert into the database. If the given name is
+    the string `stdin', it reads from the UNIX standard input
+    stream.
+
+    rdb2pg will enter the data from an RDB database into a
+    PostgreSQL database table, optionally creating the database and
+    the table if they do not exist. It automatically determines the
+    PostgreSQL data type from the column definition in the RDB file,
+    but may be overriden via a series of definition files or
+    directly via one of its parameters.
+
+    The target database and table are specified by the `db' and
+    `table' parameters. If they do not exist, and the `createdb'
+    parameter is set, they will be created. Table field definitions
+    are determined in the following order:
+
+
+#################################################################
+
+while the original version of Text (using pod2text) gives
+
+#################################################################
+
+NAME
+    rdb2pg - insert an rdb table into a PostgreSQL database
+
+SYNOPSIS
+    rdb2pg [*param*=*value* ...]
+
+PARAMETERS
+    rdb2pg uses an IRAF-compatible parameter interface. A template
+    parameter file is in /proj/axaf/simul/lib/uparm/rdb2pg.par.
+
+    input *file*
+        The RDB file to insert into the database. If the given name
+        is the string `stdin', it reads from the UNIX standard input
+        stream.
+
+DESCRIPTION
+    rdb2pg will enter the data from an RDB database into a
+    PostgreSQL database table, optionally creating the database and
+    the table if they do not exist. It automatically determines the
+    PostgreSQL data type from the column definition in the RDB file,
+    but may be overriden via a series of definition files or
+    directly via one of its parameters.
+
+    The target database and table are specified by the `db' and
+    `table' parameters. If they do not exist, and the `createdb'
+    parameter is set, they will be created. Table field definitions
+    are determined in the following order:
+
+
+#################################################################
+
+
+Thanks for any help.  If, as your email indicates, you've not much
+time to look at this, I can work around things by calling pod2text()
+directly using the official Text.pm.
+
+Diab
+
+-------------
+Diab Jerius
+djerius@cfa.harvard.edu
+
diff --git a/t/pod/headings.xr b/t/pod/headings.xr
new file mode 100644 (file)
index 0000000..e1277b7
--- /dev/null
@@ -0,0 +1,29 @@
+NAME
+    rdb2pg - insert an rdb table into a PostgreSQL database
+
+SYNOPSIS
+    rdb2pg [*param*=*value* ...]
+
+PARAMETERS
+    rdb2pg uses an IRAF-compatible parameter interface. A template
+    parameter file is in /proj/axaf/simul/lib/uparm/rdb2pg.par.
+
+    input *file*
+        The RDB file to insert into the database. If the given name
+        is the string `stdin', it reads from the UNIX standard input
+        stream.
+
+
+DESCRIPTION
+    rdb2pg will enter the data from an RDB database into a
+    PostgreSQL database table, optionally creating the database and
+    the table if they do not exist. It automatically determines the
+    PostgreSQL data type from the column definition in the RDB file,
+    but may be overriden via a series of definition files or
+    directly via one of its parameters.
+
+    The target database and table are specified by the `db' and
+    `table' parameters. If they do not exist, and the `createdb'
+    parameter is set, they will be created. Table field definitions
+    are determined in the following order:
+
diff --git a/t/pod/include.t b/t/pod/include.t
new file mode 100755 (executable)
index 0000000..4e73b78
--- /dev/null
@@ -0,0 +1,36 @@
+BEGIN {
+   use File::Basename;
+   my $THISDIR = dirname $0;
+   unshift @INC, $THISDIR;
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+=pod
+
+This file tries to demonstrate a simple =include directive
+for pods. It is used as follows:
+
+   =include filename
+
+where "filename" is expected to be an absolute pathname, or else
+reside be relative to the directory in which the current processed
+podfile resides, or be relative to the current directory.
+
+Lets try it out with the file "included.t" shall we.
+
+***THIS TEXT IS IMMEDIATELY BEFORE THE INCLUDE***
+
+=include included.t
+
+***THIS TEXT IS IMMEDIATELY AFTER THE INCLUDE***
+
+So how did we do???
diff --git a/t/pod/include.xr b/t/pod/include.xr
new file mode 100644 (file)
index 0000000..1bac06a
--- /dev/null
@@ -0,0 +1,23 @@
+    This file tries to demonstrate a simple =include directive for
+    pods. It is used as follows:
+
+       =include filename
+
+    where "filename" is expected to be an absolute pathname, or else
+    reside be relative to the directory in which the current
+    processed podfile resides, or be relative to the current
+    directory.
+
+    Lets try it out with the file "included.t" shall we.
+
+    ***THIS TEXT IS IMMEDIATELY BEFORE THE INCLUDE***
+
+###### begin =include included.t #####
+    This is the text of the included file named "included.t". It
+    should appear in the final pod document from pod2xxx
+
+###### end =include included.t #####
+    ***THIS TEXT IS IMMEDIATELY AFTER THE INCLUDE***
+
+    So how did we do???
+
diff --git a/t/pod/included.t b/t/pod/included.t
new file mode 100755 (executable)
index 0000000..4f171c4
--- /dev/null
@@ -0,0 +1,35 @@
+BEGIN {
+   use File::Basename;
+   my $THISDIR = dirname $0;
+   unshift @INC, $THISDIR;
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+##------------------------------------------------------------
+# This file is =included by "include.t"
+#
+# This text should NOT be in the resultant pod document
+# because we havent seen an =xxx pod directive in this file!
+##------------------------------------------------------------
+
+=pod
+
+This is the text of the included file named "included.t".
+It should appear in the final pod document from pod2xxx
+
+=cut
+
+##------------------------------------------------------------
+# This text should NOT be in the resultant pod document
+# because it is *after* an =cut an no other pod directives
+# proceed it!
+##------------------------------------------------------------
diff --git a/t/pod/included.xr b/t/pod/included.xr
new file mode 100644 (file)
index 0000000..f0bc03b
--- /dev/null
@@ -0,0 +1,3 @@
+    This is the text of the included file named "included.t". It
+    should appear in the final pod document from pod2xxx
+
diff --git a/t/pod/lref.t b/t/pod/lref.t
new file mode 100755 (executable)
index 0000000..02e2c9e
--- /dev/null
@@ -0,0 +1,66 @@
+BEGIN {
+   use File::Basename;
+   my $THISDIR = dirname $0;
+   unshift @INC, $THISDIR;
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+=pod
+
+Try out I<LOTS> of different ways of specifying references:
+
+Reference the L<manpage/section>
+
+Reference the L<manpage / section>
+
+Reference the L<manpage/ section>
+
+Reference the L<manpage /section>
+
+Reference the L<"manpage/section">
+
+Reference the L<"manpage"/section>
+
+Reference the L<manpage/"section">
+
+Reference the L<manpage/
+section>
+
+Reference the L<manpage
+/section>
+
+Now try it using the new "|" stuff ...
+
+Reference the L<thistext|manpage/section>
+
+Reference the L<thistext | manpage / section>
+
+Reference the L<thistext| manpage/ section>
+
+Reference the L<thistext |manpage /section>
+
+Reference the L<thistext|
+"manpage/section">
+
+Reference the L<thistext
+|"manpage"/section>
+
+Reference the L<thistext|manpage/"section">
+
+Reference the L<thistext|
+manpage/
+section>
+
+Reference the L<thistext
+|manpage
+/section>
+
diff --git a/t/pod/lref.xr b/t/pod/lref.xr
new file mode 100644 (file)
index 0000000..d8455e3
--- /dev/null
@@ -0,0 +1,40 @@
+    Try out *LOTS* of different ways of specifying references:
+
+    Reference the the "section" entry in the manpage manpage
+
+    Reference the the "section" entry in the manpage manpage
+
+    Reference the the "section" entry in the manpage manpage
+
+    Reference the the "section" entry in the manpage manpage
+
+    Reference the the section on "manpage/section"
+
+    Reference the the "section" entry in the "manpage" manpage
+
+    Reference the the section on "section" in the manpage manpage
+
+    Reference the the "section" entry in the manpage manpage
+
+    Reference the the "section" entry in the manpage manpage
+
+    Now try it using the new "|" stuff ...
+
+    Reference the thistext
+
+    Reference the thistext
+
+    Reference the thistext
+
+    Reference the thistext
+
+    Reference the thistext
+
+    Reference the thistext
+
+    Reference the thistext
+
+    Reference the thistext
+
+    Reference the thistext
+
diff --git a/t/pod/nested_items.t b/t/pod/nested_items.t
new file mode 100755 (executable)
index 0000000..c8e9b22
--- /dev/null
@@ -0,0 +1,64 @@
+BEGIN {
+   use File::Basename;
+   my $THISDIR = dirname $0;
+   unshift @INC, $THISDIR;
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+=head1 Test nested item lists
+
+This is a test to ensure the nested =item paragraphs
+get indented appropriately.
+
+=over 2
+
+=item 1
+
+First section.
+
+=over 2
+
+=item a
+
+this is item a
+
+=item b
+
+this is item b
+
+=back
+
+=item 2
+
+Second section.
+
+=over 2
+
+=item a
+
+this is item a
+
+=item b
+
+this is item b
+
+=item c
+
+=item d
+
+This is item c & d.
+
+=back
+
+=back
+
+=cut
diff --git a/t/pod/nested_items.xr b/t/pod/nested_items.xr
new file mode 100644 (file)
index 0000000..7d72bbe
--- /dev/null
@@ -0,0 +1,19 @@
+Test nested item lists
+    This is a test to ensure the nested =item paragraphs get
+    indented appropriately.
+
+    1 First section.
+
+      a this is item a
+
+      b this is item b
+
+    2 Second section.
+
+      a this is item a
+
+      b this is item b
+
+      c
+      d This is item c & d.
+
diff --git a/t/pod/nested_seqs.t b/t/pod/nested_seqs.t
new file mode 100755 (executable)
index 0000000..8559f1f
--- /dev/null
@@ -0,0 +1,23 @@
+BEGIN {
+   use File::Basename;
+   my $THISDIR = dirname $0;
+   unshift @INC, $THISDIR;
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+=pod
+
+The statement: C<This is dog kind's I<finest> hour!> is a parody of a
+quotation from Winston Churchill.
+
+=cut
+
diff --git a/t/pod/nested_seqs.xr b/t/pod/nested_seqs.xr
new file mode 100644 (file)
index 0000000..5a008c1
--- /dev/null
@@ -0,0 +1,3 @@
+    The statement: `This is dog kind's *finest* hour!' is a parody
+    of a quotation from Winston Churchill.
+
diff --git a/t/pod/oneline_cmds.t b/t/pod/oneline_cmds.t
new file mode 100755 (executable)
index 0000000..28bd1d0
--- /dev/null
@@ -0,0 +1,46 @@
+BEGIN {
+   use File::Basename;
+   my $THISDIR = dirname $0;
+   unshift @INC, $THISDIR;
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+==head1 NAME
+B<rdb2pg> - insert an rdb table into a PostgreSQL database
+
+==head1 SYNOPSIS
+B<rdb2pg>  [I<param>=I<value> ...]
+
+==head1 PARAMETERS
+B<rdb2pg> uses an IRAF-compatible parameter interface.  
+A template parameter file is in F</proj/axaf/simul/lib/uparm/rdb2pg.par>.
+
+==over 4
+==item B<input> I<file>
+The B<RDB> file to insert into the database. If the given name
+is the string C<stdin>, it reads from the UNIX standard input stream.
+
+==back
+
+==head1 DESCRIPTION
+B<rdb2pg> will enter the data from an B<RDB> database into a
+PostgreSQL database table, optionally creating the database and the
+table if they do not exist.  It automatically determines the
+PostgreSQL data type from the column definition in the B<RDB> file,
+but may be overriden via a series of definition files or directly
+via one of its parameters.
+
+The target database and table are specified by the C<db> and C<table>
+parameters.  If they do not exist, and the C<createdb> parameter is
+set, they will be created.  Table field definitions are determined
+in the following order:
+
diff --git a/t/pod/oneline_cmds.xr b/t/pod/oneline_cmds.xr
new file mode 100644 (file)
index 0000000..e1277b7
--- /dev/null
@@ -0,0 +1,29 @@
+NAME
+    rdb2pg - insert an rdb table into a PostgreSQL database
+
+SYNOPSIS
+    rdb2pg [*param*=*value* ...]
+
+PARAMETERS
+    rdb2pg uses an IRAF-compatible parameter interface. A template
+    parameter file is in /proj/axaf/simul/lib/uparm/rdb2pg.par.
+
+    input *file*
+        The RDB file to insert into the database. If the given name
+        is the string `stdin', it reads from the UNIX standard input
+        stream.
+
+
+DESCRIPTION
+    rdb2pg will enter the data from an RDB database into a
+    PostgreSQL database table, optionally creating the database and
+    the table if they do not exist. It automatically determines the
+    PostgreSQL data type from the column definition in the RDB file,
+    but may be overriden via a series of definition files or
+    directly via one of its parameters.
+
+    The target database and table are specified by the `db' and
+    `table' parameters. If they do not exist, and the `createdb'
+    parameter is set, they will be created. Table field definitions
+    are determined in the following order:
+
diff --git a/t/pod/poderrs.t b/t/pod/poderrs.t
new file mode 100755 (executable)
index 0000000..591bd2a
--- /dev/null
@@ -0,0 +1,39 @@
+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};
+
+
+__END__
+
+
+=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!
+
+=cut
diff --git a/t/pod/poderrs.xr b/t/pod/poderrs.xr
new file mode 100644 (file)
index 0000000..a7bc42d
--- /dev/null
@@ -0,0 +1,11 @@
+*** ERROR: Unknown command "unknown1" at line 21 of file t/poderrs.t
+*** ERROR: Unknown interior-sequence "N" at line 21 of file t/poderrs.t
+*** ERROR: Unknown interior-sequence "D" at line 22 of file t/poderrs.t
+*** ERROR: Unknown interior-sequence "Q" at line 25 of file t/poderrs.t
+*** ERROR: Unknown interior-sequence "A" at line 26 of file t/poderrs.t
+*** ERROR: Unknown interior-sequence "V" at line 27 of file t/poderrs.t
+*** ERROR: Unknown interior-sequence "Y" at line 27 of file t/poderrs.t
+** Unterminated B<...> at t/poderrs.t line 31
+** Unterminated I<...> at t/poderrs.t line 30
+** Unterminated C<...> at t/poderrs.t line 33
+t/poderrs.t has 10 pod syntax errors.
diff --git a/t/pod/special_seqs.t b/t/pod/special_seqs.t
new file mode 100755 (executable)
index 0000000..5352fd1
--- /dev/null
@@ -0,0 +1,30 @@
+BEGIN {
+   use File::Basename;
+   my $THISDIR = dirname $0;
+   unshift @INC, $THISDIR;
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+=pod
+
+This is a test to see if I can do not only C<$self> and C<method()>, but
+also C<$self->method()> and C<$self->{FIELDNAME}> and C<{FOO=>BAR}> without
+resorting to escape sequences.
+
+Now for the grand finale of C<$self->method()->{FIELDNAME} = {FOO=>BAR}>.
+
+Of course I should still be able to do all this I<with> escape sequences
+too: C<$self-E<gt>method()> and C<$self-E<gt>{FIELDNAME}> and C<{FOO=E<gt>BAR}>.
+
+Dont forget C<$self-E<gt>method()-E<gt>{FIELDNAME} = {FOO=E<gt>BAR}>.
+
+=cut
diff --git a/t/pod/special_seqs.xr b/t/pod/special_seqs.xr
new file mode 100644 (file)
index 0000000..b6ae7fd
--- /dev/null
@@ -0,0 +1,13 @@
+    This is a test to see if I can do not only `$self' and
+    `method()', but also `$self->method()' and `$self->{FIELDNAME}'
+    and `{FOO=>BAR}' without resorting to escape sequences.
+
+    Now for the grand finale of `$self->method()->{FIELDNAME} =
+    {FOO=>BAR}'.
+
+    Of course I should still be able to do all this *with* escape
+    sequences too: `$self->method()' and `$self->{FIELDNAME}' and
+    `{FOO=>BAR}'.
+
+    Dont forget `$self->method()->{FIELDNAME} = {FOO=>BAR}'.
+
diff --git a/t/pod/testcmp.pl b/t/pod/testcmp.pl
new file mode 100644 (file)
index 0000000..d61bbff
--- /dev/null
@@ -0,0 +1,90 @@
+package TestCompare;
+
+use vars qw(@ISA @EXPORT $MYPKG);
+#use strict;
+#use diagnostics;
+use Carp;
+use Exporter;
+use File::Basename;
+use File::Spec;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&testcmp);
+$MYPKG = eval { (caller)[0] };
+
+##--------------------------------------------------------------------------
+
+=head1 NAME
+
+testcmp -- compare two files line-by-line
+
+=head1 SYNOPSIS
+
+    $is_diff = testcmp($file1, $file2);
+
+or
+
+    $is_diff = testcmp({-cmplines => \&mycmp}, $file1, $file2);
+
+=head2 DESCRIPTION
+
+Compare two text files line-by-line and return 0 if they are the
+same, 1 if they differ. Each of $file1 and $file2 may be a filenames,
+or a filehandles (in which case it must already be open for reading).
+
+If the first argument is a hashref, then the B<-cmplines> key in the
+hash may have a subroutine reference as its corresponding value.
+The referenced user-defined subroutine should be a line-comparator
+function that takes two pre-chomped text-lines as its arguments
+(the first is from $file1 and the second is from $file2). It should
+return 0 if it considers the two lines equivalent, and non-zero
+otherwise.
+
+=cut
+
+##--------------------------------------------------------------------------
+
+sub testcmp( $ $ ; $) {
+   my %opts = ref($_[0]) eq 'HASH' ? %{shift()} : ();
+   my ($file1, $file2) = @_;
+   my ($fh1, $fh2) = ($file1, $file2);
+   unless (ref $fh1) {
+      $fh1 = FileHandle->new($file1, "r") or die "Can't open $file1: $!";
+   }
+   unless (ref $fh2) {
+      $fh2 = FileHandle->new($file2, "r") or die "Can't open $file2: $!";
+   }
+  
+   my $cmplines = $opts{'-cmplines'} || undef;
+   my ($f1text, $f2text) = ("", "");
+   my ($line, $diffs)    = (0, 0);
+  
+   while ( defined($f1text) and defined($f2text) ) {
+      defined($f1text = <$fh1>)  and  chomp($f1text);
+      defined($f2text = <$fh2>)  and  chomp($f2text);
+      ++$line;
+      last unless ( defined($f1text) and defined($f2text) );
+      $diffs = (ref $cmplines) ? &$cmplines($f1text, $f2text)
+                               : ($f1text ne $f2text);
+      last if $diffs;
+   }
+   close($fh1) unless (ref $file1);
+   close($fh2) unless (ref $file2);
+  
+   $diffs = 1  if (defined($f1text) or defined($f2text));
+   if ( defined($f1text) and defined($f2text) ) {
+      ## these two lines must be different
+      warn "$file1 and $file2 differ at line $line\n";
+   }
+   elsif (defined($f1text)  and  (! defined($f1text))) {
+      ## file1 must be shorter
+      warn "$file1 is shorter than $file2\n";
+   }
+   elsif (defined $f2text) {
+      ## file2 must be longer
+      warn "$file1 is shorter than $file2\n";
+   }
+   return $diffs;
+}
+
+1;
diff --git a/t/pod/testp2pt.pl b/t/pod/testp2pt.pl
new file mode 100644 (file)
index 0000000..140de05
--- /dev/null
@@ -0,0 +1,177 @@
+package TestPodIncPlainText;
+
+BEGIN {
+   use File::Basename;
+   use File::Spec;
+   push @INC, '..';
+   my $THISDIR = dirname $0;
+   unshift @INC, $THISDIR;
+   require "testcmp.pl";
+   import TestCompare;
+   my $PARENTDIR = dirname $THISDIR;
+   push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR);
+}
+
+use Pod::PlainText;
+use vars qw(@ISA @EXPORT $MYPKG);
+#use strict;
+#use diagnostics;
+use Carp;
+use Exporter;
+#use File::Compare;
+
+@ISA = qw(Pod::PlainText);
+@EXPORT = qw(&testpodplaintext);
+$MYPKG = eval { (caller)[0] };
+
+## Hardcode settings for TERMCAP and COLUMNS so we can try to get
+## reproducible results between environments
+@ENV{qw(TERMCAP COLUMNS)} = ('co=72:do=^J', 72);
+
+sub catfile(@) { File::Spec->catfile(@_); }
+
+## Find the path to the file to =include
+sub findinclude {
+    my $self    = shift;
+    my $incname = shift;
+
+    ## See if its already found w/out any "searching;
+    return  $incname if (-r $incname);
+
+    ## Need to search for it. Look in the following directories ...
+    ##   1. the directory containing this pod file
+    my $thispoddir = dirname $self->input_file;
+    ##   2. the parent directory of the above
+    my $parentdir  = ($thispoddir eq '.') ? '..' : dirname $thispoddir;
+    ##   3. any Pod/ or scripts/ subdirectory of these two
+    my @dirs = ();
+    for ($thispoddir, $parentdir) {
+       my $dir = $_;
+       for ( qw(scripts lib) ) {
+          push @dirs, $dir, catfile($dir, $_),
+                            catfile($dir, 'Pod'),
+                            catfile($dir, $_, 'Pod');
+       }
+    }
+    my %dirs = (map { ($_ => 1) } @dirs);
+    my @podincdirs = (sort keys %dirs);
+
+    for (@podincdirs) {
+       my $incfile = catfile($_, $incname);
+       return $incfile  if (-r $incfile);
+    }
+    warn("*** Can't find =include file $incname in @podincdirs\n");
+    return "";
+}
+
+sub command {
+    my $self = shift;
+    my ($cmd, $text, $line_num, $pod_para)  = @_;
+    $cmd     = ''  unless (defined $cmd);
+    local $_ = $text || '';
+    my $out_fh  = $self->output_handle;
+
+    ## Defer to the superclass for everything except '=include'
+    return  $self->SUPER::command(@_) unless ($cmd eq "include");
+
+    ## We have an '=include' command
+    my $incdebug = 1; ## debugging
+    my @incargs = split;
+    if (@incargs == 0) {
+        warn("*** No filename given for '=include'\n");
+        return;
+    }
+    my $incfile  = $self->findinclude(shift @incargs)  or  return;
+    my $incbase  = basename $incfile;
+    print $out_fh "###### begin =include $incbase #####\n"  if ($incdebug);
+    $self->parse_from_file( {-cutting => 1}, $incfile );
+    print $out_fh "###### end =include $incbase #####\n"    if ($incdebug);
+}
+
+sub podinc2plaintext( $ $ ) {
+    my ($infile, $outfile) = @_;
+    local $_;
+    my $text_parser = $MYPKG->new;
+    $text_parser->parse_from_file($infile, $outfile);
+}
+
+sub testpodinc2plaintext( @ ) {
+   my %args = @_;
+   my $infile  = $args{'-In'}  || croak "No input file given!";
+   my $outfile = $args{'-Out'} || croak "No output file given!";
+   my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!";
+
+   my $different = '';
+   my $testname = basename $cmpfile, '.t', '.xr';
+
+   unless (-e $cmpfile) {
+      my $msg = "*** Can't find comparison file $cmpfile for testing $infile";
+      warn  "$msg\n";
+      return  $msg;
+   }
+
+   print "+ Running testpodinc2plaintext for '$testname'...\n";
+   ## Compare the output against the expected result
+   podinc2plaintext($infile, $outfile);
+   if ( testcmp($outfile, $cmpfile) ) {
+       $different = "$outfile is different from $cmpfile";
+   }
+   else {
+       unlink($outfile);
+   }
+   return  $different;
+}
+
+sub testpodplaintext( @ ) {
+   my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : ();
+   my @testpods = @_;
+   my ($testname, $testdir) = ("", "");
+   my ($podfile, $cmpfile) = ("", "");
+   my ($outfile, $errfile) = ("", "");
+   my $passes = 0;
+   my $failed = 0;
+   local $_;
+
+   print "1..", scalar @testpods, "\n"  unless ($opts{'-xrgen'});
+
+   for $podfile (@testpods) {
+      ($testname, $_) = fileparse($podfile);
+      $testdir ||=  $_;
+      $testname  =~ s/\.t$//;
+      $cmpfile   =  $testdir . $testname . '.xr';
+      $outfile   =  $testdir . $testname . '.OUT';
+
+      if ($opts{'-xrgen'}) {
+          if ($opts{'-force'} or ! -e $cmpfile) {
+             ## Create the comparison file
+             print "+ Creating expected result for \"$testname\"" .
+                   " pod2plaintext test ...\n";
+             podinc2plaintext($podfile, $cmpfile);
+          }
+          else {
+             print "+ File $cmpfile already exists" .
+                   " (use '-force' to regenerate it).\n";
+          }
+          next;
+      }
+
+      my $failmsg = testpodinc2plaintext
+                        -In  => $podfile,
+                        -Out => $outfile,
+                        -Cmp => $cmpfile;
+      if ($failmsg) {
+          ++$failed;
+          print "+\tFAILED. ($failmsg)\n";
+         print "not ok ", $failed+$passes, "\n";
+      }
+      else {
+          ++$passes;
+          unlink($outfile);
+          print "+\tPASSED.\n";
+         print "ok ", $failed+$passes, "\n";
+      }
+   }
+   return  $passes;
+}
+
+1;
diff --git a/t/pod/testpchk.pl b/t/pod/testpchk.pl
new file mode 100644 (file)
index 0000000..cd3c138
--- /dev/null
@@ -0,0 +1,129 @@
+package TestPodChecker;
+
+BEGIN {
+   use File::Basename;
+   use File::Spec;
+   push @INC, '..';
+   my $THISDIR = dirname $0;
+   unshift @INC, $THISDIR;
+   require "testcmp.pl";
+   import TestCompare;
+   my $PARENTDIR = dirname $THISDIR;
+   push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR);
+}
+
+use Pod::Checker;
+use vars qw(@ISA @EXPORT $MYPKG);
+#use strict;
+#use diagnostics;
+use Carp;
+use Exporter;
+#use File::Compare;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&testpodchecker);
+$MYPKG = eval { (caller)[0] };
+
+sub stripname( $ ) {
+   local $_ = shift;
+   return /(\w[.\w]*)\s*$/ ? $1 : $_;
+}
+
+sub msgcmp( $ $ ) {
+   ## filter out platform-dependent aspects of error messages
+   my ($line1, $line2) = @_;
+   for ($line1, $line2) {
+      if ( /^#*\s*(\S.*?)\s+(?:has \d+\s*)?pod syntax (?:error|OK)/ ) {
+          my $fname = $1;
+          s/^#*\s*//  if ($^O eq 'MacOS');
+          s/^\s*\Q$fname\E/stripname($fname)/e;
+      }
+      elsif ( /^#*\s*\*+\s*(?:ERROR|Unterminated)/ ) {
+          s/^#*\s*//  if ($^O eq 'MacOS');
+          s/of file\s+(\S.*?)\s*$/"of file ".stripname($1)/e;
+          s/at\s+(\S.*?)\s+line/"at ".stripname($1)." line"/e;
+      }
+   }
+   return $line1 ne $line2;
+}
+
+sub testpodcheck( @ ) {
+   my %args = @_;
+   my $infile  = $args{'-In'}  || croak "No input file given!";
+   my $outfile = $args{'-Out'} || croak "No output file given!";
+   my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!";
+
+   my $different = '';
+   my $testname = basename $cmpfile, '.t', '.xr';
+
+   unless (-e $cmpfile) {
+      my $msg = "*** Can't find comparison file $cmpfile for testing $infile";
+      warn  "$msg\n";
+      return  $msg;
+   }
+
+   print "+ Running podchecker for '$testname'...\n";
+   ## Compare the output against the expected result
+   podchecker($infile, $outfile);
+   if ( testcmp({'-cmplines' => \&msgcmp}, $outfile, $cmpfile) ) {
+       $different = "$outfile is different from $cmpfile";
+   }
+   else {
+       unlink($outfile);
+   }
+   return  $different;
+}
+
+sub testpodchecker( @ ) {
+   my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : ();
+   my @testpods = @_;
+   my ($testname, $testdir) = ("", "");
+   my ($podfile, $cmpfile) = ("", "");
+   my ($outfile, $errfile) = ("", "");
+   my $passes = 0;
+   my $failed = 0;
+   local $_;
+
+   print "1..", scalar @testpods, "\n"  unless ($opts{'-xrgen'});
+
+   for $podfile (@testpods) {
+      ($testname, $_) = fileparse($podfile);
+      $testdir ||=  $_;
+      $testname  =~ s/\.t$//;
+      $cmpfile   =  $testdir . $testname . '.xr';
+      $outfile   =  $testdir . $testname . '.OUT';
+
+      if ($opts{'-xrgen'}) {
+          if ($opts{'-force'} or ! -e $cmpfile) {
+             ## Create the comparison file
+             print "+ Creating expected result for \"$testname\"" .
+                   " podchecker test ...\n";
+             podchecker($podfile, $cmpfile);
+          }
+          else {
+             print "+ File $cmpfile already exists" .
+                   " (use '-force' to regenerate it).\n";
+          }
+          next;
+      }
+
+      my $failmsg = testpodcheck
+                        -In  => $podfile,
+                        -Out => $outfile,
+                        -Cmp => $cmpfile;
+      if ($failmsg) {
+          ++$failed;
+          print "+\tFAILED. ($failmsg)\n";
+         print "not ok ", $failed+$passes, "\n";
+      }
+      else {
+          ++$passes;
+          unlink($outfile);
+          print "+\tPASSED.\n";
+         print "ok ", $failed+$passes, "\n";
+      }
+   }
+   return  $passes;
+}
+
+1;
index 7daffb3..49271f2 100644 (file)
@@ -337,6 +337,9 @@ UTILS               =                       \
                ..\pod\pod2latex        \
                ..\pod\pod2man          \
                ..\pod\pod2text         \
+               ..\pod\pod2usage        \
+               ..\pod\podchecker       \
+               ..\pod\podselect        \
                ..\x2p\find2perl        \
                ..\x2p\s2p              \
                bin\runperl.pl          \
index 574fa6a..32056a9 100644 (file)
@@ -429,6 +429,9 @@ UTILS               =                       \
                ..\pod\pod2latex        \
                ..\pod\pod2man          \
                ..\pod\pod2text         \
+               ..\pod\pod2usage        \
+               ..\pod\podchecker       \
+               ..\pod\podselect        \
                ..\x2p\find2perl        \
                ..\x2p\s2p              \
                bin\runperl.pl          \
index e5dd640..b1a1b9c 100644 (file)
@@ -1,4 +1,5 @@
-CONVERTERS = pod2html pod2latex pod2man pod2text checkpods
+CONVERTERS = pod2html pod2latex pod2man pod2text checkpods \
+               pod2usage podchecker podselect
 
 HTMLROOT = /   # Change this to fix cross-references in HTML
 POD2HTML = pod2html \
@@ -312,6 +313,15 @@ pod2text:  pod2text.PL ../lib/Config.pm
 checkpods:     checkpods.PL ../lib/Config.pm
        $(PERL) -I ../lib checkpods.PL
 
+pod2usage:     pod2usage.PL ../lib/Config.pm
+       $(PERL) -I ../lib pod2usage.PL
+
+podchecker:    podchecker.PL ../lib/Config.pm
+       $(PERL) -I ../lib podchecker.PL
+
+podselect:     podselect.PL ../lib/Config.pm
+       $(PERL) -I ../lib podselect.PL
+
 compile: all
        $(REALPERL) -I../lib ../utils/perlcc -regex 's/$$/.exe/' pod2latex pod2man pod2text checkpods -prog -verbose dcf -log ../compilelog;