One quick fix to the test for differences in error output.

[p5sagit/p5-mst-13.2.git] / lib / Pod / Perldoc.pm

diff --git a/lib/Pod/Perldoc.pm b/lib/Pod/Perldoc.pm
index 8f1bb0c..6105e1d 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.11';
+$VERSION = '3.14_01';
 #..........................................................................
 
 BEGIN {  # Make a DEBUG constant very first thing...
@@ -62,7 +62,7 @@ $Pod2man = "pod2man" . ( $Config{'versiononly'} ? $Config{'version'} : '' );
 #
 # Option accessors...
 
-foreach my $subname (map "opt_$_", split '', q{mhlvriFfXqnTdU}) {
+foreach my $subname (map "opt_$_", split '', q{mhlvriFfXqnTdUL}) {
   no strict 'refs';
   *$subname = do{ use strict 'refs';  sub () { shift->_elem($subname, @_) } };
 }
@@ -71,6 +71,7 @@ foreach my $subname (map "opt_$_", split '', q{mhlvriFfXqnTdU}) {
 sub opt_f_with { shift->_elem('opt_f', @_) }
 sub opt_q_with { shift->_elem('opt_q', @_) }
 sub opt_d_with { shift->_elem('opt_d', @_) }
+sub opt_L_with { shift->_elem('opt_L', @_) }
 
 sub opt_w_with { # Specify an option for the formatter subclass
   my($self, $value) = @_;
@@ -247,18 +248,19 @@ Options:
     -i   Ignore case
     -t   Display pod using pod2text instead of pod2man and nroff
              (-t is the default on win32 unless -n is specified)
-    -u  Display unformatted pod text
+    -u   Display unformatted pod text
     -m   Display module's file in its entirety
     -n   Specify replacement for nroff
     -l   Display the module's file name
     -F   Arguments are file names, not modules
-    -v  Verbosely describe what's going on
+    -v   Verbosely describe what's going on
     -T   Send output to STDOUT without any pager
     -d output_filename_to_send_to
     -o output_format_name
     -M FormatterModuleNameToUse
     -w formatter_option:option_value
-    -X  use index if present (looks for pod.idx at $Config{archlib})
+    -L translation_code   Choose doc translation (if any)
+    -X   use index if present (looks for pod.idx at $Config{archlib})
     -q   Search the text of questions (not answers) in perlfaq[1-9]
 
 PageName|ModuleName...
@@ -291,7 +293,7 @@ sub usage_brief {
   $me =~ s,.*[/\\],,; # get basename
   
   die <<"EOUSAGE";
-Usage: $me [-h] [-V] [-r] [-i] [-v] [-t] [-u] [-m] [-n nroffer_program] [-l] [-T] [-d output_filename] [-o output_format] [-M FormatterModuleNameToUse] [-w formatter_option:option_value] [-F] [-X] PageName|ModuleName|ProgramName
+Usage: $me [-h] [-V] [-r] [-i] [-v] [-t] [-u] [-m] [-n nroffer_program] [-l] [-T] [-d output_filename] [-o output_format] [-M FormatterModuleNameToUse] [-w formatter_option:option_value] [-L translation_code] [-F] [-X] PageName|ModuleName|ProgramName
        $me -f PerlFunc
        $me -q FAQKeywords
 
@@ -417,6 +419,12 @@ sub process {
 
     return $self->usage_brief  unless  @pages;
 
+    # Adjusts pages for translation packages
+    if ( $self->opt_L ) {
+        eval "require POD2::" . uc($self->opt_L);
+        @pages = map { 'POD2::' . uc($self->opt_L) . '::' . $_ } @pages if ! $@;
+    }
+
     $self->find_good_formatter_class();
     $self->formatter_sanity_check();
 
@@ -766,9 +774,12 @@ sub maybe_generate_dynamic_pod {
         push @{ $self->{'temp_file_list'} }, $buffer;
          # I.e., it MIGHT be deleted at the end.
         
-        print $buffd "=over 8\n\n";
+       my $in_list = $self->opt_f;
+
+        print $buffd "=over 8\n\n" if $in_list;
         print $buffd @dynamic_pod  or die "Can't print $buffer: $!";
-        print $buffd "=back\n";
+        print $buffd "=back\n"     if $in_list;
+
         close $buffd        or die "Can't close $buffer: $!";
         
         @$found_things = $buffer;
@@ -814,11 +825,17 @@ sub search_perlfunc {
 
     DEBUG > 2 and
      print "Going to perlfunc-scan for $search_re in $perlfunc\n";
-    
+
+    my $re = 'Alphabetical Listing of Perl Functions';
+    if ( $self->opt_L ) {
+        my $code = 'POD2::' . uc($self->opt_L);
+        $re =  $code->search_perlfunc_re if $code->can('search_perlfunc_re');
+    }
+
     # Skip introduction
     local $_;
     while (<PFUNC>) {
-        last if /^=head2 Alphabetical Listing of Perl Functions/;
+        last if /^=head2 $re/;
     }
 
     # Look for our function
@@ -1076,7 +1093,7 @@ sub MSWin_perldoc_tempfile {
   my $spec;
   
   do {
-    $spec = sprintf "%s/perldoc_%s_T%x_%x%02x.%s", # used also in MSWin_temp_cleanup
+    $spec = sprintf "%s\\perldoc_%s_T%x_%x%02x.%s", # used also in MSWin_temp_cleanup
       # Yes, we embed the create-time in the filename!
       $tempdir,
       $infix || 'x',
@@ -1229,6 +1246,13 @@ sub pagers_guessing {
         push @pagers, qw( more less pg view cat );
         unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
     }
+
+    if (IS_Cygwin) {
+        if (($pagers[0] eq 'less') || ($pagers[0] eq '/usr/bin/less')) {
+            unshift @pagers, '/usr/bin/less -isrR';
+        }
+    }
+
     unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
     
     return;   
@@ -1310,10 +1334,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) {
@@ -1489,6 +1515,12 @@ sub page {  # apply a pager to the output file
         # extension get the wrong default extension (such as .LIS for TYPE)
 
         $output = VMS::Filespec::rmsexpand($output, '.') if IS_VMS;
+
+        $output =~ s{/}{\\}g if IS_MSWin32 || IS_Dos;
+          # Altho "/" under MSWin is in theory good as a pathsep,
+          #  many many corners of the OS don't like it.  So we
+          #  have to force it to be "\" to make everyone happy.
+
         foreach my $pager (@pagers) {
             $self->aside("About to try calling $pager $output\n");
             if (IS_VMS) {