In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/969c6694443bf4385fae215cd8a6f09e86840ea4?hp=b4d1bf317b24612c56201f57deada75229b46118>
- Log ----------------------------------------------------------------- commit 969c6694443bf4385fae215cd8a6f09e86840ea4 Author: Chris 'BinGOs' Williams <[email protected]> Date: Fri Jun 12 09:43:13 2015 +0100 Update Pod-Usage to CPAN version 1.67 [DELTA] 1.67 (marekr) - added options -perlcmd and -perldoc to allow for non-standard installations of perl and the perldoc script. Thanks to Markus Jansen for the patch 1.66 (marekr) - CPAN#102116: pod2usage() -sections omits section with subsection specified added more precise documentation about the -section syntax and semantics - CPAN#102117: pod2usage() changes formatting added documentation to describe what formatting changes pod2usage applies - CPAN#102101: New tests fail when in core changed the way the tests find their dependencies. Thanks to BINGOS for the patch, applied in slightly modified way 1.65 (marekr) - CPAN#81059: [RT #115534]: Pod::Usage Failes to Select -sections with Negation fixed a specific corner case for section selection - CPAN#101538: Pod::Usage doesn't handle E<copy> correctly introduced a utf8 option; this may actually not solve the problem, but it is the best we can do for the moment - CPAN#101581: pod2usage() -sections omits marked-up text from =head lines make sure that marked-up text is not skipped ----------------------------------------------------------------------- Summary of changes: MANIFEST | 6 + Porting/Maintainers.pl | 2 +- cpan/Pod-Usage/lib/Pod/Usage.pm | 108 +++-- cpan/Pod-Usage/scripts/pod2usage.PL | 388 +++++++++--------- cpan/Pod-Usage/t/pod/headwithmarkup.pl | 22 + cpan/Pod-Usage/t/pod/headwithmarkup.t | 13 + cpan/Pod-Usage/t/pod/p2u_data.pl | 36 +- cpan/Pod-Usage/t/pod/pod2usage.t | 36 +- cpan/Pod-Usage/t/pod/pod2usage.xr | 5 +- cpan/Pod-Usage/t/pod/pod2usage2.t | 718 +++++++++++++++++---------------- cpan/Pod-Usage/t/pod/selectheaders.pl | 34 ++ cpan/Pod-Usage/t/pod/selectheaders.t | 17 + cpan/Pod-Usage/t/pod/selectsections.pl | 70 ++++ cpan/Pod-Usage/t/pod/selectsections.t | 17 + cpan/Pod-Usage/t/pod/testcmp.pl | 188 ++++----- cpan/Pod-Usage/t/pod/testp2pt.pl | 384 +++++++++--------- cpan/Pod-Usage/t/pod/usage.pod | 36 +- cpan/Pod-Usage/t/pod/usage2.pod | 112 ++--- 18 files changed, 1221 insertions(+), 971 deletions(-) create mode 100644 cpan/Pod-Usage/t/pod/headwithmarkup.pl create mode 100644 cpan/Pod-Usage/t/pod/headwithmarkup.t create mode 100644 cpan/Pod-Usage/t/pod/selectheaders.pl create mode 100644 cpan/Pod-Usage/t/pod/selectheaders.t create mode 100644 cpan/Pod-Usage/t/pod/selectsections.pl create mode 100644 cpan/Pod-Usage/t/pod/selectsections.t diff --git a/MANIFEST b/MANIFEST index 7122981..90291f3 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2039,10 +2039,16 @@ cpan/Pod-Simple/t/xhtml-bkb.t cpan/Pod-Simple/t/x_nixer.t Pod::Simple test file cpan/Pod-Usage/lib/Pod/Usage.pm cpan/Pod-Usage/scripts/pod2usage.PL +cpan/Pod-Usage/t/pod/headwithmarkup.pl +cpan/Pod-Usage/t/pod/headwithmarkup.t cpan/Pod-Usage/t/pod/p2u_data.pl cpan/Pod-Usage/t/pod/pod2usage2.t cpan/Pod-Usage/t/pod/pod2usage.t cpan/Pod-Usage/t/pod/pod2usage.xr +cpan/Pod-Usage/t/pod/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/usage2.pod diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 0a355bc..2ba6121 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -945,7 +945,7 @@ use File::Glob qw(:case); }, 'Pod::Usage' => { - 'DISTRIBUTION' => 'MAREKR/Pod-Usage-1.64.tar.gz', + 'DISTRIBUTION' => 'MAREKR/Pod-Usage-1.67.tar.gz', 'FILES' => q[cpan/Pod-Usage], }, diff --git a/cpan/Pod-Usage/lib/Pod/Usage.pm b/cpan/Pod-Usage/lib/Pod/Usage.pm index bb8e60f..a57d5f2 100644 --- a/cpan/Pod-Usage/lib/Pod/Usage.pm +++ b/cpan/Pod-Usage/lib/Pod/Usage.pm @@ -11,7 +11,7 @@ package Pod::Usage; use strict; use vars qw($VERSION @ISA @EXPORT); -$VERSION = '1.64'; ## Current version of this package +$VERSION = '1.67'; ## Current version of this package require 5.006; ## requires this Perl version or later #use diagnostics; @@ -128,7 +128,8 @@ sub pod2usage { } ## Check for perldoc - my $progpath = File::Spec->catfile($Config{scriptdirexp} + my $progpath = $opts{perldoc} ? $opts{perldoc} : + File::Spec->catfile($Config{scriptdirexp} || $Config{scriptdir}, 'perldoc'); my $version = sprintf("%vd",$^V); @@ -148,7 +149,9 @@ sub pod2usage { if(defined $opts{-input} && $opts{-input} =~ /^\s*(\S.*?)\s*$/) { # the perldocs back to 5.005 should all have -F # without -F there are warnings in -T scripts - system($progpath, '-F', $1); + my @perldoc_cmd = ( $progpath, '-F', $1 ); + unshift @perldoc_cmd, $opts{'-perlcmd'} if $opts{'-perlcmd'}; + system(@perldoc_cmd); if($?) { # RT16091: fall back to more if perldoc failed system(($Config{pager} || $ENV{PAGER} || '/bin/more'), $1); @@ -263,10 +266,13 @@ sub select { # Override Pod::Text->seq_i to return just "arg", not "*arg*". sub seq_i { return $_[1] } +# Override Pod::Text->cmd_i to return just "arg", not "*arg*". +# newer version based on Pod::Simple +sub cmd_i { return $_[2] } # This overrides the Pod::Text method to do something very akin to what # Pod::Select did as well as the work done below by preprocess_paragraph. -# Note that the below is very, very specific to Pod::Text. +# Note that the below is very, very specific to Pod::Text and Pod::Simple. sub _handle_element_end { my ($self, $element) = @_; if ($element eq 'head1') { @@ -278,6 +284,8 @@ sub _handle_element_end { my $idx = $1 - 1; $self->{USAGE_HEADINGS} = [] unless($self->{USAGE_HEADINGS}); $self->{USAGE_HEADINGS}->[$idx] = $$self{PENDING}[-1][1]; + # we have to get rid of the lower headings + splice(@{$self->{USAGE_HEADINGS}},$idx+1); } if ($element =~ /^head\d+$/) { $$self{USAGE_SKIPPING} = 1; @@ -312,7 +320,7 @@ sub _handle_element_end { $$self{PENDING}[-1][1] = $_; } } - if ($$self{USAGE_SKIPPING} && $element !~ m/^over-/) { + if ($$self{USAGE_SKIPPING} && $element !~ m/^over-|^[BCFILSZ]$/) { pop @{ $$self{PENDING} }; } else { $self->SUPER::_handle_element_end($element); @@ -383,10 +391,14 @@ Pod::Usage - print a usage message from embedded pod documentation pod2usage( -msg => $message_text , -exitval => $exit_status , -verbose => $verbose_level, - -output => $filehandle ); + -output => $filehandle ); pod2usage( -verbose => 2, - -noperldoc => 1 ) + -noperldoc => 1 ); + + pod2usage( -verbose => 2, + -perlcmd => $path_to_perl, + -perldoc => $path_to_perldoc ); =head1 ARGUMENTS @@ -418,49 +430,73 @@ keys: =over 4 -=item C<-message> +=item C<-message> I<string> -=item C<-msg> +=item C<-msg> I<string> The text of a message to print immediately prior to printing the program's usage message. -=item C<-exitval> +=item C<-exitval> I<value> The desired exit status to pass to the B<exit()> function. This should be an integer, or else the string "NOEXIT" to indicate that control should simply be returned without terminating the invoking process. -=item C<-verbose> +=item C<-verbose> I<value> -The desired level of "verboseness" to use when printing the usage -message. If the corresponding value is 0, then only the "SYNOPSIS" -section of the pod documentation is printed. If the corresponding value -is 1, then the "SYNOPSIS" section, along with any section entitled -"OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is printed. If the -corresponding value is 2 or more then the entire manpage is printed. +The desired level of "verboseness" to use when printing the usage message. +If the value is 0, then only the "SYNOPSIS" section of the pod documentation +is printed. If the value is 1, then the "SYNOPSIS" section, along with any +section entitled "OPTIONS", "ARGUMENTS", or "OPTIONS AND ARGUMENTS" is +printed. If the corresponding value is 2 or more then the entire manpage is +printed, using L<perldoc> if available; otherwise L<Pod::Text> is used for +the formatting. For better readability, the all-capital headings are +downcased, e.g. C<SYNOPSIS> =E<gt> C<Synopsis>. The special verbosity level 99 requires to also specify the -sections parameter; then these sections are extracted and printed. -=item C<-sections> +=item C<-sections> I<spec> + +There are two ways to specify the selection. Either a string (scalar) +representing a selection regexp for sections to be printed when -verbose +is set to 99, e.g. + + "NAME|SYNOPSIS|DESCRIPTION|VERSION" + +With the above regexp all content following (and including) any of the +given C<=head1> headings will be shown. It is possible to restrict the +output to particular subsections only, e.g.: + + "DESCRIPTION/Algorithm" + +This will output only the C<=head2 Algorithm> heading and content within +the C<=head1 DESCRIPTION> section. The regexp binding is stronger than the +section separator, such that e.g.: + + "DESCRIPTION|OPTIONS|ENVIORNMENT/Caveats" -A string representing a selection list for sections to be printed -when -verbose is set to 99, e.g. C<"NAME|SYNOPSIS|DESCRIPTION|VERSION">. +will print any C<=head2 Caveats> section (only) within any of the three +C<=head1> sections. Alternatively, an array reference of section specifications can be used: - pod2usage(-verbose => 99, - -sections => [ qw(fred fred/subsection) ] ); + pod2usage(-verbose => 99, -sections => [ + qw(DESCRIPTION DESCRIPTION/Introduction) ] ); -=item C<-output> +This will print only the content of C<=head1 DESCRIPTION> and the +C<=head2 Introduction> sections, but no other C<=head2>, and no other +C<=head1> either. + +=item C<-output> I<handle> A reference to a filehandle, or the pathname of a file to which the usage message should be written. The default is C<\*STDERR> unless the exit value is less than 2 (in which case the default is C<\*STDOUT>). -=item C<-input> +=item C<-input> I<handle> A reference to a filehandle, or the pathname of a file from which the invoking script's pod documentation should be read. It defaults to the @@ -472,7 +508,7 @@ that module's POD, you can use this: use Pod::Find qw(pod_where); pod2usage( -input => pod_where({-inc => 1}, __PACKAGE__) ); -=item C<-pathlist> +=item C<-pathlist> I<string> A list of directory paths. If the input file does not exist, then it will be searched for in the given directory list (in the order the @@ -490,17 +526,37 @@ with L<PAR>. The -noperldoc option suppresses the external call to L<perldoc> and uses the simple text formatter (L<Pod::Text>) to output the POD. +=item C<-perlcmd> + +By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is +specified. In case of special or unusual Perl installations, +the -perlcmd option may be used to supply the path to a L<perl> executable +which should run L<perldoc>. + +=item C<-perldoc> + +By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is +specified. In case L<perldoc> is not installed where the L<perl> interpreter +thinks it is (see L<Config>), the -perldoc option may be used to supply +the correct path to L<perldoc>. + =back =head2 Formatting base class -The default text formatter is L<Pod::Text>. The base class for Pod::Usage can +The default text formatter is L<Pod::Text>. The base class for Pod::Usage can be defined by pre-setting C<$Pod::Usage::Formatter> I<before> loading Pod::Usage, e.g.: BEGIN { $Pod::Usage::Formatter = 'Pod::Text::Termcap'; } use Pod::Usage qw(pod2usage); +Pod::Usage uses L<Pod::Simple>'s _handle_element_end() method to implement +the section selection, and in case of verbosity < 2 it down-cases the +all-caps headings to first capital letter and rest lowercase, and adds +a colon/newline at the end of the headings, for better readability. Same for +verbosity = 99. + =head2 Pass-through options The following options are passed through to the underlying text formatter. diff --git a/cpan/Pod-Usage/scripts/pod2usage.PL b/cpan/Pod-Usage/scripts/pod2usage.PL index 0d84590..9102455 100644 --- a/cpan/Pod-Usage/scripts/pod2usage.PL +++ b/cpan/Pod-Usage/scripts/pod2usage.PL @@ -1,190 +1,198 @@ -#!/usr/local/bin/perl - -use Config; -use File::Basename qw(&basename &dirname); -use Cwd; - -# List explicitly here the variables you want Configure to -# generate. Metaconfig only looks for shell variables, so you -# have to mention them as if they were shell variables, not -# %Config entries. Thus you write -# $startperl -# to ensure Configure will look for $Config{startperl}. - -# This forces PL files to create target in same directory as PL file. -# This is so that make depend always knows where to find PL derivatives. -$origdir = cwd; -chdir(dirname($0)); -$file = basename($0, '.PL'); -$file .= '.com' if $^O eq 'VMS'; - -open OUT,">$file" or die "Can't create $file: $!"; - -print "Extracting $file (with variable substitutions)\n"; - -# In this section, perl variables will be expanded during extraction. -# You can use $Config{...} to use Configure variables. - -print OUT <<"!GROK!THIS!"; -$Config{'startperl'} - eval 'exec perl -S \$0 "\$@"' - if 0; -!GROK!THIS! - -# In the following, perl variables are not expanded during extraction. - -print OUT <<'!NO!SUBS!'; - -############################################################################# -# pod2usage -- command to print usage messages from embedded 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. -############################################################################# - -use strict; -#use diagnostics; - -=head1 NAME - -pod2usage - print usage messages from embedded pod docs in files - -=head1 SYNOPSIS - -=over 12 - -=item B<pod2usage> - -[B<-help>] -[B<-man>] -[B<-exit>S< >I<exitval>] -[B<-output>S< >I<outfile>] -[B<-verbose> I<level>] -[B<-pathlist> I<dirlist>] -[B<-formatter> I<module>] -I<file> - -=back - -=head1 OPTIONS AND ARGUMENTS - -=over 8 - -=item B<-help> - -Print a brief help message and exit. - -=item B<-man> - -Print this command's manual page and exit. - -=item B<-exit> I<exitval> - -The exit status value to return. - -=item B<-output> I<outfile> - -The output file to print to. If the special names "-" or ">&1" or ">&STDOUT" -are used then standard output is used. If ">&2" or ">&STDERR" is used then -standard error is used. - -=item B<-verbose> I<level> - -The desired level of verbosity to use: - - 1 : print SYNOPSIS only - 2 : print SYNOPSIS sections and any OPTIONS/ARGUMENTS sections - 3 : print the entire manpage (similar to running pod2text) - -=item B<-pathlist> I<dirlist> - -Specifies one or more directories to search for the input file if it -was not supplied with an absolute path. Each directory path in the given -list should be separated by a ':' on Unix (';' on MSWin32 and DOS). - -=item 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>. - -=item I<file> - -The pathname of a file containing pod documentation to be output in -usage message format (defaults to standard input). - -=back - -=head1 DESCRIPTION - -B<pod2usage> will read the given input file looking for pod -documentation and will print the corresponding usage message. -If no input file is specified then standard input is read. - -B<pod2usage> invokes the B<pod2usage()> function in the B<Pod::Usage> -module. Please see L<Pod::Usage/pod2usage()>. - -=head1 SEE ALSO - -L<Pod::Usage>, L<pod2text(1)> - -=head1 AUTHOR - -Please report bugs using L<http://rt.cpan.org>. - -Brad Appleton E<lt>[email protected]<gt> - -Based on code for B<pod2text(1)> written by -Tom Christiansen E<lt>[email protected]<gt> - -=cut - -use Getopt::Long; - -## Define options -my %options = (); -my @opt_specs = ( - 'help', - 'man', - 'exit=i', - 'output=s', - 'pathlist=s', - 'formatter=s', - 'verbose=i', -); - -## Parse options -GetOptions(\%options, @opt_specs) || pod2usage(2); -$Pod::Usage::Formatter = $options{formatter} if $options{formatter}; -require Pod::Usage; -Pod::Usage->import(); -pod2usage(1) if ($options{help}); -pod2usage(VERBOSE => 2) if ($options{man}); - -## Dont default to STDIN if connected to a terminal -pod2usage(2) if ((@ARGV == 0) && (-t STDIN)); - -@ARGV = ('-') unless (@ARGV); -if (@ARGV > 1) { - print STDERR "pod2usage: Too many filenames given\n\n"; - pod2usage(2); -} - -my %usage = (); -$usage{-input} = shift(@ARGV); -$usage{-exitval} = $options{'exit'} if (defined $options{'exit'}); -$usage{-output} = $options{'output'} if (defined $options{'output'}); -$usage{-verbose} = $options{'verbose'} if (defined $options{'verbose'}); -$usage{-pathlist} = $options{'pathlist'} if (defined $options{'pathlist'}); - -pod2usage(\%usage); - - -!NO!SUBS! - -close OUT or die "Can't close $file: $!"; -chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; -exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; -chdir $origdir; +#!/usr/local/bin/perl + +use Config; +use File::Basename qw(&basename &dirname); +use Cwd; + +# List explicitly here the variables you want Configure to +# generate. Metaconfig only looks for shell variables, so you +# have to mention them as if they were shell variables, not +# %Config entries. Thus you write +# $startperl +# to ensure Configure will look for $Config{startperl}. + +# This forces PL files to create target in same directory as PL file. +# This is so that make depend always knows where to find PL derivatives. +$origdir = cwd; +chdir(dirname($0)); +$file = basename($0, '.PL'); +$file .= '.com' if $^O eq 'VMS'; + +open OUT,">$file" or die "Can't create $file: $!"; + +print "Extracting $file (with variable substitutions)\n"; + +# In this section, perl variables will be expanded during extraction. +# You can use $Config{...} to use Configure variables. + +print OUT <<"!GROK!THIS!"; +$Config{'startperl'} + eval 'exec perl -S \$0 "\$@"' + if 0; +!GROK!THIS! + +# In the following, perl variables are not expanded during extraction. + +print OUT <<'!NO!SUBS!'; + +############################################################################# +# pod2usage -- command to print usage messages from embedded 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. +############################################################################# + +use strict; +#use diagnostics; + +=head1 NAME + +pod2usage - print usage messages from embedded pod docs in files + +=head1 SYNOPSIS + +=over 12 + +=item B<pod2usage> + +[B<-help>] +[B<-man>] +[B<-exit>S< >I<exitval>] +[B<-output>S< >I<outfile>] +[B<-verbose> I<level>] +[B<-pathlist> I<dirlist>] +[B<-formatter> I<module>] +[B<-utf8>] +I<file> + +=back + +=head1 OPTIONS AND ARGUMENTS + +=over 8 + +=item B<-help> + +Print a brief help message and exit. + +=item B<-man> + +Print this command's manual page and exit. + +=item B<-exit> I<exitval> + +The exit status value to return. + +=item B<-output> I<outfile> + +The output file to print to. If the special names "-" or ">&1" or ">&STDOUT" +are used then standard output is used. If ">&2" or ">&STDERR" is used then +standard error is used. + +=item B<-verbose> I<level> + +The desired level of verbosity to use: + + 1 : print SYNOPSIS only + 2 : print SYNOPSIS sections and any OPTIONS/ARGUMENTS sections + 3 : print the entire manpage (similar to running pod2text) + +=item B<-pathlist> I<dirlist> + +Specifies one or more directories to search for the input file if it +was not supplied with an absolute path. Each directory path in the given +list should be separated by a ':' on Unix (';' on MSWin32 and DOS). + +=item 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>. + +=item B<-utf8> + +This option assumes that the formatter (see above) understands the option +"utf8". It turns on generation of utf8 output. + +=item I<file> + +The pathname of a file containing pod documentation to be output in +usage message format (defaults to standard input). + +=back + +=head1 DESCRIPTION + +B<pod2usage> will read the given input file looking for pod +documentation and will print the corresponding usage message. +If no input file is specified then standard input is read. + +B<pod2usage> invokes the B<pod2usage()> function in the B<Pod::Usage> +module. Please see L<Pod::Usage/pod2usage()>. + +=head1 SEE ALSO + +L<Pod::Usage>, L<pod2text(1)> + +=head1 AUTHOR + +Please report bugs using L<http://rt.cpan.org>. + +Brad Appleton E<lt>[email protected]<gt> + +Based on code for B<pod2text(1)> written by +Tom Christiansen E<lt>[email protected]<gt> + +=cut + +use Getopt::Long; + +## Define options +my %options = (); +my @opt_specs = ( + 'help', + 'man', + 'exit=i', + 'output=s', + 'pathlist=s', + 'formatter=s', + 'verbose=i', + 'utf8!' +); + +## Parse options +GetOptions(\%options, @opt_specs) || pod2usage(2); +$Pod::Usage::Formatter = $options{formatter} if $options{formatter}; +require Pod::Usage; +Pod::Usage->import(); +pod2usage(1) if ($options{help}); +pod2usage(VERBOSE => 2) if ($options{man}); + +## Dont default to STDIN if connected to a terminal +pod2usage(2) if ((@ARGV == 0) && (-t STDIN)); + +@ARGV = ('-') unless (@ARGV); +if (@ARGV > 1) { + print STDERR "pod2usage: Too many filenames given\n\n"; + pod2usage(2); +} + +my %usage = (); +$usage{-input} = shift(@ARGV); +$usage{-exitval} = $options{'exit'} if (defined $options{'exit'}); +$usage{-output} = $options{'output'} if (defined $options{'output'}); +$usage{-verbose} = $options{'verbose'} if (defined $options{'verbose'}); +$usage{-pathlist} = $options{'pathlist'} if (defined $options{'pathlist'}); +$usage{-utf8} = $options{'utf8'} if (defined $options{'utf8'}); + +pod2usage(\%usage); + + +!NO!SUBS! + +close OUT or die "Can't close $file: $!"; +chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; +exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; +chdir $origdir; diff --git a/cpan/Pod-Usage/t/pod/headwithmarkup.pl b/cpan/Pod-Usage/t/pod/headwithmarkup.pl new file mode 100644 index 0000000..318c851 --- /dev/null +++ b/cpan/Pod-Usage/t/pod/headwithmarkup.pl @@ -0,0 +1,22 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Pod::Usage; +pod2usage( + -exitstatus => 0, + -verbose => 99, + -sections => 'ACTIONS/back.*', + -noperldoc => 1 +); + +__END__ + +=head1 ACTIONS + +Para for actions. + +=head2 backup I<pkg> B<please> dest + +Para for backup. + +=cut diff --git a/cpan/Pod-Usage/t/pod/headwithmarkup.t b/cpan/Pod-Usage/t/pod/headwithmarkup.t new file mode 100644 index 0000000..adba2be --- /dev/null +++ b/cpan/Pod-Usage/t/pod/headwithmarkup.t @@ -0,0 +1,13 @@ +use Test::More tests => 1; + +my $blib = $ENV{PERL_CORE} ? '-I../../lib' : '-Mblib'; + +my $pl = $0; +$pl =~ s{t$}{pl}; + +my $out = `$^X $blib $pl`; +$out =~ s{\s+}{ }gs; +$out =~ s{^\s+|\s+$}{}gs; +# we want to make sure that the marked-up text is not lost +is($out, 'backup pkg please dest: Para for backup.'); + diff --git a/cpan/Pod-Usage/t/pod/p2u_data.pl b/cpan/Pod-Usage/t/pod/p2u_data.pl index 858cc56..ec0e3a7 100644 --- a/cpan/Pod-Usage/t/pod/p2u_data.pl +++ b/cpan/Pod-Usage/t/pod/p2u_data.pl @@ -1,18 +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 - +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 + diff --git a/cpan/Pod-Usage/t/pod/pod2usage.t b/cpan/Pod-Usage/t/pod/pod2usage.t index 98788fc..cf2c31b 100644 --- a/cpan/Pod-Usage/t/pod/pod2usage.t +++ b/cpan/Pod-Usage/t/pod/pod2usage.t @@ -1,18 +1,18 @@ -BEGIN { - use File::Basename; - my $THISDIR = dirname $0; - unshift @INC, $THISDIR; - require "testp2pt.pl"; - import TestPodIncPlainText; -} - -my %options = map { $_ => 1 } @ARGV; ## convert cmdline to options-hash -my $passed = testpodplaintext \%options, $0; -exit( ($passed == 1) ? 0 : -1 ) unless $ENV{HARNESS_ACTIVE}; - - -__END__ - -=include pod2usage.PL - - +BEGIN { + use File::Basename; + my $THISDIR = dirname $0; + unshift @INC, $THISDIR; + require "testp2pt.pl"; + import TestPodIncPlainText; +} + +my %options = map { $_ => 1 } @ARGV; ## convert cmdline to options-hash +my $passed = testpodplaintext \%options, $0; +exit( ($passed == 1) ? 0 : -1 ) unless $ENV{HARNESS_ACTIVE}; + + +__END__ + +=include pod2usage.PL + + diff --git a/cpan/Pod-Usage/t/pod/pod2usage.xr b/cpan/Pod-Usage/t/pod/pod2usage.xr index ceac4f1..7460a6d 100644 --- a/cpan/Pod-Usage/t/pod/pod2usage.xr +++ b/cpan/Pod-Usage/t/pod/pod2usage.xr @@ -5,7 +5,7 @@ NAME SYNOPSIS pod2usage [-help] [-man] [-exit *exitval*] [-output *outfile*] [-verbose *level*] [-pathlist *dirlist*] [-formatter - *module*] *file* + *module*] [-utf8] *file* OPTIONS AND ARGUMENTS -help Print a brief help message and exit. @@ -38,6 +38,9 @@ OPTIONS AND ARGUMENTS or for very old Perl versions the Pod::PlainText manpage. An alternative would be e.g. the Pod::Text::Termcap manpage. + -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 (defaults to standard input). diff --git a/cpan/Pod-Usage/t/pod/pod2usage2.t b/cpan/Pod-Usage/t/pod/pod2usage2.t index a2b0a32..0ac4747 100644 --- a/cpan/Pod-Usage/t/pod/pod2usage2.t +++ b/cpan/Pod-Usage/t/pod/pod2usage2.t @@ -1,357 +1,361 @@ -#!/usr/bin/perl -w - -use Test::More; -use strict; - -BEGIN { - if ($^O eq 'MSWin32' || $^O eq 'VMS') { - plan skip_all => "Not portable on Win32 or VMS\n"; - } - else { - plan tests => 34; - } - use_ok ("Pod::Usage"); -} - -sub getoutput -{ - my ($code) = @_; - my $pid = open(TEST_IN, "-|"); - unless(defined $pid) { - die "Cannot fork: $!"; - } - if($pid) { - # parent - my @out = <TEST_IN>; - close(TEST_IN); - my $exit = $?>>8; - s/^/#/ for @out; - local $" = ""; - print "#EXIT=$exit OUTPUT=+++#@out#+++\n"; - return($exit, join("",@out)); - } - # child - open(STDERR, ">&STDOUT"); - Test::More->builder->no_ending(1); - &$code; - print "--NORMAL-RETURN--\n"; - exit 0; -} - -sub compare -{ - my ($left,$right) = @_; - $left =~ s/^#\s+/#/gm; - $right =~ s/^#\s+/#/gm; - $left =~ s/\s+/ /gm; - $right =~ s/\s+/ /gm; - $left eq $right; -} - -SKIP: { -if('Pod::Usage'->isa('Pod::Text') && $Pod::Text::VERSION < 2.18) { - skip("Formatting with Pod::Text $Pod::Text::VERSION not reliable", 33); -} - -my ($exit, $text) = getoutput( sub { pod2usage() } ); -is ($exit, 2, "Exit status pod2usage ()"); -ok (compare ($text, <<'EOT'), "Output test pod2usage ()"); -#Usage: -# frobnicate [ -r | --recursive ] [ -f | --force ] file ... -# -EOT - -($exit, $text) = getoutput( sub { pod2usage( - -message => 'You naughty person, what did you say?', - -verbose => 1 ) }); -is ($exit, 1, "Exit status pod2usage (-message => '...', -verbose => 1)"); -ok (compare ($text, <<'EOT'), "Output test pod2usage (-message => '...', -verbose => 1)") or diag("Got:\n$text\n"); -#You naughty person, what did you say? -# Usage: -# frobnicate [ -r | --recursive ] [ -f | --force ] file ... -# -# Options: -# -r | --recursive -# Run recursively. -# -# -f | --force -# Just do it! -# -# -n number -# Specify number of frobs, default is 42. -# -EOT - -($exit, $text) = getoutput( sub { pod2usage( - -verbose => 2, -exit => 42 ) } ); -is ($exit, 42, "Exit status pod2usage (-verbose => 2, -exit => 42)"); -ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 2, -exit => 42)"); -#NAME -# frobnicate - do what I mean -# -# SYNOPSIS -# frobnicate [ -r | --recursive ] [ -f | --force ] file ... -# -# DESCRIPTION -# frobnicate does foo and bar and what not. -# -# OPTIONS -# -r | --recursive -# Run recursively. -# -# -f | --force -# Just do it! -# -# -n number -# Specify number of frobs, default is 42. -# -EOT - -($exit, $text) = getoutput( sub { pod2usage(0) } ); -is ($exit, 0, "Exit status pod2usage (0)"); -ok (compare ($text, <<'EOT'), "Output test pod2usage (0)"); -#Usage: -# frobnicate [ -r | --recursive ] [ -f | --force ] file ... -# -# Options: -# -r | --recursive -# Run recursively. -# -# -f | --force -# Just do it! -# -# -n number -# Specify number of frobs, default is 42. -# -EOT - -($exit, $text) = getoutput( sub { pod2usage(42) } ); -is ($exit, 42, "Exit status pod2usage (42)"); -ok (compare ($text, <<'EOT'), "Output test pod2usage (42)"); -#Usage: -# frobnicate [ -r | --recursive ] [ -f | --force ] file ... -# -EOT - -($exit, $text) = getoutput( sub { pod2usage(-verbose => 0, -exit => 'NOEXIT') } ); -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 ] file ... -# -# --NORMAL-RETURN-- -EOT - -($exit, $text) = getoutput( sub { pod2usage(-verbose => 99, -sections => 'DESCRIPTION') } ); -is ($exit, 1, "Exit status pod2usage (-verbose => 99, -sections => 'DESCRIPTION')"); -ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 99, -sections => 'DESCRIPTION')"); -#Description: -# frobnicate does foo and bar and what not. -# -EOT - -# does the __DATA__ work ok as input -my (@blib, $test_script, $pod_file1, , $pod_file2); -if (!$ENV{PERL_CORE}) { - @blib = '-Mblib'; -} -$test_script = File::Spec->catfile(qw(t pod p2u_data.pl)); -$pod_file1 = File::Spec->catfile(qw(t pod usage.pod)); -$pod_file2 = File::Spec->catfile(qw(t pod usage2.pod)); - - -($exit, $text) = getoutput( sub { system($^X, @blib, $test_script); exit($? >> 8); } ); -$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR -is ($exit, 17, "Exit status pod2usage (-verbose => 2, -input => \*DATA)"); -ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 2, -input => \*DATA)") or diag "Got:\n$text\n"; -#NAME -# Test -# -#SYNOPSIS -# perl podusagetest.pl -# -#DESCRIPTION -# This is a test. -# -EOT - -# test that SYNOPSIS and USAGE are printed -($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file1, - -exitval => 0, -verbose => 0); }); -$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR -is ($exit, 0, "Exit status pod2usage with USAGE"); -ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE") or diag "Got:\n$text\n"; -#Usage: -# This is a test for CPAN#33020 -# -#Usage: -# And this will be also printed. -# -EOT - -# test that SYNOPSIS and USAGE are printed with options -($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file1, - -exitval => 0, -verbose => 1); }); -$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR -is ($exit, 0, "Exit status pod2usage with USAGE and verbose=1"); -ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE and verbose=1") or diag "Got:\n$text\n"; -#Usage: -# This is a test for CPAN#33020 -# -#Usage: -# And this will be also printed. -# -#Options: -# And this with verbose == 1 -# -EOT - -# test that only USAGE is printed when requested -($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file1, - -exitval => 0, -verbose => 99, -sections => 'USAGE'); }); -$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR -is ($exit, 0, "Exit status pod2usage with USAGE and verbose=99"); -ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE and verbose=99") or diag "Got:\n$text\n"; -#Usage: -# This is a test for CPAN#33020 -# -EOT - -# test with pod_where -use_ok('Pod::Find', qw(pod_where)); - -($exit, $text) = getoutput( sub { pod2usage( -input => pod_where({-inc => 1}, 'Pod::Usage'), - -exitval => 0, -verbose => 0) } ); -$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR -is ($exit, 0, "Exit status pod2usage with Pod::Find"); -ok (compare ($text, <<'EOT'), "Output test pod2usage with Pod::Find") or diag "Got:\n$text\n"; -#Usage: -# use Pod::Usage -# -# my $message_text = "This text precedes the usage message."; -# my $exit_status = 2; ## The exit status to use -# my $verbose_level = 0; ## The verbose level to use -# my $filehandle = \*STDERR; ## The filehandle to write to -# -# pod2usage($message_text); -# -# pod2usage($exit_status); -# -# pod2usage( { -message => $message_text , -# -exitval => $exit_status , -# -verbose => $verbose_level, -# -output => $filehandle } ); -# -# pod2usage( -msg => $message_text , -# -exitval => $exit_status , -# -verbose => $verbose_level, -# -output => $filehandle ); -# -# pod2usage( -verbose => 2, -# -noperldoc => 1 ) -# -EOT - -# verify that sections are correctly found after nested headings -($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file2, - -exitval => 0, -verbose => 99, - -sections => [qw(BugHeader BugHeader/.*')]) }); -$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR -is ($exit, 0, "Exit status pod2usage with nested headings"); -ok (compare ($text, <<'EOT'), "Output test pod2usage with nested headings") or diag "Got:\n$text\n"; -#BugHeader: -# Some text -# -# BugHeader2: -# More -# Still More -# -EOT - -# Verify that =over =back work OK -($exit, $text) = getoutput( sub { - pod2usage(-input => $pod_file2, - -exitval => 0, -verbose => 99, -sections => 'BugHeader/BugHeader2') } ); -$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR -is ($exit, 0, "Exit status pod2usage with over/back"); -ok (compare ($text, <<'EOT'), "Output test pod2usage with over/back") or diag "Got:\n$text\n"; -# BugHeader2: -# More -# Still More -# -EOT - -# new array API for -sections -($exit, $text) = getoutput( sub { - pod2usage(-input => $pod_file2, - -exitval => 0, -verbose => 99, -sections => [qw(Heading-1/!.+ Heading-2/.+)]) } ); -$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR -is ($exit, 0, "Exit status pod2usage with -sections => []"); -ok (compare ($text, <<'EOT'), "Output test pod2usage with -sections => []") or diag "Got:\n$text\n"; -#Heading-1: -# One -# Two -# -# Heading-2.2: -# More text. -# -EOT - -# allow subheadings in OPTIONS and ARGUMENTS -($exit, $text) = getoutput( sub { - pod2usage(-input => $pod_file2, - -exitval => 0, -verbose => 1) } ); -$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR -$text =~ s{[*](destination|files)[*]}{$1}g; # strip * chars -is ($exit, 0, "Exit status pod2usage with subheadings in OPTIONS"); -ok (compare ($text, <<'EOT'), "Output test pod2usage with subheadings in OPTIONS") or diag "Got:\n$text\n"; -#Options and Arguments: -# Arguments: -# The required arguments (which typically follow any options on the -# command line) are: -# -# destination -# files -# -# Options: -# Options may be abbreviated. Options which take values may be separated -# from the values by whitespace or the "=" character. -# -EOT -} # end SKIP - -__END__ - -=head1 NAME - -frobnicate - do what I mean - -=head1 SYNOPSIS - -B<frobnicate> S<[ B<-r> | B<--recursive> ]> S<[ B<-f> | B<--force> ]> - file ... - -=head1 DESCRIPTION - -B<frobnicate> does foo and bar and what not. - -=head1 OPTIONS - -=over 4 - -=item B<-r> | B<--recursive> - -Run recursively. - -=item B<-f> | B<--force> - -Just do it! - -=item B<-n> number - -Specify number of frobs, default is 42. - -=back - -=cut - +#!/usr/bin/perl -w + +use Test::More; +use strict; + +BEGIN { + if ($^O eq 'MSWin32' || $^O eq 'VMS') { + plan skip_all => "Not portable on Win32 or VMS\n"; + } + else { + plan tests => 34; + } + use_ok ("Pod::Usage"); +} + +sub getoutput +{ + my ($code) = @_; + my $pid = open(TEST_IN, "-|"); + unless(defined $pid) { + die "Cannot fork: $!"; + } + if($pid) { + # parent + my @out = <TEST_IN>; + close(TEST_IN); + my $exit = $?>>8; + s/^/#/ for @out; + local $" = ""; + print "#EXIT=$exit OUTPUT=+++#@out#+++\n"; + return($exit, join("",@out)); + } + # child + open(STDERR, ">&STDOUT"); + Test::More->builder->no_ending(1); + &$code; + print "--NORMAL-RETURN--\n"; + exit 0; +} + +sub compare +{ + my ($left,$right) = @_; + $left =~ s/^#\s+/#/gm; + $right =~ s/^#\s+/#/gm; + $left =~ s/\s+/ /gm; + $right =~ s/\s+/ /gm; + $left eq $right; +} + +SKIP: { +if('Pod::Usage'->isa('Pod::Text') && $Pod::Text::VERSION < 2.18) { + skip("Formatting with Pod::Text $Pod::Text::VERSION not reliable", 33); +} + +my ($exit, $text) = getoutput( sub { pod2usage() } ); +is ($exit, 2, "Exit status pod2usage ()"); +ok (compare ($text, <<'EOT'), "Output test pod2usage ()"); +#Usage: +# frobnicate [ -r | --recursive ] [ -f | --force ] file ... +# +EOT + +($exit, $text) = getoutput( sub { pod2usage( + -message => 'You naughty person, what did you say?', + -verbose => 1 ) }); +is ($exit, 1, "Exit status pod2usage (-message => '...', -verbose => 1)"); +ok (compare ($text, <<'EOT'), "Output test pod2usage (-message => '...', -verbose => 1)") or diag("Got:\n$text\n"); +#You naughty person, what did you say? +# Usage: +# frobnicate [ -r | --recursive ] [ -f | --force ] file ... +# +# Options: +# -r | --recursive +# Run recursively. +# +# -f | --force +# Just do it! +# +# -n number +# Specify number of frobs, default is 42. +# +EOT + +($exit, $text) = getoutput( sub { pod2usage( + -verbose => 2, -exit => 42 ) } ); +is ($exit, 42, "Exit status pod2usage (-verbose => 2, -exit => 42)"); +ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 2, -exit => 42)"); +#NAME +# frobnicate - do what I mean +# +# SYNOPSIS +# frobnicate [ -r | --recursive ] [ -f | --force ] file ... +# +# DESCRIPTION +# frobnicate does foo and bar and what not. +# +# OPTIONS +# -r | --recursive +# Run recursively. +# +# -f | --force +# Just do it! +# +# -n number +# Specify number of frobs, default is 42. +# +EOT + +($exit, $text) = getoutput( sub { pod2usage(0) } ); +is ($exit, 0, "Exit status pod2usage (0)"); +ok (compare ($text, <<'EOT'), "Output test pod2usage (0)"); +#Usage: +# frobnicate [ -r | --recursive ] [ -f | --force ] file ... +# +# Options: +# -r | --recursive +# Run recursively. +# +# -f | --force +# Just do it! +# +# -n number +# Specify number of frobs, default is 42. +# +EOT + +($exit, $text) = getoutput( sub { pod2usage(42) } ); +is ($exit, 42, "Exit status pod2usage (42)"); +ok (compare ($text, <<'EOT'), "Output test pod2usage (42)"); +#Usage: +# frobnicate [ -r | --recursive ] [ -f | --force ] file ... +# +EOT + +($exit, $text) = getoutput( sub { pod2usage(-verbose => 0, -exit => 'NOEXIT') } ); +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 ] file ... +# +# --NORMAL-RETURN-- +EOT + +($exit, $text) = getoutput( sub { pod2usage(-verbose => 99, -sections => 'DESCRIPTION') } ); +is ($exit, 1, "Exit status pod2usage (-verbose => 99, -sections => 'DESCRIPTION')"); +ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 99, -sections => 'DESCRIPTION')"); +#Description: +# frobnicate does foo and bar and what not. +# +EOT + +# does the __DATA__ work ok as input +my (@blib, $test_script, $pod_file1, , $pod_file2); +if (!$ENV{PERL_CORE}) { + @blib = '-Mblib'; +} +$test_script = File::Spec->catfile(qw(t pod p2u_data.pl)); +$pod_file1 = File::Spec->catfile(qw(t pod usage.pod)); +$pod_file2 = File::Spec->catfile(qw(t pod usage2.pod)); + + +($exit, $text) = getoutput( sub { system($^X, @blib, $test_script); exit($? >> 8); } ); +$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR +is ($exit, 17, "Exit status pod2usage (-verbose => 2, -input => \*DATA)"); +ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 2, -input => \*DATA)") or diag "Got:\n$text\n"; +#NAME +# Test +# +#SYNOPSIS +# perl podusagetest.pl +# +#DESCRIPTION +# This is a test. +# +EOT + +# test that SYNOPSIS and USAGE are printed +($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file1, + -exitval => 0, -verbose => 0); }); +$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR +is ($exit, 0, "Exit status pod2usage with USAGE"); +ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE") or diag "Got:\n$text\n"; +#Usage: +# This is a test for CPAN#33020 +# +#Usage: +# And this will be also printed. +# +EOT + +# test that SYNOPSIS and USAGE are printed with options +($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file1, + -exitval => 0, -verbose => 1); }); +$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR +is ($exit, 0, "Exit status pod2usage with USAGE and verbose=1"); +ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE and verbose=1") or diag "Got:\n$text\n"; +#Usage: +# This is a test for CPAN#33020 +# +#Usage: +# And this will be also printed. +# +#Options: +# And this with verbose == 1 +# +EOT + +# test that only USAGE is printed when requested +($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file1, + -exitval => 0, -verbose => 99, -sections => 'USAGE'); }); +$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR +is ($exit, 0, "Exit status pod2usage with USAGE and verbose=99"); +ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE and verbose=99") or diag "Got:\n$text\n"; +#Usage: +# This is a test for CPAN#33020 +# +EOT + +# test with pod_where +use_ok('Pod::Find', qw(pod_where)); + +($exit, $text) = getoutput( sub { pod2usage( -input => pod_where({-inc => 1}, 'Pod::Usage'), + -exitval => 0, -verbose => 0) } ); +$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR +is ($exit, 0, "Exit status pod2usage with Pod::Find"); +ok (compare ($text, <<'EOT'), "Output test pod2usage with Pod::Find") or diag "Got:\n$text\n"; +#Usage: +# use Pod::Usage +# +# my $message_text = "This text precedes the usage message."; +# my $exit_status = 2; ## The exit status to use +# my $verbose_level = 0; ## The verbose level to use +# my $filehandle = \*STDERR; ## The filehandle to write to +# +# pod2usage($message_text); +# +# pod2usage($exit_status); +# +# pod2usage( { -message => $message_text , +# -exitval => $exit_status , +# -verbose => $verbose_level, +# -output => $filehandle } ); +# +# pod2usage( -msg => $message_text , +# -exitval => $exit_status , +# -verbose => $verbose_level, +# -output => $filehandle ); +# +# pod2usage( -verbose => 2, +# -noperldoc => 1 ); +# +# pod2usage( -verbose => 2, +# -perlcmd => $path_to_perl, +# -perldoc => $path_to_perldoc ); +# +EOT + +# verify that sections are correctly found after nested headings +($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file2, + -exitval => 0, -verbose => 99, + -sections => [qw(BugHeader BugHeader/.*')]) }); +$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR +is ($exit, 0, "Exit status pod2usage with nested headings"); +ok (compare ($text, <<'EOT'), "Output test pod2usage with nested headings") or diag "Got:\n$text\n"; +#BugHeader: +# Some text +# +# BugHeader2: +# More +# Still More +# +EOT + +# Verify that =over =back work OK +($exit, $text) = getoutput( sub { + pod2usage(-input => $pod_file2, + -exitval => 0, -verbose => 99, -sections => 'BugHeader/BugHeader2') } ); +$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR +is ($exit, 0, "Exit status pod2usage with over/back"); +ok (compare ($text, <<'EOT'), "Output test pod2usage with over/back") or diag "Got:\n$text\n"; +# BugHeader2: +# More +# Still More +# +EOT + +# new array API for -sections +($exit, $text) = getoutput( sub { + pod2usage(-input => $pod_file2, + -exitval => 0, -verbose => 99, -sections => [qw(Heading-1/!.+ Heading-2/.+)]) } ); +$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR +is ($exit, 0, "Exit status pod2usage with -sections => []"); +ok (compare ($text, <<'EOT'), "Output test pod2usage with -sections => []") or diag "Got:\n$text\n"; +#Heading-1: +# One +# Two +# +# Heading-2.2: +# More text. +# +EOT + +# allow subheadings in OPTIONS and ARGUMENTS +($exit, $text) = getoutput( sub { + pod2usage(-input => $pod_file2, + -exitval => 0, -verbose => 1) } ); +$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR +$text =~ s{[*](destination|files)[*]}{$1}g; # strip * chars +is ($exit, 0, "Exit status pod2usage with subheadings in OPTIONS"); +ok (compare ($text, <<'EOT'), "Output test pod2usage with subheadings in OPTIONS") or diag "Got:\n$text\n"; +#Options and Arguments: +# Arguments: +# The required arguments (which typically follow any options on the +# command line) are: +# +# destination +# files +# +# Options: +# Options may be abbreviated. Options which take values may be separated +# from the values by whitespace or the "=" character. +# +EOT +} # end SKIP + +__END__ + +=head1 NAME + +frobnicate - do what I mean + +=head1 SYNOPSIS + +B<frobnicate> S<[ B<-r> | B<--recursive> ]> S<[ B<-f> | B<--force> ]> + file ... + +=head1 DESCRIPTION + +B<frobnicate> does foo and bar and what not. + +=head1 OPTIONS + +=over 4 + +=item B<-r> | B<--recursive> + +Run recursively. + +=item B<-f> | B<--force> + +Just do it! + +=item B<-n> number + +Specify number of frobs, default is 42. + +=back + +=cut + diff --git a/cpan/Pod-Usage/t/pod/selectheaders.pl b/cpan/Pod-Usage/t/pod/selectheaders.pl new file mode 100644 index 0000000..d0b557f --- /dev/null +++ b/cpan/Pod-Usage/t/pod/selectheaders.pl @@ -0,0 +1,34 @@ +#!/usr/bin/perl -w +use strict; +use Pod::Usage; + +my $h2 = shift @ARGV || '.*'; + +Pod::Usage::pod2usage( + '-verbose' => 99, + '-exitval' => 0, + '-sections' => "Name/$h2/!.+", +); + +=head1 Name + +Testing + +=head2 Foo + +This is foo + +=head3 Foo bar + +This is foo bar. + +=head2 Bar + +This is bar. + +=head3 Bar baz + +This is bar baz. + +=cut + diff --git a/cpan/Pod-Usage/t/pod/selectheaders.t b/cpan/Pod-Usage/t/pod/selectheaders.t new file mode 100644 index 0000000..ff138a3 --- /dev/null +++ b/cpan/Pod-Usage/t/pod/selectheaders.t @@ -0,0 +1,17 @@ +use Test::More tests => 2; + +my $blib = $ENV{PERL_CORE} ? '-I../../lib' : '-Mblib'; + +my $pl = $0; +$pl =~ s{t$}{pl}; + +my $out = `$^X $blib $pl Foo`; +$out =~ s{\s+}{ }gs; +$out =~ s{^\s+|\s+$}{}gs; +is($out, 'Foo: This is foo', 'selection of Foo section'); + +$out = `$^X $blib $pl Bar`; +$out =~ s{\s+}{ }gs; +$out =~ s{^\s+|\s+$}{}gs; +is($out, 'Bar: This is bar.', 'selection of Bar section'); + diff --git a/cpan/Pod-Usage/t/pod/selectsections.pl b/cpan/Pod-Usage/t/pod/selectsections.pl new file mode 100644 index 0000000..0f1ad82 --- /dev/null +++ b/cpan/Pod-Usage/t/pod/selectsections.pl @@ -0,0 +1,70 @@ +#!/usr/bin/env perl +use Pod::Usage; + +my @tests = ( + [ "NAME" , "ACTIONS", "ACTIONS/help" ], + 'DESCRIPTION|OPTIONS|ENVIRONMENT/Caveats', +); + +my $idx = shift(@ARGV) || 0; + +pod2usage( + -exitstatus => 0, + -verbose => 99, + -sections => $tests[$idx], + -noperldoc => 1 +); +1; + +__END__ + +=head1 NAME + +trypodi - pod sections usage test + +=head1 ACTIONS + +Para for actions. + +=head2 help + +Help text. + +=head1 DESCRIPTION + +Description text. + +=head2 Caveats + +Description caveat text. + +=head2 Other + +Description other text. + +=head1 OPTIONS + +Options text. + +=head2 Caveats + +Options caveat text. + +=head2 Other + +Options other text. + +=head1 ENVIRONMENT + +Environment text. + +=head2 Caveats + +Environment caveat text. + +=head2 Other + +Environment other text. + +=cut + diff --git a/cpan/Pod-Usage/t/pod/selectsections.t b/cpan/Pod-Usage/t/pod/selectsections.t new file mode 100644 index 0000000..d71c487 --- /dev/null +++ b/cpan/Pod-Usage/t/pod/selectsections.t @@ -0,0 +1,17 @@ +use Test::More tests => 2; + +my $blib = $ENV{PERL_CORE} ? '-I../../lib' : '-Mblib'; + +my $pl = $0; +$pl =~ s{t$}{pl}; + +my $out = `$^X $blib $pl 0`; +$out =~ s{\s+}{ }gs; +$out =~ s{^\s+|\s+$}{}gs; +is($out, 'Name: trypodi - pod sections usage test Actions: Para for actions. help: Help text.', 'selection of specific sections'); + +$out = `$^X $blib $pl 1`; +$out =~ s{\s+}{ }gs; +$out =~ s{^\s+|\s+$}{}gs; +is($out, 'Caveats: Description caveat text. Caveats: Options caveat text. Caveats: Environment caveat text.', 'selection of caveats sections'); + diff --git a/cpan/Pod-Usage/t/pod/testcmp.pl b/cpan/Pod-Usage/t/pod/testcmp.pl index b8592fc..17f0b0b 100644 --- a/cpan/Pod-Usage/t/pod/testcmp.pl +++ b/cpan/Pod-Usage/t/pod/testcmp.pl @@ -1,94 +1,94 @@ -package TestCompare; - -use vars qw(@ISA @EXPORT $MYPKG); -#use strict; -#use diagnostics; -use Carp; -use Exporter; -use File::Basename; -use File::Spec; -use FileHandle; - -@ISA = qw(Exporter); -@EXPORT = qw(&testcmp); -$MYPKG = eval { (caller)[0] }; - -##-------------------------------------------------------------------------- - -=head1 NAME - -testcmp -- compare two files line-by-line - -=head1 SYNOPSIS - - $is_diff = testcmp($file1, $file2); - -or - - $is_diff = testcmp({-cmplines => \&mycmp}, $file1, $file2); - -=head2 DESCRIPTION - -Compare two text files line-by-line and return 0 if they are the -same, 1 if they differ. Each of $file1 and $file2 may be a filenames, -or a filehandles (in which case it must already be open for reading). - -If the first argument is a hashref, then the B<-cmplines> key in the -hash may have a subroutine reference as its corresponding value. -The referenced user-defined subroutine should be a line-comparator -function that takes two pre-chomped text-lines as its arguments -(the first is from $file1 and the second is from $file2). It should -return 0 if it considers the two lines equivalent, and non-zero -otherwise. - -=cut - -##-------------------------------------------------------------------------- - -sub testcmp( $ $ ; $) { - my %opts = ref($_[0]) eq 'HASH' ? %{shift()} : (); - my ($file1, $file2) = @_; - my ($fh1, $fh2) = ($file1, $file2); - unless (ref $fh1) { - $fh1 = FileHandle->new($file1, "r") or die "Can't open $file1: $!"; - } - unless (ref $fh2) { - $fh2 = FileHandle->new($file2, "r") or die "Can't open $file2: $!"; - } - - my $cmplines = $opts{'-cmplines'} || undef; - my ($f1text, $f2text) = ("", ""); - my ($line, $diffs) = (0, 0); - - while ( defined($f1text) and defined($f2text) ) { - defined($f1text = <$fh1>) and chomp($f1text); - defined($f2text = <$fh2>) and chomp($f2text); - ++$line; - last unless ( defined($f1text) and defined($f2text) ); - # 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; - } - close($fh1) unless (ref $file1); - close($fh2) unless (ref $file2); - - $diffs = 1 if (defined($f1text) or defined($f2text)); - if ( defined($f1text) and defined($f2text) ) { - ## these two lines must be different - warn "$file1 and $file2 differ at line $line\n"; - } - elsif (defined($f1text) and (! defined($f1text))) { - ## file1 must be shorter - warn "$file1 is shorter than $file2\n"; - } - elsif (defined $f2text) { - ## file2 must be longer - warn "$file1 is shorter than $file2\n"; - } - return $diffs; -} - -1; +package TestCompare; + +use vars qw(@ISA @EXPORT $MYPKG); +#use strict; +#use diagnostics; +use Carp; +use Exporter; +use File::Basename; +use File::Spec; +use FileHandle; + +@ISA = qw(Exporter); +@EXPORT = qw(&testcmp); +$MYPKG = eval { (caller)[0] }; + +##-------------------------------------------------------------------------- + +=head1 NAME + +testcmp -- compare two files line-by-line + +=head1 SYNOPSIS + + $is_diff = testcmp($file1, $file2); + +or + + $is_diff = testcmp({-cmplines => \&mycmp}, $file1, $file2); + +=head2 DESCRIPTION + +Compare two text files line-by-line and return 0 if they are the +same, 1 if they differ. Each of $file1 and $file2 may be a filenames, +or a filehandles (in which case it must already be open for reading). + +If the first argument is a hashref, then the B<-cmplines> key in the +hash may have a subroutine reference as its corresponding value. +The referenced user-defined subroutine should be a line-comparator +function that takes two pre-chomped text-lines as its arguments +(the first is from $file1 and the second is from $file2). It should +return 0 if it considers the two lines equivalent, and non-zero +otherwise. + +=cut + +##-------------------------------------------------------------------------- + +sub testcmp( $ $ ; $) { + my %opts = ref($_[0]) eq 'HASH' ? %{shift()} : (); + my ($file1, $file2) = @_; + my ($fh1, $fh2) = ($file1, $file2); + unless (ref $fh1) { + $fh1 = FileHandle->new($file1, "r") or die "Can't open $file1: $!"; + } + unless (ref $fh2) { + $fh2 = FileHandle->new($file2, "r") or die "Can't open $file2: $!"; + } + + my $cmplines = $opts{'-cmplines'} || undef; + my ($f1text, $f2text) = ("", ""); + my ($line, $diffs) = (0, 0); + + while ( defined($f1text) and defined($f2text) ) { + defined($f1text = <$fh1>) and chomp($f1text); + defined($f2text = <$fh2>) and chomp($f2text); + ++$line; + last unless ( defined($f1text) and defined($f2text) ); + # 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; + } + close($fh1) unless (ref $file1); + close($fh2) unless (ref $file2); + + $diffs = 1 if (defined($f1text) or defined($f2text)); + if ( defined($f1text) and defined($f2text) ) { + ## these two lines must be different + warn "$file1 and $file2 differ at line $line\n"; + } + elsif (defined($f1text) and (! defined($f1text))) { + ## file1 must be shorter + warn "$file1 is shorter than $file2\n"; + } + elsif (defined $f2text) { + ## file2 must be longer + warn "$file1 is shorter than $file2\n"; + } + return $diffs; +} + +1; diff --git a/cpan/Pod-Usage/t/pod/testp2pt.pl b/cpan/Pod-Usage/t/pod/testp2pt.pl index 5c17300..308cd1c 100644 --- a/cpan/Pod-Usage/t/pod/testp2pt.pl +++ b/cpan/Pod-Usage/t/pod/testp2pt.pl @@ -1,192 +1,192 @@ -package TestPodIncPlainText; - -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"; - import TestCompare; - my $PARENTDIR = dirname $THISDIR; - push @INC, map { File::Spec->catfile($_, '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 { - 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 catfile(@) { File::Spec->catfile(@_); } - -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 = ( catfile($INSTDIR, 'lib', 'Pod'), - catfile($INSTDIR, 'scripts'), - catfile($INSTDIR, 'pod'), - catfile($INSTDIR, 't', 'pod') - ); - -# FIXME - we should make the core capable of finding utilities built in -# locations in ext. -push @PODINCDIRS, catfile((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 = 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!"; **** PATCH TRUNCATED AT 2000 LINES -- 427 NOT SHOWN **** -- Perl5 Master Repository
