mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 08:38:23 +00:00
Code Issues Packages Projects Releases Wiki Activity

cpan/Pod-Usage - Update to version 2.05

Browse Source 
2.05      2025-03-29

- merged PR #27, fixing spurious Exporter inheritance
This commit is contained in:
Marek Rouchal 2025-03-30 10:26:18 -04:00 committed by James E Keenan
parent 63857a61c0
commit 52fdca79c1
11 changed files with 63 additions and 4529 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
MANIFEST
View File

@ -2026,26 +2026,21 @@ cpan/Pod-Simple/t/xhtml10.t Pod::Simple test file
cpan/Pod-Simple/t/xhtml15.t Pod::Simple test file
cpan/Pod-Simple/t/xhtml20.t Pod::Simple test file
cpan/Pod-Simple/t/xhtml25.t Pod-Simple
cpan/Pod-Usage/lib/Pod/Usage.pm
cpan/Pod-Usage/scripts/pod2usage.PL
cpan/Pod-Usage/t/inc/Pod/InputObjects.pm
cpan/Pod-Usage/t/inc/Pod/Parser.pm
cpan/Pod-Usage/t/inc/Pod/PlainText.pm
cpan/Pod-Usage/t/inc/Pod/Select.pm
cpan/Pod-Usage/t/pod/headwithmarkup.pl
cpan/Pod-Usage/t/pod/headwithmarkup.t
cpan/Pod-Usage/t/pod/p2u_data.pl
cpan/Pod-Usage/t/pod/pod2usage.t
cpan/Pod-Usage/t/pod/pod2usage.xr
cpan/Pod-Usage/t/pod/pod2usage2.t
cpan/Pod-Usage/t/pod/selectheaders.pl
cpan/Pod-Usage/t/pod/selectheaders.t
cpan/Pod-Usage/t/pod/selectsections.pl
cpan/Pod-Usage/t/pod/selectsections.t
cpan/Pod-Usage/t/pod/testcmp.pl
cpan/Pod-Usage/t/pod/testp2pt.pl
cpan/Pod-Usage/t/pod/usage.pod
cpan/Pod-Usage/t/pod/usage2.pod
cpan/Pod-Usage/lib/Pod/Usage.pm Module related to Pod::Usage
cpan/Pod-Usage/scripts/pod2usage.PL Pod::Usage
cpan/Pod-Usage/t/pod/headwithmarkup.pl Script related to Pod::Usage
cpan/Pod-Usage/t/pod/headwithmarkup.t Test file related to Pod::Usage
cpan/Pod-Usage/t/pod/p2u_data.pl Script related to Pod::Usage
cpan/Pod-Usage/t/pod/pod2usage.t Test file related to Pod::Usage
cpan/Pod-Usage/t/pod/pod2usage.xr Pod::Usage
cpan/Pod-Usage/t/pod/pod2usage2.t Test file related to Pod::Usage
cpan/Pod-Usage/t/pod/selectheaders.pl Script related to Pod::Usage
cpan/Pod-Usage/t/pod/selectheaders.t Test file related to Pod::Usage
cpan/Pod-Usage/t/pod/selectsections.pl Script related to Pod::Usage
cpan/Pod-Usage/t/pod/selectsections.t Test file related to Pod::Usage
cpan/Pod-Usage/t/pod/testcmp.pl Script related to Pod::Usage
cpan/Pod-Usage/t/pod/usage.pod Pod::Usage
cpan/Pod-Usage/t/pod/usage2.pod Pod::Usage
cpan/podlators/docs/docknot.yaml podlators
cpan/podlators/lib/Pod/Man.pm Convert POD data to *roff
cpan/podlators/lib/Pod/ParseLink.pm Perl an L<> formatting code in POD text

3
Porting/Maintainers.pl
View File

