Upgrade to Pod::Parser 1.33
Rafael Garcia-Suarez [Wed, 21 Sep 2005 15:31:02 +0000 (15:31 +0000)]
p4raw-id: //depot/perl@25543

MANIFEST
lib/Pod/Checker.pm
lib/Pod/InputObjects.pm
lib/Pod/ParseUtils.pm
lib/Pod/Parser.pm
lib/Pod/Select.pm
lib/Pod/Usage.pm
t/pod/find.t
t/pod/pod2usage2.t [new file with mode: 0644]
t/pod/poderrs.xr

index dadb716..8dd603c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2976,6 +2976,7 @@ t/pod/oneline_cmds.t              Test single paragraph ==cmds
 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
index f20fe84..49162da 100644 (file)
@@ -10,7 +10,7 @@
 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
@@ -57,7 +57,7 @@ Curious/ambitious users are welcome to propose additional features they wish
 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
 
@@ -142,7 +142,7 @@ There is no specification of the formatter after the C<=for> command.
 =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>"
@@ -234,7 +234,7 @@ C<=over>/C<=back> block.
 
 =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.
 
@@ -623,9 +623,11 @@ sub poderror {
         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');
+    }
 }
 
 ##################################
@@ -1101,7 +1103,7 @@ sub _check_ptree {
         }
         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
index 222061f..fa5f61f 100644 (file)
@@ -183,7 +183,7 @@ sub name {
         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__
 
index 64c92b6..8788601 100644 (file)
@@ -10,7 +10,7 @@
 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
@@ -357,7 +357,7 @@ sub parse {
         $type = 'item';
     }
     # non-standard: Hyperlink
-    elsif(m!^((?:http|ftp|mailto|news):.+)$!i) {
+    elsif(m!^(\w+:[^:\s]\S*)$!i) {
         $node = $1;
         $type = 'hyperlink';
     }
@@ -371,7 +371,7 @@ sub parse {
         ($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';
     }
index 6c3f161..a5fde84 100644 (file)
@@ -10,7 +10,7 @@
 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
 
 #############################################################################
@@ -118,7 +118,7 @@ You may also want to override the B<begin_input()> and B<end_input()>
 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()>.
 
@@ -140,7 +140,7 @@ to avoid name collisions.
 
 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
@@ -651,7 +651,7 @@ them in simple bottom-up order.
 
 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
@@ -1066,7 +1066,6 @@ sub parse_from_filehandle {
     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
@@ -1157,20 +1156,13 @@ sub parse_from_file {
     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";
         }
@@ -1179,6 +1171,14 @@ sub parse_from_file {
         $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;
@@ -1194,20 +1194,7 @@ sub parse_from_file {
     ## 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";
@@ -1227,6 +1214,19 @@ sub parse_from_file {
             $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>";
index d0cbec6..1cc14df 100644 (file)
@@ -428,7 +428,7 @@ sub clear_selections {
 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
@@ -575,7 +575,7 @@ are used.
 
 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 
index 0827dcc..c298e94 100644 (file)
@@ -10,7 +10,7 @@
 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
@@ -40,6 +40,9 @@ Pod::Usage, pod2usage() - print a usage message from embedded pod documentation
                -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
@@ -94,7 +97,8 @@ is 1, then the "SYNOPSIS" section, along with any section entitled
 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>
 
@@ -123,6 +127,14 @@ to an array, or by a string of directory paths which use the same path
 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
@@ -200,8 +212,8 @@ to C<STDOUT>, just in case the user wants to pipe the output to a pager
 =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
@@ -387,6 +399,11 @@ similar to the following:
 
     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>.
@@ -433,7 +450,7 @@ BEGIN {
 ##---------------------------------
 
 sub pod2usage {
-    local($_) = shift || "";
+    local($_) = shift;
     my %opts;
     ## Collect arguments
     if (@_ > 0) {
@@ -441,6 +458,9 @@ sub pod2usage {
         ## 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');
@@ -503,7 +523,7 @@ sub pod2usage {
     ## 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)' .
@@ -517,7 +537,8 @@ sub pod2usage {
     }
 
     ## 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 )
     {
@@ -562,6 +583,9 @@ sub select {
     }
 }
 
+# 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.
index 2058601..66b65c5 100644 (file)
@@ -88,7 +88,6 @@ print "### found $result\n";
 
 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`
@@ -102,31 +101,19 @@ else {
 }
 
 # 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
diff --git a/t/pod/pod2usage2.t b/t/pod/pod2usage2.t
new file mode 100644 (file)
index 0000000..04890f2
--- /dev/null
@@ -0,0 +1,178 @@
+#!/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
+
index a8ef58b..5b40d7a 100644 (file)
@@ -17,7 +17,7 @@
 *** 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