t/pod/oneline_cmds.xr Expected results for oneline_cmds.t
t/pod/plainer.t Test Pod::Plainer
t/pod/pod2usage.t Test Pod::Usage
+t/pod/pod2usage2.t Test Pod::Usage
t/pod/pod2usage.xr Expected results for pod2usage.t
t/pod/poderrs.t Test POD errors
t/pod/poderrs.xr Expected results for poderrs.t
package Pod::Checker;
use vars qw($VERSION);
-$VERSION = 1.42; ## Current version of this package
+$VERSION = 1.43; ## Current version of this package
require 5.005; ## requires this Perl version or later
use Pod::ParseUtils; ## for hyperlinks and lists
to see in B<Pod::Checker> and B<podchecker> and verify that the checks are
consistent with L<perlpod>.
-The following checks are currently preformed:
+The following checks are currently performed:
=over 4
=item * unresolved internal link I<NAME>
The given link to I<NAME> does not have a matching node in the current
-POD. This also happens when a single word node name is not enclosed in
+POD. This also happend when a single word node name is not enclosed in
C<"">.
=item * Unknown command "I<CMD>"
=item * =item type mismatch (I<one> vs. I<two>)
-A list started with e.g. a bulleted C<=item> and continued with a
+A list started with e.g. a bulletted 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.
if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR'));
++($self->{_NUM_WARNINGS})
if(!%opts || ($opts{-severity} && $opts{-severity} eq 'WARNING'));
- my $out_fh = $self->output_handle() || \*STDERR;
- print $out_fh ($severity, $msg, $line, $file, "\n")
- if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING');
+ unless($self->{-quiet}) {
+ my $out_fh = $self->output_handle() || \*STDERR;
+ print $out_fh ($severity, $msg, $line, $file, "\n")
+ if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING');
+ }
}
##################################
}
if($nestlist =~ /$cmd/) {
$self->poderror({ -line => $line, -file => $file,
- -severity => 'ERROR',
+ -severity => 'WARNING',
-msg => "nested commands $cmd<...$cmd<...>...>"});
# _TODO_ should we add the contents anyway?
# expand it anyway, see below
my $handle = $pod_input->handle();
Returns a reference to the handle object from which input is read (the
-one used to construct this input source object).
+one used to contructed this input source object).
=end __PRIVATE__
package Pod::ParseUtils;
use vars qw($VERSION);
-$VERSION = 1.30; ## Current version of this package
+$VERSION = 1.33; ## Current version of this package
require 5.005; ## requires this Perl version or later
=head1 NAME
$type = 'item';
}
# non-standard: Hyperlink
- elsif(m!^((?:http|ftp|mailto|news):.+)$!i) {
+ elsif(m!^(\w+:[^:\s]\S*)$!i) {
$node = $1;
$type = 'hyperlink';
}
($alttext, $node) = ($1,$2);
}
# nonstandard: alttext and hyperlink
- elsif(m!^(.*?)\s*[|]\s*((?:http|ftp|mailto|news):.+)$!) {
+ elsif(m!^(.*?)\s*[|]\s*(\w+:[^:\s]\S*)$!) {
($alttext, $node) = ($1,$2);
$type = 'hyperlink';
}
package Pod::Parser;
use vars qw($VERSION);
-$VERSION = 1.30; ## Current version of this package
+$VERSION = 1.32; ## Current version of this package
require 5.005; ## requires this Perl version or later
#############################################################################
methods for your subclass (to perform any needed per-file and/or
per-document initialization or cleanup).
-If you need to perform any preprocessing of input before it is parsed
+If you need to perform any preprocesssing of input before it is parsed
you may want to override one or more of B<preprocess_line()> and/or
B<preprocess_paragraph()>.
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 interpret the commands and translate the result.
+how to intepret 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
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 corresponding to the beginning of C<$text>.
+line number curresponding to the beginning of C<$text>.
B<parse_text()> will parse the given text into a parse-tree of "nodes."
and interior-sequences. Each "node" in the parse tree is either a
while (defined ($textline = $tied_fh ? <$in_fh> : $in_fh->getline)) {
$textline = $self->preprocess_line($textline, ++$nlines);
next unless ((defined $textline) && (length $textline));
- $_ = $paragraph; ## save previous contents
if ((! length $paragraph) && ($textline =~ /^==/)) {
## '==' denotes a one-line command paragraph
my $self = shift;
my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
my ($infile, $outfile) = @_;
- my ($in_fh, $out_fh) = (gensym, gensym) if ($] < 5.6);
+ my ($in_fh, $out_fh) = (gensym(), gensym()) if ($] < 5.006);
my ($close_input, $close_output) = (0, 0);
local *myData = $self;
local *_;
## Is $infile a filename or a (possibly implied) filehandle
- $infile = '-' unless ((defined $infile) && (length $infile));
- if (($infile eq '-') || ($infile =~ /^<&(STDIN|0)$/i)) {
- ## Not a filename, just a string implying STDIN
- $infile ||= '-';
- $myData{_INFILE} = "<standard input>";
- $in_fh = \*STDIN;
- }
- elsif (ref $infile) {
+ if (defined $infile && ref $infile) {
if (ref($infile) =~ /^(SCALAR|ARRAY|HASH|CODE|REF)$/) {
croak "Input from $1 reference not supported!\n";
}
$myData{_INFILE} = ${$infile};
$in_fh = $infile;
}
+ elsif (!defined($infile) || !length($infile) || ($infile eq '-')
+ || ($infile =~ /^<&(?:STDIN|0)$/i))
+ {
+ ## Not a filename, just a string implying STDIN
+ $infile ||= '-';
+ $myData{_INFILE} = "<standard input>";
+ $in_fh = \*STDIN;
+ }
else {
## We have a filename, open it for reading
$myData{_INFILE} = $infile;
## already
## Is $outfile a filename, a (possibly implied) filehandle, maybe a ref?
- if (!defined($outfile) || !length($outfile) || ($outfile eq '-')
- || ($outfile =~ /^>&?(?:STDOUT|1)$/i))
- {
- if (defined $myData{_TOP_STREAM}) {
- $out_fh = $myData{_OUTPUT};
- }
- else {
- ## Not a filename, just a string implying STDOUT
- $outfile ||= '-';
- $myData{_OUTFILE} = "<standard output>";
- $out_fh = \*STDOUT;
- }
- }
- elsif (ref $outfile) {
+ if (ref $outfile) {
## we need to check for ref() first, as other checks involve reading
if (ref($outfile) =~ /^(ARRAY|HASH|CODE)$/) {
croak "Output to $1 reference not supported!\n";
$out_fh = $outfile;
}
}
+ elsif (!defined($outfile) || !length($outfile) || ($outfile eq '-')
+ || ($outfile =~ /^>&?(?:STDOUT|1)$/i))
+ {
+ if (defined $myData{_TOP_STREAM}) {
+ $out_fh = $myData{_OUTPUT};
+ }
+ else {
+ ## Not a filename, just a string implying STDOUT
+ $outfile ||= '-';
+ $myData{_OUTFILE} = "<standard output>";
+ $out_fh = \*STDOUT;
+ }
+ }
elsif ($outfile =~ /^>&(STDERR|2)$/i) {
## Not a filename, just a string implying STDERR
$myData{_OUTFILE} = "<standard error>";
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).
+there are no explictly selected/deselected sections).
The arguments C<$heading1>, C<$heading2>, etc. are the heading titles of
the corresponding sections, subsections, etc. to try and match. If
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
+be interpeted to mean standard input (which is the default if no
filenames are given).
=cut
package Pod::Usage;
use vars qw($VERSION);
-$VERSION = 1.30; ## Current version of this package
+$VERSION = 1.33; ## 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
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.
+parameter; then these sections are extracted (see L<Pod::Select>)
+and printed.
=item C<-section>
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
-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
+desireable to exit with a status of 1 (as opposed to 0) after issuing
+the user-requested usage message. It is also desireable to give a
more verbose description of program usage in this case.
=back
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>.
##---------------------------------
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)' .
}
## 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 )
{
}
}
+# 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.
require Config;
if ($^O eq 'VMS') { # privlib is perl_root:[lib] OK but not under mms
- $result = VMS::Filespec::vmsify($result); #if you want VMS you need to force it.
$compare = "lib.File]Find.pm";
$result =~ s/perl_root:\[\-?\.?//i;
$result =~ s/\[\-?\.?//i; # needed under `mms test`
}
# Search for a documentation pod rather than a module
-my $searchpod = $ENV{PERL_CORE} ? 'Stuff' : 'perlfunc';
+my $searchpod = 'Stuff';
print "### searching for $searchpod.pod\n";
-$result = pod_where($ENV{PERL_CORE} ?
- { -dirs => [ File::Spec->catdir('pod', 'testpods', 'lib', 'Pod') ],
- -verbose => $VERBOSE }
- : { -inc => 1, -verbose => $VERBOSE }, $searchpod)
+$result = pod_where(
+ { -dirs => [ File::Spec->catdir(
+ $ENV{PERL_CORE} ? () : qw(t), 'pod', 'testpods', 'lib', 'Pod') ],
+ -verbose => $VERBOSE }, $searchpod)
|| "undef - $searchpod.pod not found!";
print "### found $result\n";
-if($ENV{PERL_CORE}) {
- $compare = File::Spec->catfile('pod', 'testpods', 'lib', 'Pod' ,'Stuff.pm');
- ok(_canon($result),_canon($compare));
-}
-elsif ($^O eq 'VMS') { # privlib is perl_root:[lib] unfortunately
- $compare = "/lib/pod/perlfunc.pod";
- $result = VMS::Filespec::unixify($result);
- $result =~ s/perl_root\///i;
- $result =~ s/^\.\.//; # needed under `mms test`
- ok($result,$compare);
-}
-else {
- $compare = File::Spec->catfile($Config::Config{privlib},
- ($^O =~ /macos|darwin|cygwin/i ? 'pods' : 'pod'),"perlfunc.pod");
- ok(_canon($result),_canon($compare));
-}
+$compare = File::Spec->catfile(
+ $ENV{PERL_CORE} ? () : qw(t),
+ 'pod', 'testpods', 'lib', 'Pod' ,'Stuff.pm');
+ok(_canon($result),_canon($compare));
# make the path as generic as possible
sub _canon
--- /dev/null
+#!/usr/bin/perl -w
+
+use Test;
+
+BEGIN {
+ plan tests => 8;
+}
+
+eval "use Pod::Usage";
+
+ok($@ eq '');
+
+sub getoutput
+{
+ my ($code) = @_;
+ my $pid = open(IN, "-|");
+ unless(defined $pid) {
+ die "Cannot fork: $!";
+ }
+ if($pid) {
+ # parent
+ my @out = <IN>;
+ close(IN);
+ my $exit = $?>>8;
+ print "\nEXIT=$exit OUTPUT=+++\n@out+++\n";
+ return($exit, join("",@out));
+ }
+ # child
+ open(STDERR, ">&STDOUT");
+ &$code;
+ print "--NORMAL-RETURN--\n";
+ exit 0;
+}
+
+sub compare
+{
+ my ($left,$right) = @_;
+ $left =~ s/[\r\n]+/\n/sg;
+ $right =~ s/[\r\n]+/\n/sg;
+ $left =~ s/\s+/ /gm;
+ $right =~ s/\s+/ /gm;
+ $left eq $right;
+}
+
+# test 2
+my ($exit, $text) = getoutput( sub { pod2usage() } );
+ok($exit == 2 && compare($text, <<'EOT'));
+Usage:
+ frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+
+EOT
+
+# test 3
+($exit, $text) = getoutput( sub { pod2usage(
+ -message => 'You naughty person, what did you say?',
+ -verbose => 1 ) } );
+ok($exit == 1 && compare($text,<<'EOT'));
+You naughty person, what did you say?
+ Usage:
+ frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+
+ Options:
+ -r | --recursive
+ Run recursively.
+
+ -f | --force
+ Just do it!
+
+ -n number
+ Specify number of frobs, default is 42.
+
+EOT
+
+# test 4
+($exit, $text) = getoutput( sub { pod2usage(
+ -verbose => 2, -exit => 42 ) } );
+ok($exit == 42 && compare($text,<<'EOT'));
+NAME
+ frobnicate - do what I mean
+
+ SYNOPSIS
+ frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] 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
+
+# test 5
+($exit, $text) = getoutput( sub { pod2usage(0) } );
+ok($exit == 0 && compare($text, <<'EOT'));
+Usage:
+ frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+
+ Options:
+ -r | --recursive
+ Run recursively.
+
+ -f | --force
+ Just do it!
+
+ -n number
+ Specify number of frobs, default is 42.
+
+EOT
+
+# test 6
+($exit, $text) = getoutput( sub { pod2usage(42) } );
+ok($exit == 42 && compare($text, <<'EOT'));
+Usage:
+ frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+
+EOT
+
+# test 7
+($exit, $text) = getoutput( sub { pod2usage(-verbose => 0, -exit => 'NOEXIT') } );
+ok($exit == 0 && compare($text, <<'EOT'));
+Usage:
+ frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
+
+ --NORMAL-RETURN--
+EOT
+
+# test 8
+($exit, $text) = getoutput( sub { pod2usage(-verbose => 99, -sections => 'DESCRIPTION') } );
+ok($exit == 1 && compare($text, <<'EOT'));
+Description:
+ frobnicate does foo and bar and what not.
+
+EOT
+
+
+
+__END__
+
+=head1 NAME
+
+frobnicate - do what I mean
+
+=head1 SYNOPSIS
+
+B<frobnicate> S<[ B<-r> | B<--recursive> ]> S<[ B<-f> | B<--force> ]>
+ S<[ B<-n> I<number> ]> I<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> I<number>
+
+Specify number of frobs, default is 42.
+
+=back
+
+=cut
+
*** ERROR: =end without =begin at line 77 in file t/pod/poderrs.t
*** ERROR: No argument for =begin at line 83 in file t/pod/poderrs.t
*** ERROR: =for without formatter specification at line 89 in file t/pod/poderrs.t
-*** ERROR: nested commands C<...C<...>...> at line 95 in file t/pod/poderrs.t
+*** WARNING: nested commands C<...C<...>...> at line 95 in file t/pod/poderrs.t
*** ERROR: garbled entity E<alea iacta est> at line 99 in file t/pod/poderrs.t
*** ERROR: garbled entity E<C<auml>> at line 100 in file t/pod/poderrs.t
*** ERROR: garbled entity E<abcI<bla>> at line 101 in file t/pod/poderrs.t
projects / p5sagit/p5-mst-13.2.git / commitdiff