@ -976,7 +976,8 @@ our %Modules = (
},
'Pod::Usage' => {
'DISTRIBUTION' => 'MAREKR/Pod-Usage-2.03.tar.gz',
'DISTRIBUTION' => 'MAREKR/Pod-Usage-2.05.tar.gz',
'SYNCINFO' => 'jkeenan on Sun Mar 30 10:25:52 2025',
'FILES' => q[cpan/Pod-Usage],
'EXCLUDED' => [
qr{^t/00-},

6
cpan/Pod-Usage/lib/Pod/Usage.pm
View File

@ -15,10 +15,10 @@ require 5.006; ## requires this Perl version or later
use Carp;
use Config;
use Exporter;
use Exporter qw(import);
use File::Spec;
our $VERSION = '2.03';
our $VERSION = '2.05';
our @EXPORT = qw(&pod2usage);
our @ISA;
@ -843,7 +843,7 @@ things:
=item B<-help>
Print a brief help message and exits.
Prints a brief help message and exits.
=item B<-man>

9
cpan/Pod-Usage/scripts/pod2usage.PL
View File

@ -78,11 +78,11 @@ I<file>
=item B<-help>
Print a brief help message and exit.
Prints a brief help message and exit.
=item B<-man>
Print this command's manual page and exit.
Prints this command's manual page and exit.
=item B<-exit> I<exitval>
@ -110,9 +110,8 @@ list should be separated by a ':' on Unix (';' on MSWin32 and DOS).
=item B<-formatter> I<module>
Which text formatter to use. Default is L<Pod::Text>, or for very old
Perl versions L<Pod::PlainText>. An alternative would be e.g.
L<Pod::Text::Termcap>.
Which text formatter to use. Default is L<Pod::Text>. An alternative would
be e.g. L<Pod::Text::Termcap>.
=item B<-utf8>

941
cpan/Pod-Usage/t/inc/Pod/InputObjects.pm
View File

@ -1,941 +0,0 @@
#############################################################################
# Pod/InputObjects.pm -- package which defines objects for input streams
# and paragraphs and commands when parsing POD docs.
#
# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################
package Pod::InputObjects;
use strict;
use warnings;
use vars qw($VERSION);
$VERSION = '1.60'; ## Current version of this package
require 5.005; ## requires this Perl version or later
#############################################################################
=head1 NAME
Pod::InputObjects - objects representing POD input paragraphs, commands, etc.
=head1 SYNOPSIS
use Pod::InputObjects;
=head1 REQUIRES
perl5.004, Carp
=head1 EXPORTS
Nothing.
=head1 DESCRIPTION
This module defines some basic input objects used by B<Pod::Parser> when
reading and parsing POD text from an input source. The following objects
are defined:
=begin __PRIVATE__
=over 4
=item package B<Pod::InputSource>
An object corresponding to a source of POD input text. It is mostly a
wrapper around a filehandle or C<IO::Handle>-type object (or anything
that implements the C<getline()> method) which keeps track of some
additional information relevant to the parsing of PODs.
=back
=end __PRIVATE__
=over 4
=item package B<Pod::Paragraph>
An object corresponding to a paragraph of POD input text. It may be a
plain paragraph, a verbatim paragraph, or a command paragraph (see
L<perlpod>).
=item package B<Pod::InteriorSequence>
An object corresponding to an interior sequence command from the POD
input text (see L<perlpod>).
=item package B<Pod::ParseTree>
An object corresponding to a tree of parsed POD text. Each "node" in
a parse-tree (or I<ptree>) is either a text-string or a reference to
a B<Pod::InteriorSequence> object. The nodes appear in the parse-tree
in the order in which they were parsed from left-to-right.
=back
Each of these input objects are described in further detail in the
sections which follow.
=cut
#############################################################################
package Pod::InputSource;
##---------------------------------------------------------------------------
=begin __PRIVATE__
=head1 B<Pod::InputSource>
This object corresponds to an input source or stream of POD
documentation. When parsing PODs, it is necessary to associate and store
certain context information with each input source. All of this
information is kept together with the stream itself in one of these
C<Pod::InputSource> objects. Each such object is merely a wrapper around
an C<IO::Handle> object of some kind (or at least something that
implements the C<getline()> method). They have the following
methods/attributes:
=end __PRIVATE__
=cut
##---------------------------------------------------------------------------
=begin __PRIVATE__
=head2 B<new()>
my $pod_input1 = Pod::InputSource->new(-handle => $filehandle);
my $pod_input2 = Pod::InputSource->new(-handle => $filehandle,
-name => $name);
my $pod_input3 = Pod::InputSource->new(-handle => \*STDIN);
my $pod_input4 = Pod::InputSource->new(-handle => \*STDIN,
-name => "(STDIN)");
This is a class method that constructs a C<Pod::InputSource> object and
returns a reference to the new input source object. It takes one or more
keyword arguments in the form of a hash. The keyword C<-handle> is
required and designates the corresponding input handle. The keyword
C<-name> is optional and specifies the name associated with the input
handle (typically a file name).
=end __PRIVATE__
=cut
sub new {
## Determine if we were called via an object-ref or a classname
my $this = shift;
my $class = ref($this) || $this;
## Any remaining arguments are treated as initial values for the
## hash that is used to represent this object. Note that we default
## certain values by specifying them *before* the arguments passed.
## If they are in the argument list, they will override the defaults.
my $self = { -name => '(unknown)',
-handle => undef,
-was_cutting => 0,
@_ };
## Bless ourselves into the desired class and perform any initialization
bless $self, $class;
return $self;
}
##---------------------------------------------------------------------------
=begin __PRIVATE__
=head2 B<name()>
my $filename = $pod_input->name();
$pod_input->name($new_filename_to_use);
This method gets/sets the name of the input source (usually a filename).
If no argument is given, it returns a string containing the name of
the input source; otherwise it sets the name of the input source to the
contents of the given argument.
=end __PRIVATE__
=cut
sub name {
(@_ > 1) and $_[0]->{'-name'} = $_[1];
return $_[0]->{'-name'};
}
## allow 'filename' as an alias for 'name'
*filename = \&name;
##---------------------------------------------------------------------------
=begin __PRIVATE__
=head2 B<handle()>
my $handle = $pod_input->handle();
Returns a reference to the handle object from which input is read (the
one used to contructed this input source object).
=end __PRIVATE__
=cut
sub handle {
return $_[0]->{'-handle'};
}
##---------------------------------------------------------------------------
=begin __PRIVATE__
=head2 B<was_cutting()>
print "Yes.\n" if ($pod_input->was_cutting());
The value of the C<cutting> state (that the B<cutting()> method would
have returned) immediately before any input was read from this input
stream. After all input from this stream has been read, the C<cutting>
state is restored to this value.
=end __PRIVATE__
=cut
sub was_cutting {
(@_ > 1) and $_[0]->{-was_cutting} = $_[1];
return $_[0]->{-was_cutting};
}
##---------------------------------------------------------------------------
#############################################################################
package Pod::Paragraph;
##---------------------------------------------------------------------------
=head1 B<Pod::Paragraph>
An object representing a paragraph of POD input text.
It has the following methods/attributes:
=cut
##---------------------------------------------------------------------------
=head2 Pod::Paragraph-E<gt>B<new()>
my $pod_para1 = Pod::Paragraph->new(-text => $text);
my $pod_para2 = Pod::Paragraph->new(-name => $cmd,
-text => $text);
my $pod_para3 = Pod::Paragraph->new(-text => $text);
my $pod_para4 = Pod::Paragraph->new(-name => $cmd,
-text => $text);
my $pod_para5 = Pod::Paragraph->new(-name => $cmd,
-text => $text,
-file => $filename,
-line => $line_number);
This is a class method that constructs a C<Pod::Paragraph> object and
returns a reference to the new paragraph object. It may be given one or
two keyword arguments. The C<-text> keyword indicates the corresponding
text of the POD paragraph. The C<-name> keyword indicates the name of
the corresponding POD command, such as C<head1> or C<item> (it should
I<not> contain the C<=> prefix); this is needed only if the POD
paragraph corresponds to a command paragraph. The C<-file> and C<-line>
keywords indicate the filename and line number corresponding to the
beginning of the paragraph
=cut
sub new {
## Determine if we were called via an object-ref or a classname
my $this = shift;
my $class = ref($this) || $this;
## Any remaining arguments are treated as initial values for the
## hash that is used to represent this object. Note that we default
## certain values by specifying them *before* the arguments passed.
## If they are in the argument list, they will override the defaults.
my $self = {
-name => undef,
-text => (@_ == 1) ? shift : undef,
-file => '<unknown-file>',
-line => 0,
-prefix => '=',
-separator => ' ',
-ptree => [],
@_
};
## Bless ourselves into the desired class and perform any initialization
bless $self, $class;
return $self;
}
##---------------------------------------------------------------------------
=head2 $pod_para-E<gt>B<cmd_name()>
my $para_cmd = $pod_para->cmd_name();
If this paragraph is a command paragraph, then this method will return
the name of the command (I<without> any leading C<=> prefix).
=cut
sub cmd_name {
(@_ > 1) and $_[0]->{'-name'} = $_[1];
return $_[0]->{'-name'};
}
## let name() be an alias for cmd_name()
*name = \&cmd_name;
##---------------------------------------------------------------------------
=head2 $pod_para-E<gt>B<text()>
my $para_text = $pod_para->text();
This method will return the corresponding text of the paragraph.
=cut
sub text {
(@_ > 1) and $_[0]->{'-text'} = $_[1];
return $_[0]->{'-text'};
}
##---------------------------------------------------------------------------
=head2 $pod_para-E<gt>B<raw_text()>
my $raw_pod_para = $pod_para->raw_text();
This method will return the I<raw> text of the POD paragraph, exactly
as it appeared in the input.
=cut
sub raw_text {
return $_[0]->{'-text'} unless (defined $_[0]->{'-name'});
return $_[0]->{'-prefix'} . $_[0]->{'-name'} .
$_[0]->{'-separator'} . $_[0]->{'-text'};
}
##---------------------------------------------------------------------------
=head2 $pod_para-E<gt>B<cmd_prefix()>
my $prefix = $pod_para->cmd_prefix();
If this paragraph is a command paragraph, then this method will return
the prefix used to denote the command (which should be the string "="
or "==").
=cut
sub cmd_prefix {
return $_[0]->{'-prefix'};
}
##---------------------------------------------------------------------------
=head2 $pod_para-E<gt>B<cmd_separator()>
my $separator = $pod_para->cmd_separator();
If this paragraph is a command paragraph, then this method will return
the text used to separate the command name from the rest of the
paragraph (if any).
=cut
sub cmd_separator {
return $_[0]->{'-separator'};
}
##---------------------------------------------------------------------------
=head2 $pod_para-E<gt>B<parse_tree()>
my $ptree = $pod_parser->parse_text( $pod_para->text() );
$pod_para->parse_tree( $ptree );
$ptree = $pod_para->parse_tree();
This method will get/set the corresponding parse-tree of the paragraph's text.
=cut
sub parse_tree {
(@_ > 1) and $_[0]->{'-ptree'} = $_[1];
return $_[0]->{'-ptree'};
}
## let ptree() be an alias for parse_tree()
*ptree = \&parse_tree;
##---------------------------------------------------------------------------
=head2 $pod_para-E<gt>B<file_line()>
my ($filename, $line_number) = $pod_para->file_line();
my $position = $pod_para->file_line();
Returns the current filename and line number for the paragraph
object. If called in a list context, it returns a list of two
elements: first the filename, then the line number. If called in
a scalar context, it returns a string containing the filename, followed
by a colon (':'), followed by the line number.
=cut
sub file_line {
my @loc = ($_[0]->{'-file'} || '<unknown-file>',
$_[0]->{'-line'} || 0);
return (wantarray) ? @loc : join(':', @loc);
}
##---------------------------------------------------------------------------
#############################################################################
package Pod::InteriorSequence;
##---------------------------------------------------------------------------
=head1 B<Pod::InteriorSequence>
An object representing a POD interior sequence command.
It has the following methods/attributes:
=cut
##---------------------------------------------------------------------------
=head2 Pod::InteriorSequence-E<gt>B<new()>
my $pod_seq1 = Pod::InteriorSequence->new(-name => $cmd
-ldelim => $delimiter);
my $pod_seq2 = Pod::InteriorSequence->new(-name => $cmd,
-ldelim => $delimiter);
my $pod_seq3 = Pod::InteriorSequence->new(-name => $cmd,
-ldelim => $delimiter,
-file => $filename,
-line => $line_number);
my $pod_seq4 = Pod::InteriorSequence->new(-name => $cmd, $ptree);
my $pod_seq5 = Pod::InteriorSequence->new($cmd, $ptree);
This is a class method that constructs a C<Pod::InteriorSequence> object
and returns a reference to the new interior sequence object. It should
be given two keyword arguments. The C<-ldelim> keyword indicates the
corresponding left-delimiter of the interior sequence (e.g. 'E<lt>').
The C<-name> keyword indicates the name of the corresponding interior
sequence command, such as C<I> or C<B> or C<C>. The C<-file> and
C<-line> keywords indicate the filename and line number corresponding
to the beginning of the interior sequence. If the C<$ptree> argument is
given, it must be the last argument, and it must be either string, or
else an array-ref suitable for passing to B<Pod::ParseTree::new> (or
it may be a reference to a Pod::ParseTree object).
=cut
sub new {
## Determine if we were called via an object-ref or a classname
my $this = shift;
my $class = ref($this) || $this;
## See if first argument has no keyword
if (((@_ <= 2) or (@_ % 2)) and $_[0] !~ /^-\w/) {
## Yup - need an implicit '-name' before first parameter
unshift @_, '-name';
}
## See if odd number of args
if ((@_ % 2) != 0) {
## Yup - need an implicit '-ptree' before the last parameter
splice @_, $#_, 0, '-ptree';
}
## Any remaining arguments are treated as initial values for the
## hash that is used to represent this object. Note that we default
## certain values by specifying them *before* the arguments passed.
## If they are in the argument list, they will override the defaults.
my $self = {
-name => (@_ == 1) ? $_[0] : undef,
-file => '<unknown-file>',
-line => 0,
-ldelim => '<',
-rdelim => '>',
@_
};
## Initialize contents if they havent been already
my $ptree = $self->{'-ptree'} || Pod::ParseTree->new();
if ( ref $ptree =~ /^(ARRAY)?$/ ) {
## We have an array-ref, or a normal scalar. Pass it as an
## an argument to the ptree-constructor
$ptree = Pod::ParseTree->new($1 ? [$ptree] : $ptree);
}
$self->{'-ptree'} = $ptree;
## Bless ourselves into the desired class and perform any initialization
bless $self, $class;
return $self;
}
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<cmd_name()>
my $seq_cmd = $pod_seq->cmd_name();
The name of the interior sequence command.
=cut
sub cmd_name {
(@_ > 1) and $_[0]->{'-name'} = $_[1];
return $_[0]->{'-name'};
}
## let name() be an alias for cmd_name()
*name = \&cmd_name;
##---------------------------------------------------------------------------
## Private subroutine to set the parent pointer of all the given
## children that are interior-sequences to be $self
sub _set_child2parent_links {
my ($self, @children) = @_;
## Make sure any sequences know who their parent is
for (@children) {
next unless (length and ref and ref ne 'SCALAR');
if (UNIVERSAL::isa($_, 'Pod::InteriorSequence') or
UNIVERSAL::can($_, 'nested'))
{
$_->nested($self);
}
}
}
## Private subroutine to unset child->parent links
sub _unset_child2parent_links {
my $self = shift;
$self->{'-parent_sequence'} = undef;
my $ptree = $self->{'-ptree'};
for (@$ptree) {
next unless (length and ref and ref ne 'SCALAR');
$_->_unset_child2parent_links()
if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
}
}
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<prepend()>
$pod_seq->prepend($text);
$pod_seq1->prepend($pod_seq2);
Prepends the given string or parse-tree or sequence object to the parse-tree
of this interior sequence.
=cut
sub prepend {
my $self = shift;
$self->{'-ptree'}->prepend(@_);
_set_child2parent_links($self, @_);
return $self;
}
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<append()>
$pod_seq->append($text);
$pod_seq1->append($pod_seq2);
Appends the given string or parse-tree or sequence object to the parse-tree
of this interior sequence.
=cut
sub append {
my $self = shift;
$self->{'-ptree'}->append(@_);
_set_child2parent_links($self, @_);
return $self;
}
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<nested()>
$outer_seq = $pod_seq->nested || print "not nested";
If this interior sequence is nested inside of another interior
sequence, then the outer/parent sequence that contains it is
returned. Otherwise C<undef> is returned.
=cut
sub nested {
my $self = shift;
(@_ == 1) and $self->{'-parent_sequence'} = shift;
return $self->{'-parent_sequence'} || undef;
}
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<raw_text()>
my $seq_raw_text = $pod_seq->raw_text();
This method will return the I<raw> text of the POD interior sequence,
exactly as it appeared in the input.
=cut
sub raw_text {
my $self = shift;
my $text = $self->{'-name'} . $self->{'-ldelim'};
for ( $self->{'-ptree'}->children ) {
$text .= (ref $_) ? $_->raw_text : $_;
}
$text .= $self->{'-rdelim'};
return $text;
}
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<left_delimiter()>
my $ldelim = $pod_seq->left_delimiter();
The leftmost delimiter beginning the argument text to the interior
sequence (should be "<").
=cut
sub left_delimiter {
(@_ > 1) and $_[0]->{'-ldelim'} = $_[1];
return $_[0]->{'-ldelim'};
}
## let ldelim() be an alias for left_delimiter()
*ldelim = \&left_delimiter;
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<right_delimiter()>
The rightmost delimiter beginning the argument text to the interior
sequence (should be ">").
=cut
sub right_delimiter {
(@_ > 1) and $_[0]->{'-rdelim'} = $_[1];
return $_[0]->{'-rdelim'};
}
## let rdelim() be an alias for right_delimiter()
*rdelim = \&right_delimiter;
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<parse_tree()>
my $ptree = $pod_parser->parse_text($paragraph_text);
$pod_seq->parse_tree( $ptree );
$ptree = $pod_seq->parse_tree();
This method will get/set the corresponding parse-tree of the interior
sequence's text.
=cut
sub parse_tree {
(@_ > 1) and $_[0]->{'-ptree'} = $_[1];
return $_[0]->{'-ptree'};
}
## let ptree() be an alias for parse_tree()
*ptree = \&parse_tree;
##---------------------------------------------------------------------------
=head2 $pod_seq-E<gt>B<file_line()>
my ($filename, $line_number) = $pod_seq->file_line();
my $position = $pod_seq->file_line();
Returns the current filename and line number for the interior sequence
object. If called in a list context, it returns a list of two
elements: first the filename, then the line number. If called in
a scalar context, it returns a string containing the filename, followed
by a colon (':'), followed by the line number.
=cut
sub file_line {
my @loc = ($_[0]->{'-file'} || '<unknown-file>',
$_[0]->{'-line'} || 0);
return (wantarray) ? @loc : join(':', @loc);
}
##---------------------------------------------------------------------------
=head2 Pod::InteriorSequence::B<DESTROY()>
This method performs any necessary cleanup for the interior-sequence.
If you override this method then it is B<imperative> that you invoke
the parent method from within your own method, otherwise
I<interior-sequence storage will not be reclaimed upon destruction!>
=cut
sub DESTROY {
## We need to get rid of all child->parent pointers throughout the
## tree so their reference counts will go to zero and they can be
## garbage-collected
_unset_child2parent_links(@_);
}
##---------------------------------------------------------------------------
#############################################################################
package Pod::ParseTree;
##---------------------------------------------------------------------------
=head1 B<Pod::ParseTree>
This object corresponds to a tree of parsed POD text. As POD text is
scanned from left to right, it is parsed into an ordered list of
text-strings and B<Pod::InteriorSequence> objects (in order of
appearance). A B<Pod::ParseTree> object corresponds to this list of
strings and sequences. Each interior sequence in the parse-tree may
itself contain a parse-tree (since interior sequences may be nested).
=cut
##---------------------------------------------------------------------------
=head2 Pod::ParseTree-E<gt>B<new()>
my $ptree1 = Pod::ParseTree->new;
my $ptree2 = Pod::ParseTree->new($array_ref);
This is a class method that constructs a C<Pod::Parse_tree> object and
returns a reference to the new parse-tree. If a single-argument is given,
it must be a reference to an array, and is used to initialize the root
(top) of the parse tree.
=cut
sub new {
## Determine if we were called via an object-ref or a classname
my $this = shift;
my $class = ref($this) || $this;
my $self = (@_ == 1 and ref $_[0]) ? $_[0] : [];
## Bless ourselves into the desired class and perform any initialization
bless $self, $class;
return $self;
}
##---------------------------------------------------------------------------
=head2 $ptree-E<gt>B<top()>
my $top_node = $ptree->top();
$ptree->top( $top_node );
$ptree->top( @children );
This method gets/sets the top node of the parse-tree. If no arguments are
given, it returns the topmost node in the tree (the root), which is also
a B<Pod::ParseTree>. If it is given a single argument that is a reference,
then the reference is assumed to a parse-tree and becomes the new top node.
Otherwise, if arguments are given, they are treated as the new list of
children for the top node.
=cut
sub top {
my $self = shift;
if (@_ > 0) {
@{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_;
}
return $self;
}
## let parse_tree() & ptree() be aliases for the 'top' method
*parse_tree = *ptree = \&top;
##---------------------------------------------------------------------------
=head2 $ptree-E<gt>B<children()>
This method gets/sets the children of the top node in the parse-tree.
If no arguments are given, it returns the list (array) of children
(each of which should be either a string or a B<Pod::InteriorSequence>.
Otherwise, if arguments are given, they are treated as the new list of
children for the top node.
=cut
sub children {
my $self = shift;
if (@_ > 0) {
@{ $self } = (@_ == 1 and ref $_[0]) ? ${ @_ } : @_;
}
return @{ $self };
}
##---------------------------------------------------------------------------
=head2 $ptree-E<gt>B<prepend()>
This method prepends the given text or parse-tree to the current parse-tree.
If the first item on the parse-tree is text and the argument is also text,
then the text is prepended to the first item (not added as a separate string).
Otherwise the argument is added as a new string or parse-tree I<before>
the current one.
=cut
use vars qw(@ptree); ## an alias used for performance reasons
sub prepend {
my $self = shift;
local *ptree = $self;
for (@_) {
next unless length;
if (@ptree && !(ref $ptree[0]) && !(ref $_)) {
$ptree[0] = $_ . $ptree[0];
}
else {
unshift @ptree, $_;
}
}
}
##---------------------------------------------------------------------------
=head2 $ptree-E<gt>B<append()>
This method appends the given text or parse-tree to the current parse-tree.
If the last item on the parse-tree is text and the argument is also text,
then the text is appended to the last item (not added as a separate string).
Otherwise the argument is added as a new string or parse-tree I<after>
the current one.
=cut
sub append {
my $self = shift;
local *ptree = $self;
my $can_append = @ptree && !(ref $ptree[-1]);
for (@_) {
if (ref) {
push @ptree, $_;
}
elsif(!length) {
next;
}
elsif ($can_append) {
$ptree[-1] .= $_;
}
else {
push @ptree, $_;
}
}
}
=head2 $ptree-E<gt>B<raw_text()>
my $ptree_raw_text = $ptree->raw_text();
This method will return the I<raw> text of the POD parse-tree
exactly as it appeared in the input.
=cut
sub raw_text {
my $self = shift;
my $text = '';
for ( @$self ) {
$text .= (ref $_) ? $_->raw_text : $_;
}
return $text;
}
##---------------------------------------------------------------------------
## Private routines to set/unset child->parent links
sub _unset_child2parent_links {
my $self = shift;
local *ptree = $self;
for (@ptree) {
next unless (defined and length and ref and ref ne 'SCALAR');
$_->_unset_child2parent_links()
if UNIVERSAL::isa($_, 'Pod::InteriorSequence');
}
}
sub _set_child2parent_links {
## nothing to do, Pod::ParseTrees cant have parent pointers
}
=head2 Pod::ParseTree::B<DESTROY()>
This method performs any necessary cleanup for the parse-tree.
If you override this method then it is B<imperative>
that you invoke the parent method from within your own method,
otherwise I<parse-tree storage will not be reclaimed upon destruction!>
=cut
sub DESTROY {
## We need to get rid of all child->parent pointers throughout the
## tree so their reference counts will go to zero and they can be
## garbage-collected
_unset_child2parent_links(@_);
}
#############################################################################
=head1 SEE ALSO
B<Pod::InputObjects> is part of the L<Pod::Parser> distribution.
See L<Pod::Parser>, L<Pod::Select>
=head1 AUTHOR
Please report bugs using L<http://rt.cpan.org>.
Brad Appleton E<lt>bradapp@enteract.comE<gt>
=cut
1;

1836
cpan/Pod-Usage/t/inc/Pod/Parser.pm
View File

File diff suppressed because it is too large Load Diff

751
cpan/Pod-Usage/t/inc/Pod/PlainText.pm
View File

@ -1,751 +0,0 @@
# Pod::PlainText -- Convert POD data to formatted ASCII text.
# $Id: Text.pm,v 2.1 1999/09/20 11:53:33 eagle Exp $
#
# Copyright 1999-2000 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# This module is intended to be a replacement for Pod::Text, and attempts to
# match its output except for some specific circumstances where other
# decisions seemed to produce better output. It uses Pod::Parser and is
# designed to be very easy to subclass.
############################################################################
# Modules and declarations
############################################################################
package Pod::PlainText;
use strict;
use warnings;
require 5.005;
use Carp qw(carp croak);
use Pod::Select ();
use vars qw(@ISA %ESCAPES $VERSION);
# We inherit from Pod::Select instead of Pod::Parser so that we can be used
# by Pod::Usage.
@ISA = qw(Pod::Select);
$VERSION = '2.06';
BEGIN {
if ($] < 5.006) {
require Symbol;
Symbol->import;
}
if ($] < 5.008 || ord "A" == 65) {
*to_native = sub { return chr shift; };
}
else {
*to_native = sub { return chr utf8::unicode_to_native(shift); };
}
}
############################################################################
# Table of supported E<> escapes
############################################################################
# This table is taken near verbatim from Pod::PlainText in Pod::Parser,
# which got it near verbatim from the original Pod::Text. It is therefore
# credited to Tom Christiansen, and I'm glad I didn't have to write it. :)
%ESCAPES = (
'amp' => '&', # ampersand
'lt' => '<', # left chevron, less-than
'gt' => '>', # right chevron, greater-than
'quot' => '"', # double quote
"Aacute" => to_native(0xC1), # capital A, acute accent
"aacute" => to_native(0xE1), # small a, acute accent
"Acirc" => to_native(0xC2), # capital A, circumflex accent
"acirc" => to_native(0xE2), # small a, circumflex accent
"AElig" => to_native(0xC6), # capital AE diphthong (ligature)
"aelig" => to_native(0xE6), # small ae diphthong (ligature)
"Agrave" => to_native(0xC0), # capital A, grave accent
"agrave" => to_native(0xE0), # small a, grave accent
"Aring" => to_native(0xC5), # capital A, ring
"aring" => to_native(0xE5), # small a, ring
"Atilde" => to_native(0xC3), # capital A, tilde
"atilde" => to_native(0xE3), # small a, tilde
"Auml" => to_native(0xC4), # capital A, dieresis or umlaut mark
"auml" => to_native(0xE4), # small a, dieresis or umlaut mark
"Ccedil" => to_native(0xC7), # capital C, cedilla
"ccedil" => to_native(0xE7), # small c, cedilla
"Eacute" => to_native(0xC9), # capital E, acute accent
"eacute" => to_native(0xE9), # small e, acute accent
"Ecirc" => to_native(0xCA), # capital E, circumflex accent
"ecirc" => to_native(0xEA), # small e, circumflex accent
"Egrave" => to_native(0xC8), # capital E, grave accent
"egrave" => to_native(0xE8), # small e, grave accent
"ETH" => to_native(0xD0), # capital Eth, Icelandic
"eth" => to_native(0xF0), # small eth, Icelandic
"Euml" => to_native(0xCB), # capital E, dieresis or umlaut mark
"euml" => to_native(0xEB), # small e, dieresis or umlaut mark
"Iacute" => to_native(0xCD), # capital I, acute accent
"iacute" => to_native(0xED), # small i, acute accent
"Icirc" => to_native(0xCE), # capital I, circumflex accent
"icirc" => to_native(0xEE), # small i, circumflex accent
"Igrave" => to_native(0xCD), # capital I, grave accent
"igrave" => to_native(0xED), # small i, grave accent
"Iuml" => to_native(0xCF), # capital I, dieresis or umlaut mark
"iuml" => to_native(0xEF), # small i, dieresis or umlaut mark
"Ntilde" => to_native(0xD1), # capital N, tilde
"ntilde" => to_native(0xF1), # small n, tilde
"Oacute" => to_native(0xD3), # capital O, acute accent
"oacute" => to_native(0xF3), # small o, acute accent
"Ocirc" => to_native(0xD4), # capital O, circumflex accent
"ocirc" => to_native(0xF4), # small o, circumflex accent
"Ograve" => to_native(0xD2), # capital O, grave accent
"ograve" => to_native(0xF2), # small o, grave accent
"Oslash" => to_native(0xD8), # capital O, slash
"oslash" => to_native(0xF8), # small o, slash
"Otilde" => to_native(0xD5), # capital O, tilde
"otilde" => to_native(0xF5), # small o, tilde
"Ouml" => to_native(0xD6), # capital O, dieresis or umlaut mark
"ouml" => to_native(0xF6), # small o, dieresis or umlaut mark
"szlig" => to_native(0xDF), # small sharp s, German (sz ligature)
"THORN" => to_native(0xDE), # capital THORN, Icelandic
"thorn" => to_native(0xFE), # small thorn, Icelandic
"Uacute" => to_native(0xDA), # capital U, acute accent
"uacute" => to_native(0xFA), # small u, acute accent
"Ucirc" => to_native(0xDB), # capital U, circumflex accent
"ucirc" => to_native(0xFB), # small u, circumflex accent
"Ugrave" => to_native(0xD9), # capital U, grave accent
"ugrave" => to_native(0xF9), # small u, grave accent
"Uuml" => to_native(0xDC), # capital U, dieresis or umlaut mark
"uuml" => to_native(0xFC), # small u, dieresis or umlaut mark
"Yacute" => to_native(0xDD), # capital Y, acute accent
"yacute" => to_native(0xFD), # small y, acute accent
"yuml" => to_native(0xFF), # small y, dieresis or umlaut mark
"lchevron" => to_native(0xAB), # left chevron (double less than)
"rchevron" => to_native(0xBB), # right chevron (double greater than)
);
############################################################################
# Initialization
############################################################################
# Initialize the object. Must be sure to call our parent initializer.
sub initialize {
my $self = shift;
$$self{alt} = 0 unless defined $$self{alt};
$$self{indent} = 4 unless defined $$self{indent};
$$self{loose} = 0 unless defined $$self{loose};
$$self{sentence} = 0 unless defined $$self{sentence};
$$self{width} = 76 unless defined $$self{width};
$$self{INDENTS} = []; # Stack of indentations.
$$self{MARGIN} = $$self{indent}; # Current left margin in spaces.
return $self->SUPER::initialize;
}
############################################################################
# Core overrides
############################################################################
# Called for each command paragraph. Gets the command, the associated
# paragraph, the line number, and a Pod::Paragraph object. Just dispatches
# the command to a method named the same as the command. =cut is handled
# internally by Pod::Parser.
sub command {
my $self = shift;
my $command = shift;
return if $command eq 'pod';
return if ($$self{EXCLUDE} && $command ne 'end');
if (defined $$self{ITEM}) {
$self->item ("\n");
local $_ = "\n";
$self->output($_) if($command eq 'back');
}
$command = 'cmd_' . $command;
return $self->$command (@_);
}
# Called for a verbatim paragraph. Gets the paragraph, the line number, and
# a Pod::Paragraph object. Just output it verbatim, but with tabs converted
# to spaces.
sub verbatim {
my $self = shift;
return if $$self{EXCLUDE};
$self->item if defined $$self{ITEM};
local $_ = shift;
return if /^\s*$/;
s/^(\s*\S+)/(' ' x $$self{MARGIN}) . $1/gme;
return $self->output($_);
}
# Called for a regular text block. Gets the paragraph, the line number, and
# a Pod::Paragraph object. Perform interpolation and output the results.
sub textblock {
my $self = shift;
return if $$self{EXCLUDE};
if($$self{VERBATIM}) {
$self->output($_[0]);
return;
}
local $_ = shift;
my $line = shift;
# Perform a little magic to collapse multiple L<> references. This is
# here mostly for backwards-compatibility. We'll just rewrite the whole
# thing into actual text at this part, bypassing the whole internal
# sequence parsing thing.
s{
(
L< # A link of the form L</something>.
/
(
[:\w]+ # The item has to be a simple word...
(\(\))? # ...or simple function.
)
>
(
,?\s+(and\s+)? # Allow lots of them, conjuncted.
L<
/
(
[:\w]+
(\(\))?
)
>
)+
)
} {
local $_ = $1;
s%L</([^>]+)>%$1%g;
my @items = split /(?:,?\s+(?:and\s+)?)/;
my $string = "the ";
my $i;
for ($i = 0; $i < @items; $i++) {
$string .= $items[$i];
$string .= ", " if @items > 2 && $i != $#items;
$string .= " and " if ($i == $#items - 1);
}
$string .= " entries elsewhere in this document";
$string;
}gex;
# Now actually interpolate and output the paragraph.
$_ = $self->interpolate ($_, $line);
s/\s*$/\n/s;
if (defined $$self{ITEM}) {
$self->item ($_ . "\n");
} else {
$self->output ($self->reformat ($_ . "\n"));
}
}
# Called for an interior sequence. Gets the command, argument, and a
# Pod::InteriorSequence object and is expected to return the resulting text.
# Calls code, bold, italic, file, and link to handle those types of
# sequences, and handles S<>, E<>, X<>, and Z<> directly.
sub interior_sequence {
my $self = shift;
my $command = shift;
local $_ = shift;
return '' if ($command eq 'X' || $command eq 'Z');
# Expand escapes into the actual character now, carping if invalid.
if ($command eq 'E') {
return $ESCAPES{$_} if defined $ESCAPES{$_};
carp "Unknown escape: E<$_>";
return "E<$_>";
}
# For all the other sequences, empty content produces no output.
return if $_ eq '';
# For S<>, compress all internal whitespace and then map spaces to \01.
# When we output the text, we'll map this back.
if ($command eq 'S') {
s/\s{2,}/ /g;
tr/ /\01/;
return $_;
}
# Anything else needs to get dispatched to another method.
if ($command eq 'B') { return $self->seq_b ($_) }
elsif ($command eq 'C') { return $self->seq_c ($_) }
elsif ($command eq 'F') { return $self->seq_f ($_) }
elsif ($command eq 'I') { return $self->seq_i ($_) }
elsif ($command eq 'L') { return $self->seq_l ($_) }
else { carp "Unknown sequence $command<$_>" }
}
# Called for each paragraph that's actually part of the POD. We take
# advantage of this opportunity to untabify the input.
sub preprocess_paragraph {
my $self = shift;
local $_ = shift;
1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;
return $_;
}
############################################################################
# Command paragraphs
############################################################################
# All command paragraphs take the paragraph and the line number.
# First level heading.
sub cmd_head1 {
my $self = shift;
local $_ = shift;
s/\s+$//s;
$_ = $self->interpolate ($_, shift);
if ($$self{alt}) {
$self->output ("\n==== $_ ====\n\n");
} else {
$_ .= "\n" if $$self{loose};
$self->output ($_ . "\n");
}
}
# Second level heading.
sub cmd_head2 {
my $self = shift;
local $_ = shift;
s/\s+$//s;
$_ = $self->interpolate ($_, shift);
if ($$self{alt}) {
$self->output ("\n== $_ ==\n\n");
} else {
$_ .= "\n" if $$self{loose};
$self->output (' ' x ($$self{indent} / 2) . $_ . "\n");
}
}
# third level heading - not strictly perlpodspec compliant
sub cmd_head3 {
my $self = shift;
local $_ = shift;
s/\s+$//s;
$_ = $self->interpolate ($_, shift);
if ($$self{alt}) {
$self->output ("\n= $_ =\n");
} else {
$_ .= "\n" if $$self{loose};
$self->output (' ' x ($$self{indent}) . $_ . "\n");
}
}
# fourth level heading - not strictly perlpodspec compliant
# just like head3
*cmd_head4 = \&cmd_head3;
# Start a list.
sub cmd_over {
my $self = shift;
local $_ = shift;
unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }
push (@{ $$self{INDENTS} }, $$self{MARGIN});
$$self{MARGIN} += ($_ + 0);
}
# End a list.
sub cmd_back {
my $self = shift;
$$self{MARGIN} = pop @{ $$self{INDENTS} };
unless (defined $$self{MARGIN}) {
carp 'Unmatched =back';
$$self{MARGIN} = $$self{indent};
}
}
# An individual list item.
sub cmd_item {
my $self = shift;
if (defined $$self{ITEM}) { $self->item }
local $_ = shift;
s/\s+$//s;
$$self{ITEM} = $self->interpolate ($_);
}
# Begin a block for a particular translator. Setting VERBATIM triggers
# special handling in textblock().
sub cmd_begin {
my $self = shift;
local $_ = shift;
my ($kind) = /^(\S+)/ or return;
if ($kind eq 'text') {
$$self{VERBATIM} = 1;
} else {
$$self{EXCLUDE} = 1;
}
}
# End a block for a particular translator. We assume that all =begin/=end
# pairs are properly closed.
sub cmd_end {
my $self = shift;
$$self{EXCLUDE} = 0;
$$self{VERBATIM} = 0;
}
# One paragraph for a particular translator. Ignore it unless it's intended
# for text, in which case we treat it as a verbatim text block.
sub cmd_for {
my $self = shift;
local $_ = shift;
my $line = shift;
return unless s/^text\b[ \t]*\r?\n?//;
$self->verbatim ($_, $line);
}
# just a dummy method for the time being
sub cmd_encoding {
return;
}
############################################################################
# Interior sequences
############################################################################
# The simple formatting ones. These are here mostly so that subclasses can
# override them and do more complicated things.
sub seq_b { return $_[0]{alt} ? "``$_[1]''" : $_[1] }
sub seq_c { return $_[0]{alt} ? "``$_[1]''" : "`$_[1]'" }
sub seq_f { return $_[0]{alt} ? "\"$_[1]\"" : $_[1] }
sub seq_i { return '*' . $_[1] . '*' }
# The complicated one. Handle links. Since this is plain text, we can't
# actually make any real links, so this is all to figure out what text we
# print out.
sub seq_l {
my $self = shift;
local $_ = shift;
# Smash whitespace in case we were split across multiple lines.
s/\s+/ /g;
# If we were given any explicit text, just output it.
if (/^([^|]+)\|/) { return $1 }
# Okay, leading and trailing whitespace isn't important; get rid of it.
s/^\s+//;
s/\s+$//;
# Default to using the whole content of the link entry as a section
# name. Note that L<manpage/> forces a manpage interpretation, as does
# something looking like L<manpage(section)>. The latter is an
# enhancement over the original Pod::Text.
my ($manpage, $section) = ('', $_);
if (/^(?:https?|ftp|news):/) {
# a URL
return $_;
} elsif (/^"\s*(.*?)\s*"$/) {
$section = '"' . $1 . '"';
} elsif (m/^[-:.\w]+(?:\(\S+\))?$/) {
($manpage, $section) = ($_, '');
} elsif (m{/}) {
($manpage, $section) = split (/\s*\/\s*/, $_, 2);
}
my $text = '';
# Now build the actual output text.
if (!length $section) {
$text = "the $manpage manpage" if length $manpage;
} elsif ($section =~ /^[:\w]+(?:\(\))?/) {
$text .= 'the ' . $section . ' entry';
$text .= (length $manpage) ? " in the $manpage manpage"
: ' elsewhere in this document';
} else {
$section =~ s/^\"\s*//;
$section =~ s/\s*\"$//;
$text .= 'the section on "' . $section . '"';
$text .= " in the $manpage manpage" if length $manpage;
}
return $text;
}
############################################################################
# List handling
############################################################################
# This method is called whenever an =item command is complete (in other
# words, we've seen its associated paragraph or know for certain that it
# doesn't have one). It gets the paragraph associated with the item as an
# argument. If that argument is empty, just output the item tag; if it
# contains a newline, output the item tag followed by the newline.
# Otherwise, see if there's enough room for us to output the item tag in the
# margin of the text or if we have to put it on a separate line.
sub item {
my $self = shift;
local $_ = shift;
my $tag = $$self{ITEM};
unless (defined $tag) {
carp 'item called without tag';
return;
}
undef $$self{ITEM};
my $indent = $$self{INDENTS}[-1];
unless (defined $indent) { $indent = $$self{indent} }
my $space = ' ' x $indent;
$space =~ s/^ /:/ if $$self{alt};
if (!$_ || /^\s+$/ || ($$self{MARGIN} - $indent < length ($tag) + 1)) {
my $margin = $$self{MARGIN};
$$self{MARGIN} = $indent;
my $output = $self->reformat ($tag);
$output =~ s/[\r\n]*$/\n/;
$self->output ($output);
$$self{MARGIN} = $margin;
$self->output ($self->reformat ($_)) if /\S/;
} else {
$_ = $self->reformat ($_);
s/^ /:/ if ($$self{alt} && $indent > 0);
my $tagspace = ' ' x length $tag;
s/^($space)$tagspace/$1$tag/ or carp 'Bizarre space in item';
$self->output ($_);
}
}
############################################################################
# Output formatting
############################################################################
# Wrap a line, indenting by the current left margin. We can't use
# Text::Wrap because it plays games with tabs. We can't use formline, even
# though we'd really like to, because it screws up non-printing characters.
# So we have to do the wrapping ourselves.
sub wrap {
my $self = shift;
local $_ = shift;
my $output = '';
my $spaces = ' ' x $$self{MARGIN};
my $width = $$self{width} - $$self{MARGIN};
while (length > $width) {
if (s/^([^\r\n]{0,$width})\s+// || s/^([^\r\n]{$width})//) {
$output .= $spaces . $1 . "\n";
} else {
last;
}
}
$output .= $spaces . $_;
$output =~ s/\s+$/\n\n/;
return $output;
}
# Reformat a paragraph of text for the current margin. Takes the text to
# reformat and returns the formatted text.
sub reformat {
my $self = shift;
local $_ = shift;
# If we're trying to preserve two spaces after sentences, do some
# munging to support that. Otherwise, smash all repeated whitespace.
if ($$self{sentence}) {
s/ +$//mg;
s/\.\r?\n/. \n/g;
s/[\r\n]+/ /g;
s/ +/ /g;
} else {
s/\s+/ /g;
}
return $self->wrap($_);
}
# Output text to the output device.
sub output { $_[1] =~ tr/\01/ /; print { $_[0]->output_handle } $_[1] }
############################################################################
# Backwards compatibility
############################################################################
# The old Pod::Text module did everything in a pod2text() function. This
# tries to provide the same interface for legacy applications.
sub pod2text {
my @args;
# This is really ugly; I hate doing option parsing in the middle of a
# module. But the old Pod::Text module supported passing flags to its
# entry function, so handle -a and -<number>.
while ($_[0] =~ /^-/) {
my $flag = shift;
if ($flag eq '-a') { push (@args, alt => 1) }
elsif ($flag =~ /^-(\d+)$/) { push (@args, width => $1) }
else {
unshift (@_, $flag);
last;
}
}
# Now that we know what arguments we're using, create the parser.
my $parser = Pod::PlainText->new (@args);
# If two arguments were given, the second argument is going to be a file
# handle. That means we want to call parse_from_filehandle(), which
# means we need to turn the first argument into a file handle. Magic
# open will handle the <&STDIN case automagically.
if (defined $_[1]) {
my $infh;
if ($] < 5.006) {
$infh = gensym();
}
unless (open ($infh, $_[0])) {
croak ("Can't open $_[0] for reading: $!\n");
}
$_[0] = $infh;
return $parser->parse_from_filehandle (@_);
} else {
return $parser->parse_from_file (@_);
}
}
############################################################################
# Module return value and documentation
############################################################################
1;
__END__
=head1 NAME
Pod::PlainText - Convert POD data to formatted ASCII text
=head1 SYNOPSIS
use Pod::PlainText;
my $parser = Pod::PlainText->new (sentence => 0, width => 78);
# Read POD from STDIN and write to STDOUT.
$parser->parse_from_filehandle;
# Read POD from file.pod and write to file.txt.
$parser->parse_from_file ('file.pod', 'file.txt');
=head1 DESCRIPTION
Pod::PlainText is a module that can convert documentation in the POD format (the
preferred language for documenting Perl) into formatted ASCII. It uses no
special formatting controls or codes whatsoever, and its output is therefore
suitable for nearly any device.
As a derived class from Pod::Parser, Pod::PlainText supports the same methods and
interfaces. See L<Pod::Parser> for all the details; briefly, one creates a
new parser with C<Pod::PlainText-E<gt>new()> and then calls either
parse_from_filehandle() or parse_from_file().
new() can take options, in the form of key/value pairs, that control the
behavior of the parser. The currently recognized options are:
=over 4
=item alt
If set to a true value, selects an alternate output format that, among other
things, uses a different heading style and marks C<=item> entries with a
colon in the left margin. Defaults to false.
=item indent
The number of spaces to indent regular text, and the default indentation for
C<=over> blocks. Defaults to 4.
=item loose
If set to a true value, a blank line is printed after a C<=headN> headings.
If set to false (the default), no blank line is printed after C<=headN>.
This is the default because it's the expected formatting for manual pages;
if you're formatting arbitrary text documents, setting this to true may
result in more pleasing output.
=item sentence
If set to a true value, Pod::PlainText will assume that each sentence ends in two
spaces, and will try to preserve that spacing. If set to false, all
consecutive whitespace in non-verbatim paragraphs is compressed into a
single space. Defaults to true.
=item width
The column at which to wrap text on the right-hand side. Defaults to 76.
=back
The standard Pod::Parser method parse_from_filehandle() takes up to two
arguments, the first being the file handle to read POD from and the second
being the file handle to write the formatted output to. The first defaults
to STDIN if not given, and the second defaults to STDOUT. The method
parse_from_file() is almost identical, except that its two arguments are the
input and output disk files instead. See L<Pod::Parser> for the specific
details.
=head1 DIAGNOSTICS
=over 4
=item Bizarre space in item
(W) Something has gone wrong in internal C<=item> processing. This message
indicates a bug in Pod::PlainText; you should never see it.
=item Can't open %s for reading: %s
(F) Pod::PlainText was invoked via the compatibility mode pod2text() interface
and the input file it was given could not be opened.
=item Unknown escape: %s
(W) The POD source contained an C<EE<lt>E<gt>> escape that Pod::PlainText didn't
know about.
=item Unknown sequence: %s
(W) The POD source contained a non-standard internal sequence (something of
the form C<XE<lt>E<gt>>) that Pod::PlainText didn't know about.
=item Unmatched =back
(W) Pod::PlainText encountered a C<=back> command that didn't correspond to an
C<=over> command.
=back
=head1 RESTRICTIONS
Embedded Ctrl-As (octal 001) in the input will be mapped to spaces on
output, due to an internal implementation detail.
=head1 NOTES
This is a replacement for an earlier Pod::Text module written by Tom
Christiansen. It has a revamped interface, since it now uses Pod::Parser,
but an interface roughly compatible with the old Pod::Text::pod2text()
function is still available. Please change to the new calling convention,
though.
The original Pod::Text contained code to do formatting via termcap
sequences, although it wasn't turned on by default and it was problematic to
get it to work at all. This rewrite doesn't even try to do that, but a
subclass of it does. Look for L<Pod::Text::Termcap|Pod::Text::Termcap>.
=head1 SEE ALSO
B<Pod::PlainText> is part of the L<Pod::Parser> distribution.
L<Pod::Parser|Pod::Parser>, L<Pod::Text::Termcap|Pod::Text::Termcap>,
pod2text(1)
=head1 AUTHOR
Please report bugs using L<http://rt.cpan.org>.
Russ Allbery E<lt>rra@stanford.eduE<gt>, based I<very> heavily on the
original Pod::Text by Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> and
its conversion to Pod::Parser by Brad Appleton
E<lt>bradapp@enteract.comE<gt>.
=cut

749
cpan/Pod-Usage/t/inc/Pod/Select.pm
View File

@ -1,749 +0,0 @@
#############################################################################
# Pod/Select.pm -- function to select portions of POD docs
#
# Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################
package Pod::Select;
use strict;
use warnings;
use vars qw($VERSION @ISA @EXPORT $MAX_HEADING_LEVEL %myData @section_headings @selected_sections);
$VERSION = '1.60'; ## Current version of this package
require 5.005; ## requires this Perl version or later
#############################################################################
=head1 NAME
Pod::Select, podselect() - extract selected sections of POD from input
=head1 SYNOPSIS
use Pod::Select;
## Select all the POD sections for each file in @filelist
## and print the result on standard output.
podselect(@filelist);
## Same as above, but write to tmp.out
podselect({-output => "tmp.out"}, @filelist):
## Select from the given filelist, only those POD sections that are
## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.
podselect({-sections => ["NAME|SYNOPSIS", "OPTIONS"]}, @filelist):
## Select the "DESCRIPTION" section of the PODs from STDIN and write
## the result to STDERR.
podselect({-output => ">&STDERR", -sections => ["DESCRIPTION"]}, \*STDIN);
or
use Pod::Select;
## Create a parser object for selecting POD sections from the input
$parser = Pod::Select->new();
## Select all the POD sections for each file in @filelist
## and print the result to tmp.out.
$parser->parse_from_file("<&STDIN", "tmp.out");
## Select from the given filelist, only those POD sections that are
## within a 1st level section named any of: NAME, SYNOPSIS, OPTIONS.
$parser->select("NAME|SYNOPSIS", "OPTIONS");
for (@filelist) { $parser->parse_from_file($_); }
## Select the "DESCRIPTION" and "SEE ALSO" sections of the PODs from
## STDIN and write the result to STDERR.
$parser->select("DESCRIPTION");
$parser->add_selection("SEE ALSO");
$parser->parse_from_filehandle(\*STDIN, \*STDERR);
=head1 REQUIRES
perl5.005, Pod::Parser, Exporter, Carp
=head1 EXPORTS
podselect()
=head1 DESCRIPTION
B<podselect()> is a function which will extract specified sections of
pod documentation from an input stream. This ability is provided by the
B<Pod::Select> module which is a subclass of B<Pod::Parser>.
B<Pod::Select> provides a method named B<select()> to specify the set of
POD sections to select for processing/printing. B<podselect()> merely
creates a B<Pod::Select> object and then invokes the B<podselect()>
followed by B<parse_from_file()>.
=head1 SECTION SPECIFICATIONS
B<podselect()> and B<Pod::Select::select()> may be given one or more
"section specifications" to restrict the text processed to only the
desired set of sections and their corresponding subsections. A section
specification is a string containing one or more Perl-style regular
expressions separated by forward slashes ("/"). If you need to use a
forward slash literally within a section title you can escape it with a
backslash ("\/").
The formal syntax of a section specification is:
=over 4
=item *
I<head1-title-regex>/I<head2-title-regex>/...
=back
Any omitted or empty regular expressions will default to ".*".
Please note that each regular expression given is implicitly
anchored by adding "^" and "$" to the beginning and end. Also, if a
given regular expression starts with a "!" character, then the
expression is I<negated> (so C<!foo> would match anything I<except>
C<foo>).
Some example section specifications follow.
=over 4
=item *
Match the C<NAME> and C<SYNOPSIS> sections and all of their subsections:
C<NAME|SYNOPSIS>
=item *
Match only the C<Question> and C<Answer> subsections of the C<DESCRIPTION>
section:
C<DESCRIPTION/Question|Answer>
=item *
Match the C<Comments> subsection of I<all> sections:
C</Comments>
=item *
Match all subsections of C<DESCRIPTION> I<except> for C<Comments>:
C<DESCRIPTION/!Comments>
=item *
Match the C<DESCRIPTION> section but do I<not> match any of its subsections:
C<DESCRIPTION/!.+>
=item *
Match all top level sections but none of their subsections:
C</!.+>
=back
=begin _NOT_IMPLEMENTED_
=head1 RANGE SPECIFICATIONS
B<podselect()> and B<Pod::Select::select()> may be given one or more
"range specifications" to restrict the text processed to only the
desired ranges of paragraphs in the desired set of sections. A range
specification is a string containing a single Perl-style regular
expression (a regex), or else two Perl-style regular expressions
(regexs) separated by a ".." (Perl's "range" operator is "..").
The regexs in a range specification are delimited by forward slashes
("/"). If you need to use a forward slash literally within a regex you
can escape it with a backslash ("\/").
The formal syntax of a range specification is:
=over 4
=item *
/I<start-range-regex>/[../I<end-range-regex>/]
=back
Where each the item inside square brackets (the ".." followed by the
end-range-regex) is optional. Each "range-regex" is of the form:
=cmd-expr text-expr
Where I<cmd-expr> is intended to match the name of one or more POD
commands, and I<text-expr> is intended to match the paragraph text for
the command. If a range-regex is supposed to match a POD command, then
the first character of the regex (the one after the initial '/')
absolutely I<must> be a single '=' character; it may not be anything
else (not even a regex meta-character) if it is supposed to match
against the name of a POD command.
If no I<=cmd-expr> is given then the text-expr will be matched against
plain textblocks unless it is preceded by a space, in which case it is
matched against verbatim text-blocks. If no I<text-expr> is given then
only the command-portion of the paragraph is matched against.
Note that these two expressions are each implicitly anchored. This
means that when matching against the command-name, there will be an
implicit '^' and '$' around the given I<=cmd-expr>; and when matching
against the paragraph text there will be an implicit '\A' and '\Z'
around the given I<text-expr>.
Unlike with section-specs, the '!' character does I<not> have any special
meaning (negation or otherwise) at the beginning of a range-spec!
Some example range specifications follow.
=over 4
=item
Match all C<=for html> paragraphs:
C</=for html/>
=item
Match all paragraphs between C<=begin html> and C<=end html>
(note that this will I<not> work correctly if such sections
are nested):
C</=begin html/../=end html/>
=item
Match all paragraphs between the given C<=item> name until the end of the
current section:
C</=item mine/../=head\d/>
=item
Match all paragraphs between the given C<=item> until the next item, or
until the end of the itemized list (note that this will I<not> work as
desired if the item contains an itemized list nested within it):
C</=item mine/../=(item|back)/>
=back
=end _NOT_IMPLEMENTED_
=cut
#############################################################################
#use diagnostics;
use Carp;
use Pod::Parser 1.04;
@ISA = qw(Pod::Parser);
@EXPORT = qw(&podselect);
## Maximum number of heading levels supported for '=headN' directives
*MAX_HEADING_LEVEL = \3;
#############################################################################
=head1 OBJECT METHODS
The following methods are provided in this module. Each one takes a
reference to the object itself as an implicit first parameter.
=cut
##---------------------------------------------------------------------------
## =begin _PRIVATE_
##
## =head1 B<_init_headings()>
##
## Initialize the current set of active section headings.
##
## =cut
##
## =end _PRIVATE_
sub _init_headings {
my $self = shift;
local *myData = $self;
## Initialize current section heading titles if necessary
unless (defined $myData{_SECTION_HEADINGS}) {
local *section_headings = $myData{_SECTION_HEADINGS} = [];
for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
$section_headings[$i] = '';
}
}
}
##---------------------------------------------------------------------------
=head1 B<curr_headings()>
($head1, $head2, $head3, ...) = $parser->curr_headings();
$head1 = $parser->curr_headings(1);
This method returns a list of the currently active section headings and
subheadings in the document being parsed. The list of headings returned
corresponds to the most recently parsed paragraph of the input.
If an argument is given, it must correspond to the desired section
heading number, in which case only the specified section heading is
returned. If there is no current section heading at the specified
level, then C<undef> is returned.
=cut
sub curr_headings {
my $self = shift;
$self->_init_headings() unless (defined $self->{_SECTION_HEADINGS});
my @headings = @{ $self->{_SECTION_HEADINGS} };
return (@_ > 0 and $_[0] =~ /^\d+$/) ? $headings[$_[0] - 1] : @headings;
}
##---------------------------------------------------------------------------
=head1 B<select()>
$parser->select($section_spec1,$section_spec2,...);
This method is used to select the particular sections and subsections of
POD documentation that are to be printed and/or processed. The existing
set of selected sections is I<replaced> with the given set of sections.
See B<add_selection()> for adding to the current set of selected
sections.
Each of the C<$section_spec> arguments should be a section specification
as described in L<"SECTION SPECIFICATIONS">. The section specifications
are parsed by this method and the resulting regular expressions are
stored in the invoking object.
If no C<$section_spec> arguments are given, then the existing set of
selected sections is cleared out (which means C<all> sections will be
processed).
This method should I<not> normally be overridden by subclasses.
=cut
sub select {
my ($self, @sections) = @_;
local *myData = $self;
local $_;
### NEED TO DISCERN A SECTION-SPEC FROM A RANGE-SPEC (look for m{^/.+/$}?)
##---------------------------------------------------------------------
## The following is a blatant hack for backward compatibility, and for
## implementing add_selection(). If the *first* *argument* is the
## string "+", then the remaining section specifications are *added*
## to the current set of selections; otherwise the given section
## specifications will *replace* the current set of selections.
##
## This should probably be fixed someday, but for the present time,
## it seems incredibly unlikely that "+" would ever correspond to
## a legitimate section heading
##---------------------------------------------------------------------
my $add = ($sections[0] eq '+') ? shift(@sections) : '';
## Reset the set of sections to use
unless (@sections) {
delete $myData{_SELECTED_SECTIONS} unless ($add);
return;
}
$myData{_SELECTED_SECTIONS} = []
unless ($add && exists $myData{_SELECTED_SECTIONS});
local *selected_sections = $myData{_SELECTED_SECTIONS};
## Compile each spec
for my $spec (@sections) {
if ( defined($_ = _compile_section_spec($spec)) ) {
## Store them in our sections array
push(@selected_sections, $_);
}
else {
carp qq{Ignoring section spec "$spec"!\n};
}
}
}
##---------------------------------------------------------------------------
=head1 B<add_selection()>
$parser->add_selection($section_spec1,$section_spec2,...);
This method is used to add to the currently selected sections and
subsections of POD documentation that are to be printed and/or
processed. See <select()> for replacing the currently selected sections.
Each of the C<$section_spec> arguments should be a section specification
as described in L<"SECTION SPECIFICATIONS">. The section specifications
are parsed by this method and the resulting regular expressions are
stored in the invoking object.
This method should I<not> normally be overridden by subclasses.
=cut
sub add_selection {
my $self = shift;
return $self->select('+', @_);
}
##---------------------------------------------------------------------------
=head1 B<clear_selections()>
$parser->clear_selections();
This method takes no arguments, it has the exact same effect as invoking
<select()> with no arguments.
=cut
sub clear_selections {
my $self = shift;
return $self->select();
}
##---------------------------------------------------------------------------
=head1 B<match_section()>
$boolean = $parser->match_section($heading1,$heading2,...);
Returns a value of true if the given section and subsection heading
titles match any of the currently selected section specifications in
effect from prior calls to B<select()> and B<add_selection()> (or if
there are no explicitly selected/deselected sections).
The arguments C<$heading1>, C<$heading2>, etc. are the heading titles of
the corresponding sections, subsections, etc. to try and match. If
C<$headingN> is omitted then it defaults to the current corresponding
section heading title in the input.
This method should I<not> normally be overridden by subclasses.
=cut
sub match_section {
my $self = shift;
my (@headings) = @_;
local *myData = $self;
## Return true if no restrictions were explicitly specified
my $selections = (exists $myData{_SELECTED_SECTIONS})
? $myData{_SELECTED_SECTIONS} : undef;
return 1 unless ((defined $selections) && @{$selections});
## Default any unspecified sections to the current one
my @current_headings = $self->curr_headings();
for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
(defined $headings[$i]) or $headings[$i] = $current_headings[$i];
}
## Look for a match against the specified section expressions
for my $section_spec ( @{$selections} ) {
##------------------------------------------------------
## Each portion of this spec must match in order for
## the spec to be matched. So we will start with a
## match-value of 'true' and logically 'and' it with
## the results of matching a given element of the spec.
##------------------------------------------------------
my $match = 1;
for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
my $regex = $section_spec->[$i];
my $negated = ($regex =~ s/^\!//);
$match &= ($negated ? ($headings[$i] !~ /${regex}/)
: ($headings[$i] =~ /${regex}/));
last unless ($match);
}
return 1 if ($match);
}
return 0; ## no match
}
##---------------------------------------------------------------------------
=head1 B<is_selected()>
$boolean = $parser->is_selected($paragraph);
This method is used to determine if the block of text given in
C<$paragraph> falls within the currently selected set of POD sections
and subsections to be printed or processed. This method is also
responsible for keeping track of the current input section and
subsections. It is assumed that C<$paragraph> is the most recently read
(but not yet processed) input paragraph.
The value returned will be true if the C<$paragraph> and the rest of the
text in the same section as C<$paragraph> should be selected (included)
for processing; otherwise a false value is returned.
=cut
sub is_selected {
my ($self, $paragraph) = @_;
local $_;
local *myData = $self;
$self->_init_headings() unless (defined $myData{_SECTION_HEADINGS});
## Keep track of current sections levels and headings
$_ = $paragraph;
if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*?)\s*$/)
{
## This is a section heading command
my ($level, $heading) = ($2, $3);
$level = 1 + (length($1) / 3) if ((! length $level) || (length $1));
## Reset the current section heading at this level
$myData{_SECTION_HEADINGS}->[$level - 1] = $heading;
## Reset subsection headings of this one to empty
for (my $i = $level; $i < $MAX_HEADING_LEVEL; ++$i) {
$myData{_SECTION_HEADINGS}->[$i] = '';
}
}
return $self->match_section();
}
#############################################################################
=head1 EXPORTED FUNCTIONS
The following functions are exported by this module. Please note that
these are functions (not methods) and therefore C<do not> take an
implicit first argument.
=cut
##---------------------------------------------------------------------------
=head1 B<podselect()>
podselect(\%options,@filelist);
B<podselect> will print the raw (untranslated) POD paragraphs of all
POD sections in the given input files specified by C<@filelist>
according to the given options.
If any argument to B<podselect> is a reference to a hash
(associative array) then the values with the following keys are
processed as follows:
=over 4
=item B<-output>
A string corresponding to the desired output file (or ">&STDOUT"
or ">&STDERR"). The default is to use standard output.
=item B<-sections>
A reference to an array of sections specifications (as described in
L<"SECTION SPECIFICATIONS">) which indicate the desired set of POD
sections and subsections to be selected from input. If no section
specifications are given, then all sections of the PODs are used.
=begin _NOT_IMPLEMENTED_
=item B<-ranges>
A reference to an array of range specifications (as described in
L<"RANGE SPECIFICATIONS">) which indicate the desired range of POD
paragraphs to be selected from the desired input sections. If no range
specifications are given, then all paragraphs of the desired sections
are used.
=end _NOT_IMPLEMENTED_
=back
All other arguments should correspond to the names of input files
containing POD sections. A file name of "-" or "<&STDIN" will
be interpreted to mean standard input (which is the default if no
filenames are given).
=cut
sub podselect {
my(@argv) = @_;
my %defaults = ();
my $pod_parser = Pod::Select->new(%defaults);
my $num_inputs = 0;
my $output = '>&STDOUT';
my %opts;
local $_;
for (@argv) {
if (ref($_)) {
next unless (ref($_) eq 'HASH');
%opts = (%defaults, %{$_});
##-------------------------------------------------------------
## Need this for backward compatibility since we formerly used
## options that were all uppercase words rather than ones that
## looked like Unix command-line options.
## to be uppercase keywords)
##-------------------------------------------------------------
%opts = map {
my ($key, $val) = (lc $_, $opts{$_});
$key =~ s/^(?=\w)/-/;
$key =~ /^-se[cl]/ and $key = '-sections';
#! $key eq '-range' and $key .= 's';
($key => $val);
} (keys %opts);
## Process the options
(exists $opts{'-output'}) and $output = $opts{'-output'};
## Select the desired sections
$pod_parser->select(@{ $opts{'-sections'} })
if ( (defined $opts{'-sections'})
&& ((ref $opts{'-sections'}) eq 'ARRAY') );
#! ## Select the desired paragraph ranges
#! $pod_parser->select(@{ $opts{'-ranges'} })
#! if ( (defined $opts{'-ranges'})
#! && ((ref $opts{'-ranges'}) eq 'ARRAY') );
}
else {
$pod_parser->parse_from_file($_, $output);
++$num_inputs;
}
}
$pod_parser->parse_from_file('-') unless ($num_inputs > 0);
}
#############################################################################
=head1 PRIVATE METHODS AND DATA
B<Pod::Select> makes uses a number of internal methods and data fields
which clients should not need to see or use. For the sake of avoiding
name collisions with client data and methods, these methods and fields
are briefly discussed here. Determined hackers may obtain further
information about them by reading the B<Pod::Select> source code.
Private data fields are stored in the hash-object whose reference is
returned by the B<new()> constructor for this class. The names of all
private methods and data-fields used by B<Pod::Select> begin with a
prefix of "_" and match the regular expression C</^_\w+$/>.
=cut
##---------------------------------------------------------------------------
=begin _PRIVATE_
=head1 B<_compile_section_spec()>
$listref = $parser->_compile_section_spec($section_spec);
This function (note it is a function and I<not> a method) takes a
section specification (as described in L<"SECTION SPECIFICATIONS">)
given in C<$section_sepc>, and compiles it into a list of regular
expressions. If C<$section_spec> has no syntax errors, then a reference
to the list (array) of corresponding regular expressions is returned;
otherwise C<undef> is returned and an error message is printed (using
B<carp>) for each invalid regex.
=end _PRIVATE_
=cut
sub _compile_section_spec {
my ($section_spec) = @_;
my (@regexs, $negated);
## Compile the spec into a list of regexs
local $_ = $section_spec;
s{\\\\}{\001}g; ## handle escaped backward slashes
s{\\/}{\002}g; ## handle escaped forward slashes
## Parse the regexs for the heading titles
@regexs = split(/\//, $_, $MAX_HEADING_LEVEL);
## Set default regex for ommitted levels
for (my $i = 0; $i < $MAX_HEADING_LEVEL; ++$i) {
$regexs[$i] = '.*' unless ((defined $regexs[$i])
&& (length $regexs[$i]));
}
## Modify the regexs as needed and validate their syntax
my $bad_regexs = 0;
for (@regexs) {
$_ .= '.+' if ($_ eq '!');
s{\001}{\\\\}g; ## restore escaped backward slashes
s{\002}{\\/}g; ## restore escaped forward slashes
$negated = s/^\!//; ## check for negation
eval "m{$_}"; ## check regex syntax
if ($@) {
++$bad_regexs;
carp qq{Bad regular expression /$_/ in "$section_spec": $@\n};
}
else {
## Add the forward and rear anchors (and put the negator back)
$_ = '^' . $_ unless (/^\^/);
$_ = $_ . '$' unless (/\$$/);
$_ = '!' . $_ if ($negated);
}
}
return (! $bad_regexs) ? [ @regexs ] : undef;
}
##---------------------------------------------------------------------------
=begin _PRIVATE_
=head2 $self->{_SECTION_HEADINGS}
A reference to an array of the current section heading titles for each
heading level (note that the first heading level title is at index 0).
=end _PRIVATE_
=cut
##---------------------------------------------------------------------------
=begin _PRIVATE_
=head2 $self->{_SELECTED_SECTIONS}
A reference to an array of references to arrays. Each subarray is a list
of anchored regular expressions (preceded by a "!" if the expression is to
be negated). The index of the expression in the subarray should correspond
to the index of the heading title in C<$self-E<gt>{_SECTION_HEADINGS}>
that it is to be matched against.
=end _PRIVATE_
=cut
#############################################################################
=head1 SEE ALSO
L<Pod::Parser>
=head1 AUTHOR
Please report bugs using L<http://rt.cpan.org>.
Brad Appleton E<lt>bradapp@enteract.comE<gt>
Based on code for B<pod2text> written by
Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
B<Pod::Select> is part of the L<Pod::Parser> distribution.
=cut
1;
# vim: ts=4 sw=4 et

40
cpan/Pod-Usage/t/pod/pod2usage.t
View File

@ -1,21 +1,41 @@
use strict;
use warnings;
use Test::More tests => 1;
use File::Basename;
use File::Spec;
use Cwd qw(abs_path);
my $THISDIR;
BEGIN {
use File::Basename;
my $THISDIR = dirname $0;
unshift @INC, $THISDIR;
require "testp2pt.pl";
TestPodIncPlainText->import;
$THISDIR = dirname(abs_path(__FILE__));
unshift @INC, $THISDIR;
require "testcmp.pl";
TestCompare->import;
}
my %options = map { $_ => 1 } @ARGV; ## convert cmdline to options-hash
my $passed = testpodplaintext \%options, $0;
exit( ($passed == 1) ? 0 : -1 ) unless $ENV{HARNESS_ACTIVE};
use Pod::Text;
my $infile = File::Spec->catfile($THISDIR, (File::Spec->updir) x 2, 'scripts', 'pod2usage.PL');
my $cmpfile = File::Spec->catfile($THISDIR, 'pod2usage.xr');
my $outfile = File::Spec->catfile($THISDIR, 'pod2usage.OUT');
__END__
my $text_parser = Pod::Text->new;
$text_parser->parse_from_file($infile, $outfile);
=include pod2usage.PL
my %opts = map +($_ => 1), @ARGV;
if ($opts{'-xrgen'}) {
if ($opts{'-force'} or ! -e $cmpfile) {
print "# Creating expected result for \"pod2usage\"" .
" pod2text test ...\n";
$text_parser->parse_from_file($infile, $cmpfile);
}
else {
print "# File $cmpfile already exists" .
" (use '-force' to regenerate it).\n";
}
}
ok !testcmp( $outfile, $cmpfile ), "$outfile matches $cmpfile";
unlink $outfile;

23
cpan/Pod-Usage/t/pod/pod2usage.xr
View File

@ -1,4 +1,3 @@
###### begin =include pod2usage.PL #####
NAME
pod2usage - print usage messages from embedded pod docs in files
@ -8,9 +7,9 @@ SYNOPSIS
*module*] [-utf8] *file*
OPTIONS AND ARGUMENTS
-help Print a brief help message and exit.
-help Prints a brief help message and exit.
-man Print this command's manual page and exit.
-man Prints this command's manual page and exit.
-exit *exitval*
The exit status value to return.
@ -34,18 +33,16 @@ OPTIONS AND ARGUMENTS
on MSWin32 and DOS).
-formatter *module*
Which text formatter to use. Default is the Pod::Text manpage,
or for very old Perl versions the Pod::PlainText manpage. An
alternative would be e.g. the Pod::Text::Termcap manpage.
Which text formatter to use. Default is Pod::Text. An
alternative would be e.g. Pod::Text::Termcap.
-utf8 This option assumes that the formatter (see above) understands
the option "utf8". It turns on generation of utf8 output.
*file* The pathname of a file containing pod documentation to be output
in usage message format. If omitted, standard input is read -
but the output is then formatted with the Pod::Text manpage only
- unless a specific formatter has been specified with
-formatter.
but the output is then formatted with Pod::Text only - unless a
specific formatter has been specified with -formatter.
DESCRIPTION
pod2usage will read the given input file looking for pod documentation
@ -53,18 +50,16 @@ DESCRIPTION
specified then standard input is read.
pod2usage invokes the pod2usage() function in the Pod::Usage module.
Please see the pod2usage() entry in the Pod::Usage manpage.
Please see "pod2usage()" in Pod::Usage.
SEE ALSO
the Pod::Usage manpage, the pod2text manpage, the Pod::Text manpage, the
Pod::Text::Termcap manpage, the perldoc manpage
Pod::Usage, pod2text, Pod::Text, Pod::Text::Termcap, perldoc
AUTHOR
Please report bugs using http://rt.cpan.org.
Please report bugs using <http://rt.cpan.org>.
Brad Appleton <bradapp@enteract.com>
Based on code for pod2text(1) written by Tom Christiansen
<tchrist@mox.perl.com>
###### end =include pod2usage.PL #####

