Upgrade to Pod::Perldoc 3.13

p4raw-id: //depot/perl@22916

diff --git a/MANIFEST b/MANIFEST
index 4ccdbfc..605b77d 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1549,6 +1549,7 @@ lib/Pod/ParseUtils.pm             Pod-Parser - pod utility functions
 lib/Pod/Perldoc/BaseTo.pm      utility module for perldoc
 lib/Pod/Perldoc/GetOptsOO.pm   options parsing for perldoc
 lib/Pod/Perldoc.pm             guts of the 'perldoc' utility
+lib/Pod/Perldoc/t/01_about_verbose.t   test Pod::Perldoc
 lib/Pod/Perldoc/t/checkerbasic.t       test Pod::Perldoc::ToChecker
 lib/Pod/Perldoc/ToChecker.pm   let perldoc check POD for errors
 lib/Pod/Perldoc/ToMan.pm       render POD as man pages

diff --git a/lib/Pod/Perldoc.pm b/lib/Pod/Perldoc.pm
index 178481e..0a4381f 100644 (file)
--- a/lib/Pod/Perldoc.pm
+++ b/lib/Pod/Perldoc.pm
@@ -12,7 +12,7 @@ use File::Spec::Functions qw(catfile catdir splitdir);
 use vars qw($VERSION @Pagers $Bindir $Pod2man
   $Temp_Files_Created $Temp_File_Lifetime
 );
-$VERSION = '3.12';
+$VERSION = '3.13';
 #..........................................................................
 
 BEGIN {  # Make a DEBUG constant very first thing...
@@ -1313,10 +1313,12 @@ sub check_file {
     unless( ref $self ) {
       # Should never get called:
       $Carp::Verbose = 1;
-      Carp::croak join '',
+      require Carp;
+      Carp::croak( join '',
         "Crazy ", __PACKAGE__, " error:\n",
         "check_file must be an object_method!\n",
         "Aborting"
+      );
     }
     
     if(length $dir and not -d $dir) {

diff --git a/lib/Pod/Perldoc/ToMan.pm b/lib/Pod/Perldoc/ToMan.pm
index 12c2a68..83b7142 100644 (file)
--- a/lib/Pod/Perldoc/ToMan.pm
+++ b/lib/Pod/Perldoc/ToMan.pm
@@ -46,14 +46,22 @@ sub parse_from_file {
       grep !m/^_/s,
         keys %$self
   ;
-  
-  my $command =
+
+  my $pod2man =
     catfile(
       ($self->{'__bindir'}  || die "no bindir set?!"  ),
       ($self->{'__pod2man'} || die "no pod2man set?!" ),
     )
-    . " $switches --lax $file | $render -man"
-  ;               # no temp file, just a pipe!
+  ;
+  unless(-e $pod2man) {
+    # This is rarely needed, I think.
+    $pod2man = $self->{'__pod2man'} || die "no pod2man set?!";
+    die "Can't find a pod2man?! (". $self->{'__pod2man'} .")\nAborting"
+      unless -e $pod2man;
+  }
+
+  my $command = "$pod2man $switches --lax $file | $render -man";
+         # no temp file, just a pipe!
 
   # Thanks to Brendan O'Dea for contributing the following block
   if(Pod::Perldoc::IS_Linux and -t STDOUT
@@ -158,7 +166,7 @@ L<Pod::Man>, L<Pod::Perldoc>, L<Pod::Perldoc::ToNroff>
 
 =head1 COPYRIGHT AND DISCLAIMERS
 
-Copyright (c) 2002 Sean M. Burke.  All rights reserved.
+Copyright (c) 2002,3,4 Sean M. Burke.  All rights reserved.
 
 This library is free software; you can redistribute it and/or modify it
 under the same terms as Perl itself.

diff --git a/lib/Pod/Perldoc/t/01_about_verbose.t b/lib/Pod/Perldoc/t/01_about_verbose.t
new file mode 100644 (file)
index 0000000..eb2f411
--- /dev/null
+++ b/lib/Pod/Perldoc/t/01_about_verbose.t
@@ -0,0 +1,87 @@
+
+require 5;
+# Time-stamp: "2004-04-09 18:02:36 ADT"
+
+# Summary of, well, things.
+
+use Test;
+BEGIN {plan tests => 2};
+
+ok 1;
+
+use Pod::Perldoc;
+
+#chdir "t" if -e "t";
+
+{
+  my @out;
+  push @out,
+    "\n\nPerl v",
+    defined($^V) ? sprintf('%vd', $^V) : $],
+    " under $^O ",
+    (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber())
+      ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (),
+    (defined $MacPerl::Version)
+      ? ("(MacPerl version $MacPerl::Version)") : (),
+    "\n"
+  ;
+
+  # Ugly code to walk the symbol tables:
+  my %v;
+  my @stack = ('');  # start out in %::
+  my $this;
+  my $count = 0;
+  my $pref;
+  while(@stack) {
+    $this = shift @stack;
+    die "Too many packages?" if ++$count > 1000;
+    next if exists $v{$this};
+    next if $this eq 'main'; # %main:: is %::
+
+    #print "Peeking at $this => ${$this . '::VERSION'}\n";
+    
+    if(defined ${$this . '::VERSION'} ) {
+      $v{$this} = ${$this . '::VERSION'}
+    } elsif(
+       defined *{$this . '::ISA'} or defined &{$this . '::import'}
+       or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"})
+       # If it has an ISA, an import, or any subs...
+    ) {
+      # It's a class/module with no version.
+      $v{$this} = undef;
+    } else {
+      # It's probably an unpopulated package.
+      ## $v{$this} = '...';
+    }
+    
+    $pref = length($this) ? "$this\::" : '';
+    push @stack, map m/^(.+)::$/ ? "$pref$1" : (), keys %{$this . '::'};
+    #print "Stack: @stack\n";
+  }
+  push @out, " Modules in memory:\n";
+  delete @v{'', '[none]'};
+  foreach my $p (sort {lc($a) cmp lc($b)} keys %v) {
+    $indent = ' ' x (2 + ($p =~ tr/:/:/));
+    push @out,  '  ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n";
+  }
+  push @out, sprintf "[at %s (local) / %s (GMT)]\n",
+    scalar(gmtime), scalar(localtime);
+  my $x = join '', @out;
+  $x =~ s/^/#/mg;
+  print $x;
+}
+
+print "# Running",
+  (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n",
+  "#\n",
+;
+
+print "# \@INC:\n", map("#   [$_]\n", @INC), "#\n#\n";
+
+print "# \%INC:\n";
+foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) {
+  print "#   [$x] = [", $INC{$x} || '', "]\n";
+}
+
+ok 1;
+