Change 30187 by [EMAIL PROTECTED] on 2007/02/09 23:24:25
Integrate:
[ 25686]
Pod::Usage documentation fix, suggested by :
Subject: [perl #37322] Pod::Usage implementation of -sections disagrees
with its documentation
From: "Steven Schubiger via RT" <[EMAIL PROTECTED]>
Date: Sun, 02 Oct 2005 07:25:37 -0700
Message-ID: <[EMAIL PROTECTED]>
[ 26297]
One quick fix to the test for differences in error output.
[ 26303]
Fix to Pod::Usage to work with all recent Pod::Text versions. Also
includes a change to the Pod::Usage test file for compatibility
purposes.
[ 26304]
Further yak-shaving on Pod::Usage. Now, t/pod/pod2usage2.t tests
pass.
[ 26305]
Version bump for Pod::Usage
[ 26306]
One final Pod::Usage yak to shave...
[ 29126]
Upgrade to Pod-Parser-1.35.
[ 29214]
Sync Pod::Usage with the CPAN version
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#310 integrate
... //depot/maint-5.8/perl/lib/Pod/Checker.pm#11 integrate
... //depot/maint-5.8/perl/lib/Pod/ParseUtils.pm#8 integrate
... //depot/maint-5.8/perl/lib/Pod/Parser.pm#9 integrate
... //depot/maint-5.8/perl/lib/Pod/PlainText.pm#3 integrate
... //depot/maint-5.8/perl/lib/Pod/Select.pm#5 integrate
... //depot/maint-5.8/perl/lib/Pod/Usage.pm#9 integrate
... //depot/maint-5.8/perl/lib/Pod/t/Usage.t#3 integrate
... //depot/maint-5.8/perl/t/pod/p2u_data.pl#1 branch
... //depot/maint-5.8/perl/t/pod/pod2usage2.t#3 integrate
... //depot/maint-5.8/perl/t/pod/testcmp.pl#2 integrate
... //depot/maint-5.8/perl/t/pod/twice.t#1 branch
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#310 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#309~30179~ 2007-02-09 04:25:37.000000000 -0800
+++ perl/MANIFEST 2007-02-09 15:24:25.000000000 -0800
@@ -2922,6 +2922,7 @@
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/p2u_data.pl Test Pod::Usage
t/pod/plainer.t Test Pod::Plainer
t/pod/pod2usage2.t Test Pod::Usage
t/pod/pod2usage.t Test Pod::Usage
@@ -2936,6 +2937,7 @@
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/pod/testpods/lib/Pod/Stuff.pm Sample data for find.t
+t/pod/twice.t Test Pod::Parser
t/README Instructions for regression tests
t/run/exit.t Test perl's exit status.
t/run/fresh_perl.t Tests that require a fresh perl.
==== //depot/maint-5.8/perl/lib/Pod/Checker.pm#11 (text) ====
Index: perl/lib/Pod/Checker.pm
--- perl/lib/Pod/Checker.pm#10~26599~ 2006-01-03 04:44:38.000000000 -0800
+++ perl/lib/Pod/Checker.pm 2007-02-09 15:24:25.000000000 -0800
@@ -82,7 +82,7 @@
=item *
-Check for malformed or nonexisting entities C<EE<lt>...E<gt>>.
+Check for malformed or non-existing entities C<EE<lt>...E<gt>>.
=item *
@@ -142,7 +142,7 @@
=item * unresolved internal link I<NAME>
The given link to I<NAME> does not have a matching node in the current
-POD. This also happend when a single word node name is not enclosed in
+POD. This also happened when a single word node name is not enclosed in
C<"">.
=item * Unknown command "I<CMD>"
@@ -234,7 +234,7 @@
=item * =item type mismatch (I<one> vs. I<two>)
-A list started with e.g. a bulletted C<=item> and continued with a
+A list started with e.g. a bullet-like C<=item> and continued with a
numbered one. This is obviously inconsistent. For most translators the
type of the I<first> C<=item> determines the type of the list.
@@ -282,7 +282,7 @@
=head2 Hyperlinks
-There are some warnings wrt. malformed hyperlinks.
+There are some warnings with respect to malformed hyperlinks:
=over 4
@@ -332,8 +332,8 @@
method to print errors and warnings. The summary output (e.g.
"Pod syntax OK") has been dropped from the module and has been included in
B<podchecker> (the script). This allows users of B<Pod::Checker> to
-control completely the output behaviour. Users of B<podchecker> (the script)
-get the well-known behaviour.
+control completely the output behavior. Users of B<podchecker> (the script)
+get the well-known behavior.
=cut
==== //depot/maint-5.8/perl/lib/Pod/ParseUtils.pm#8 (text) ====
Index: perl/lib/Pod/ParseUtils.pm
--- perl/lib/Pod/ParseUtils.pm#7~26599~ 2006-01-03 04:44:38.000000000 -0800
+++ perl/lib/Pod/ParseUtils.pm 2007-02-09 15:24:25.000000000 -0800
@@ -10,7 +10,7 @@
package Pod::ParseUtils;
use vars qw($VERSION);
-$VERSION = 1.33; ## Current version of this package
+$VERSION = 1.35; ## Current version of this package
require 5.005; ## requires this Perl version or later
=head1 NAME
@@ -356,6 +356,13 @@
$node = $1;
$type = 'item';
}
+
+ # non-standard: Hyperlink with alt-text - doesn't remove protocol prefix,
maybe it should?
+ elsif(m!^ \s* (.*?) \s* [|] \s* (\w+:[^:\s] [^\s|]*?) \s* $!ix) {
+ ($alttext,$node) = ($1,$2);
+ $type = 'hyperlink';
+ }
+
# non-standard: Hyperlink
elsif(m!^(\w+:[^:\s]\S*)$!i) {
$node = $1;
@@ -370,11 +377,6 @@
elsif(m!^(.*?)\s*[|]\s*/(.+)$!) {
($alttext, $node) = ($1,$2);
}
- # nonstandard: alttext and hyperlink
- elsif(m!^(.*?)\s*[|]\s*(\w+:[^:\s]\S*)$!) {
- ($alttext, $node) = ($1,$2);
- $type = 'hyperlink';
- }
# must be an item or a "malformed" section (without "")
else {
$node = $_;
@@ -792,7 +794,7 @@
Look for a node or index entry named C<$name> in the object.
Returns the unique id of the node (i.e. the second element of the array
-stored in the node arry) or undef if not found.
+stored in the node array) or undef if not found.
=cut
==== //depot/maint-5.8/perl/lib/Pod/Parser.pm#9 (text) ====
Index: perl/lib/Pod/Parser.pm
--- perl/lib/Pod/Parser.pm#8~26599~ 2006-01-03 04:44:38.000000000 -0800
+++ perl/lib/Pod/Parser.pm 2007-02-09 15:24:25.000000000 -0800
@@ -10,7 +10,7 @@
package Pod::Parser;
use vars qw($VERSION);
-$VERSION = 1.32; ## Current version of this package
+$VERSION = 1.35; ## Current version of this package
require 5.005; ## requires this Perl version or later
#############################################################################
@@ -140,7 +140,7 @@
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.
+how to interpret the commands and translate the result.
Note that all we have described here in this quick overview is the
simplest most straightforward use of B<Pod::Parser> to do stream-based
@@ -651,7 +651,7 @@
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>.
+line number corresponding to the beginning of C<$text>.
B<parse_text()> will parse the given text into a parse-tree of "nodes."
and interior-sequences. Each "node" in the parse tree is either a
@@ -844,7 +844,7 @@
$seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_);
}
## Keep track of line count
- $line += tr/\n//;
+ $line += s/\r*\n//;
## Remember the "current" sequence
$seq = $seq_stack[-1];
}
@@ -1156,7 +1156,10 @@
my $self = shift;
my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
my ($infile, $outfile) = @_;
- my ($in_fh, $out_fh) = (gensym(), gensym()) if ($] < 5.006);
+ my ($in_fh, $out_fh);
+ if ($] < 5.006) {
+ ($in_fh, $out_fh) = (gensym(), gensym());
+ }
my ($close_input, $close_output) = (0, 0);
local *myData = $self;
local *_;
@@ -1761,6 +1764,14 @@
they are text-strings, or by calling their B<emit()> method if they
are objects/references.
+=head1 CAVEATS
+
+Please note that POD has the notion of "paragraphs": this is something
+starting I<after> a blank (read: empty) line, with the single exception
+of the file start, which is also starting a paragraph. That means that
+especially a command (e.g. C<=head1>) I<must> be preceded with a blank
+line; C<__END__> is I<not> a blank line.
+
=head1 SEE ALSO
L<Pod::InputObjects>, L<Pod::Select>
==== //depot/maint-5.8/perl/lib/Pod/PlainText.pm#3 (text) ====
Index: perl/lib/Pod/PlainText.pm
--- perl/lib/Pod/PlainText.pm#2~21979~ 2003-12-27 11:30:17.000000000 -0800
+++ perl/lib/Pod/PlainText.pm 2007-02-09 15:24:25.000000000 -0800
@@ -303,6 +303,23 @@
}
}
+# third level heading - not strictly perlpodspec compliant
+sub cmd_head3 {
+ my $self = shift;
+ local $_ = shift;
+ s/\s+$//;
+ $_ = $self->interpolate ($_, shift);
+ if ($$self{alt}) {
+ $self->output ("\n= $_ =\n");
+ } else {
+ $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;
==== //depot/maint-5.8/perl/lib/Pod/Select.pm#5 (text) ====
Index: perl/lib/Pod/Select.pm
--- perl/lib/Pod/Select.pm#4~26599~ 2006-01-03 04:44:38.000000000 -0800
+++ perl/lib/Pod/Select.pm 2007-02-09 15:24:25.000000000 -0800
@@ -10,7 +10,7 @@
package Pod::Select;
use vars qw($VERSION);
-$VERSION = 1.30; ## Current version of this package
+$VERSION = 1.35; ## Current version of this package
require 5.005; ## requires this Perl version or later
#############################################################################
@@ -505,7 +505,7 @@
## Keep track of current sections levels and headings
$_ = $paragraph;
- if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*)\s*$/)
+ if (/^=((?:sub)*)(?:head(?:ing)?|sec(?:tion)?)(\d*)\s+(.*?)\s*$/)
{
## This is a section heading command
my ($level, $heading) = ($2, $3);
@@ -575,7 +575,7 @@
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
+be interpreted to mean standard input (which is the default if no
filenames are given).
=cut
==== //depot/maint-5.8/perl/lib/Pod/Usage.pm#9 (text) ====
Index: perl/lib/Pod/Usage.pm
--- perl/lib/Pod/Usage.pm#8~26599~ 2006-01-03 04:44:38.000000000 -0800
+++ perl/lib/Pod/Usage.pm 2007-02-09 15:24:25.000000000 -0800
@@ -10,7 +10,7 @@
package Pod::Usage;
use vars qw($VERSION);
-$VERSION = 1.33; ## Current version of this package
+$VERSION = "1.35"; ## Current version of this package
require 5.005; ## requires this Perl version or later
=head1 NAME
@@ -96,11 +96,11 @@
"OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is printed. If the
corresponding value is 2 or more then the entire manpage is printed.
-The special verbosity level 99 requires to also specify the -section
+The special verbosity level 99 requires to also specify the -sections
parameter; then these sections are extracted (see L<Pod::Select>)
and printed.
-=item C<-section>
+=item C<-sections>
A string representing a selection list for sections to be printed
when -verbose is set to 99, e.g. C<"NAME|SYNOPSIS|DESCRIPTION|VERSION">.
@@ -212,8 +212,8 @@
=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
+desirable to exit with a status of 1 (as opposed to 0) after issuing
+the user-requested usage message. It is also desirable to give a
more verbose description of program usage in this case.
=back
@@ -413,7 +413,7 @@
Based on code for B<Pod::Text::pod2text()> written by
Tom Christiansen E<lt>[EMAIL PROTECTED]<gt>
-=head1 ACKNOWLEDGEMENTS
+=head1 ACKNOWLEDGMENTS
Steven McDougall E<lt>[EMAIL PROTECTED]<gt> for his help and patience
with re-writing this manpage.
@@ -531,6 +531,9 @@
'(?:\s*(?:AND|\/)\s*(?:OPTIONS|ARGUMENTS))?';
$parser->select( 'SYNOPSIS', $opt_re, "DESCRIPTION/$opt_re" );
}
+ elsif ($opts{"-verbose"} >= 2 && $opts{"-verbose"} != 99) {
+ $parser->select('.*');
+ }
elsif ($opts{"-verbose"} == 99) {
$parser->select( $opts{"-sections"} );
$opts{"-verbose"} = 1;
@@ -545,6 +548,10 @@
## spit out the entire PODs. Might as well invoke perldoc
my $progpath = File::Spec->catfile($Config{scriptdir}, "perldoc");
system($progpath, $opts{"-input"});
+ if($?) {
+ # RT16091: fall back to more if perldoc failed
+ system($ENV{PAGER} || 'more', $opts{"-input"});
+ }
}
else {
$parser->parse_from_file($opts{"-input"}, $opts{"-output"});
@@ -593,7 +600,9 @@
my ($self, $element) = @_;
if ($element eq 'head1') {
$$self{USAGE_HEAD1} = $$self{PENDING}[-1][1];
- $$self{PENDING}[-1][1] =~ s/^\s*SYNOPSIS\s*$/USAGE/;
+ if ($self->{USAGE_OPTIONS}->{-verbose} < 2) {
+ $$self{PENDING}[-1][1] =~ s/^\s*SYNOPSIS\s*$/USAGE/;
+ }
} elsif ($element eq 'head2') {
$$self{USAGE_HEAD2} = $$self{PENDING}[-1][1];
}
@@ -601,20 +610,26 @@
$$self{USAGE_SKIPPING} = 1;
my $heading = $$self{USAGE_HEAD1};
$heading .= '/' . $$self{USAGE_HEAD2} if defined $$self{USAGE_HEAD2};
- for (@{ $$self{USAGE_SELECT} }) {
- if ($heading =~ /^$_\s*$/) {
- $$self{USAGE_SKIPPING} = 0;
- last;
- }
+ if (!$$self{USAGE_SELECT} || [EMAIL PROTECTED] $$self{USAGE_SELECT} })
{
+ $$self{USAGE_SKIPPING} = 0;
+ } else {
+ for (@{ $$self{USAGE_SELECT} }) {
+ if ($heading =~ /^$_\s*$/) {
+ $$self{USAGE_SKIPPING} = 0;
+ last;
+ }
+ }
}
# Try to do some lowercasing instead of all-caps in headings, and use
# a colon to end all headings.
- local $_ = $$self{PENDING}[-1][1];
- s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
- s/\s*$/:/ unless (/:\s*$/);
- $_ .= "\n";
- $$self{PENDING}[-1][1] = $_;
+ if($self->{USAGE_OPTIONS}->{-verbose} < 2) {
+ local $_ = $$self{PENDING}[-1][1];
+ s{([A-Z])([A-Z]+)}{((length($2) > 2) ? $1 : lc($1)) . lc($2)}ge;
+ s/\s*$/:/ unless (/:\s*$/);
+ $_ .= "\n";
+ $$self{PENDING}[-1][1] = $_;
+ }
}
if ($$self{USAGE_SKIPPING}) {
pop @{ $$self{PENDING} };
==== //depot/maint-5.8/perl/lib/Pod/t/Usage.t#3 (text) ====
Index: perl/lib/Pod/t/Usage.t
--- perl/lib/Pod/t/Usage.t#2~22089~ 2004-01-07 05:19:41.000000000 -0800
+++ perl/lib/Pod/t/Usage.t 2007-02-09 15:24:25.000000000 -0800
@@ -36,7 +36,7 @@
pod2usage({ -verbose => 0, -exit => 'noexit',
-output => \*FAKEOUT, -input => $file });
};
- like( $@, qr/^Can't open $file for reading:/,
+ like( $@, qr/^Can't open $file/,
'File not found without -pathlist' );
eval {
==== //depot/maint-5.8/perl/t/pod/p2u_data.pl#1 (text) ====
Index: perl/t/pod/p2u_data.pl
--- /dev/null 2007-01-16 11:55:45.526841103 -0800
+++ perl/t/pod/p2u_data.pl 2007-02-09 15:24:25.000000000 -0800
@@ -0,0 +1,18 @@
+use Pod::Usage;
+pod2usage(-verbose => 2, -exit => 17, -input => \*DATA);
+
+__DATA__
+=head1 NAME
+
+Test
+
+=head1 SYNOPSIS
+
+perl podusagetest.pl
+
+=head1 DESCRIPTION
+
+This is a test.
+
+=cut
+
==== //depot/maint-5.8/perl/t/pod/pod2usage2.t#3 (text) ====
Index: perl/t/pod/pod2usage2.t
--- perl/t/pod/pod2usage2.t#2~26956~ 2006-01-27 03:35:12.000000000 -0800
+++ perl/t/pod/pod2usage2.t 2007-02-09 15:24:25.000000000 -0800
@@ -50,7 +50,7 @@
is ($exit, 2, "Exit status pod2usage ()");
ok (compare ($text, <<'EOT'), "Output test pod2usage ()");
#Usage:
-# frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+# frobnicate [ -r | --recursive ] [ -f | --force ] file ...
#
EOT
@@ -61,7 +61,7 @@
ok (compare ($text, <<'EOT'), "Output test pod2usage (-message => '...',
-verbose => 1)");
#You naughty person, what did you say?
# Usage:
-# frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+# frobnicate [ -r | --recursive ] [ -f | --force ] file ...
#
# Options:
# -r | --recursive
@@ -83,7 +83,7 @@
# frobnicate - do what I mean
#
# SYNOPSIS
-# frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+# frobnicate [ -r | --recursive ] [ -f | --force ] file ...
#
# DESCRIPTION
# frobnicate does foo and bar and what not.
@@ -104,7 +104,7 @@
is ($exit, 0, "Exit status pod2usage (0)");
ok (compare ($text, <<'EOT'), "Output test pod2usage (0)");
#Usage:
-# frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+# frobnicate [ -r | --recursive ] [ -f | --force ] file ...
#
# Options:
# -r | --recursive
@@ -122,7 +122,7 @@
is ($exit, 42, "Exit status pod2usage (42)");
ok (compare ($text, <<'EOT'), "Output test pod2usage (42)");
#Usage:
-# frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+# frobnicate [ -r | --recursive ] [ -f | --force ] file ...
#
EOT
@@ -130,7 +130,7 @@
is ($exit, 0, "Exit status pod2usage (-verbose => 0, -exit =>
'NOEXIT')");
ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 0, -exit =>
'NOEXIT')");
#Usage:
-# frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+# frobnicate [ -r | --recursive ] [ -f | --force ] file ...
#
# --NORMAL-RETURN--
EOT
@@ -154,7 +154,7 @@
=head1 SYNOPSIS
B<frobnicate> S<[ B<-r> | B<--recursive> ]> S<[ B<-f> | B<--force> ]>
- S<[ B<-n> I<number> ]> I<file> ...
+ file ...
=head1 DESCRIPTION
@@ -172,7 +172,7 @@
Just do it!
-=item B<-n> I<number>
+=item B<-n> number
Specify number of frobs, default is 42.
==== //depot/maint-5.8/perl/t/pod/testcmp.pl#2 (text) ====
Index: perl/t/pod/testcmp.pl
--- perl/t/pod/testcmp.pl#1~17645~ 2002-07-19 12:29:57.000000000 -0700
+++ perl/t/pod/testcmp.pl 2007-02-09 15:24:25.000000000 -0800
@@ -65,6 +65,9 @@
defined($f2text = <$fh2>) and chomp($f2text);
++$line;
last unless ( defined($f1text) and defined($f2text) );
+ # kill any extra line endings
+ $f1text =~ s/[\r\n]+$//s;
+ $f2text =~ s/[\r\n]+$//s;
$diffs = (ref $cmplines) ? &$cmplines($f1text, $f2text)
: ($f1text ne $f2text);
last if $diffs;
==== //depot/maint-5.8/perl/t/pod/twice.t#1 (text) ====
Index: perl/t/pod/twice.t
--- /dev/null 2007-01-16 11:55:45.526841103 -0800
+++ perl/t/pod/twice.t 2007-02-09 15:24:25.000000000 -0800
@@ -0,0 +1,36 @@
+use strict;
+use Test;
+use File::Spec;
+
+BEGIN { plan tests => 1 }
+
+use Pod::Parser;
+use Carp;
+$SIG{__DIE__} = \&Carp::confess;
+
+eval {require IO::String;};
+skip($@ ? 'no IO::String' : '', sub {
+ {
+ my $pod_string = 'some I<silly> text';
+ my $handle = IO::String->new( \$pod_string );
+ my $parser = Pod::Parser->new();
+ $parser->parse_from_file( $0, $handle );
+ }
+ # free the reference
+ {
+ my $parser = Pod::Parser->new();
+ $parser->parse_from_file( $0, File::Spec->devnull );
+ }
+ 1;
+});
+
+exit 0;
+
+__END__
+
+=head1 EXAMPLE
+
+This test makes sure the parse_from_file is re-entrant
+
+=cut
+
End of Patch.