199
cpan/Pod-Usage/t/pod/testp2pt.pl
View File

@ -1,199 +0,0 @@
package TestPodIncPlainText;
my $PARENTDIR;
BEGIN {
use File::Basename;
use File::Spec;
use Cwd qw(abs_path);
push @INC, '..';
my $THISDIR = abs_path(dirname $0);
unshift @INC, $THISDIR;
require "testcmp.pl";
TestCompare->import;
# RT#130418: previous use of dirname() was failing on VMS
$PARENTDIR = File::Spec->catdir($THISDIR, File::Spec->updir());
push @INC, map { File::Spec->catdir($_, 'lib') } ($PARENTDIR, $THISDIR);
}
#use strict;
#use diagnostics;
use Carp;
use Exporter;
#use File::Compare;
#use Cwd qw(abs_path);
use vars qw($MYPKG @EXPORT @ISA);
$MYPKG = eval { (caller)[0] };
@EXPORT = qw(&testpodplaintext);
BEGIN {
# we want this for testing only
unshift(@INC, File::Spec->catdir($PARENTDIR, 'inc'));
#print "INC=@INC\n";
require Pod::PlainText;
@ISA = qw( Pod::PlainText );
require VMS::Filespec if $^O eq 'VMS';
}
## Hardcode settings for TERMCAP and COLUMNS so we can try to get
## reproducible results between environments
@ENV{qw(TERMCAP COLUMNS)} = ('co=76:do=^J', 76);
sub catdir(@) { File::Spec->catdir(@_); }
my $INSTDIR = abs_path(dirname $0);
$INSTDIR = VMS::Filespec::unixpath($INSTDIR) if $^O eq 'VMS';
$INSTDIR =~ s#/$## if $^O eq 'VMS';
$INSTDIR =~ s#:$## if $^O eq 'MacOS';
$INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'pod');
$INSTDIR =~ s#:$## if $^O eq 'MacOS';
$INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 't');
my @PODINCDIRS = ( catdir($INSTDIR, 'lib', 'Pod'),
catdir($INSTDIR, 'scripts'),
catdir($INSTDIR, 'pod'),
catdir($INSTDIR, 't', 'pod')
);
# FIXME - we should make the core capable of finding utilities built in
# locations in ext.
push @PODINCDIRS, catdir((File::Spec->updir()) x 2, 'pod') if $ENV{PERL_CORE};
## 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 = dirname $thispoddir;
my @podincdirs = ($thispoddir, $parentdir, @PODINCDIRS);
for (@podincdirs) {
my $incfile = File::Spec->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 begin_input {
$_[0]->{_INFILE} = VMS::Filespec::unixify($_[0]->{_INFILE}) if $^O eq 'VMS';
}
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;