package Pod::Usage;
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
=head1 NAME
-verbose => $verbose_level,
-output => $filehandle );
+ pod2usage( -verbose => 2,
+ -noperldoc => 1 )
+
=head1 ARGUMENTS
B<pod2usage> should be given either a single argument, or a list of
"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
-parameter; then these sections are extracted and printed.
+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">.
separator as C<$ENV{PATH}> on your system (e.g., C<:> for Unix, C<;> for
MSWin32 and DOS).
+=item C<-noperldoc>
+
+By default, Pod::Usage will call L<perldoc> when -verbose >= 2 is
+specified. This does not work well e.g. if the script was packed
+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.
+
=back
=head1 DESCRIPTION
=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
pod2usage(-exitval => 2, -input => "/path/to/your/pod/docs");
+In the pathological case that a script is called via a relative path
+I<and> the script itself changes the current working directory
+(see L<perlfunc/chdir>) I<before> calling pod2usage, Pod::Usage will
+fail even on robust platforms. Don't do that.
+
=head1 AUTHOR
Please report bugs using L<http://rt.cpan.org>.
Based on code for B<Pod::Text::pod2text()> written by
Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
-=head1 ACKNOWLEDGEMENTS
+=head1 ACKNOWLEDGMENTS
Steven McDougall E<lt>swmcd@world.std.comE<gt> for his help and patience
with re-writing this manpage.
##---------------------------------
sub pod2usage {
- local($_) = shift || "";
+ local($_) = shift;
my %opts;
## Collect arguments
if (@_ > 0) {
## the user forgot to pass a reference to it.
%opts = ($_, @_);
}
+ elsif (!defined $_) {
+ $_ = "";
+ }
elsif (ref $_) {
## User passed a ref to a hash
%opts = %{$_} if (ref($_) eq 'HASH');
## Now create a pod reader and constrain it to the desired sections.
my $parser = new Pod::Usage(USAGE_OPTIONS => \%opts);
if ($opts{"-verbose"} == 0) {
- $parser->select("SYNOPSIS");
+ $parser->select('SYNOPSIS\s*');
}
elsif ($opts{"-verbose"} == 1) {
my $opt_re = '(?i)' .
'(?:\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;
}
## Now translate the pod document and then exit with the desired status
- if ( $opts{"-verbose"} >= 2
+ if ( !$opts{"-noperldoc"}
+ and $opts{"-verbose"} >= 2
and !ref($opts{"-input"})
and $opts{"-output"} == \*STDOUT )
{
## 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"});
}
}
+# Override Pod::Text->seq_i to return just "arg", not "*arg*".
+sub seq_i { return $_[1] }
+
# 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.
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];
}
$$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} || !@{ $$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} };
projects / p5sagit/p5-mst-13.2.git / blobdiff