Change 31762: [PATCH] lib/Pod/Perldoc.pm - make -L more forgiving

[Rafael Garcia-Suarez]

Change 31762 by [EMAIL PROTECTED] on 2007/08/30 08:50:11

        Subject: [PATCH] lib/Pod/Perldoc.pm - make -L more forgiving
        From: "Adriano Ferreira" <[EMAIL PROTECTED]>
        Date: Thu, 23 Aug 2007 15:37:13 -0300
        Message-ID: <[EMAIL PROTECTED]>

Affected files ...

... //depot/perl/lib/Pod/Perldoc.pm#17 edit

Differences ...

==== //depot/perl/lib/Pod/Perldoc.pm#17 (text) ====
Index: perl/lib/Pod/Perldoc.pm
--- perl/lib/Pod/Perldoc.pm#16~31628~   2007-07-18 10:37:53.000000000 -0700
+++ perl/lib/Pod/Perldoc.pm     2007-08-30 01:50:11.000000000 -0700
@@ -12,7 +12,7 @@
 use vars qw($VERSION @Pagers $Bindir $Pod2man
   $Temp_Files_Created $Temp_File_Lifetime
 );
-$VERSION = '3.14_01';
+$VERSION = '3.14_02';
 #..........................................................................
 
 BEGIN {  # Make a DEBUG constant very first thing...
@@ -350,6 +350,9 @@
   DEBUG > 3 and printf "Formatter switches now: [%s]\n",
    join ' ', map "[EMAIL PROTECTED]", @{ $self->{'formatter_switches'} };
 
+  $self->{'translators'} = [];
+  $self->{'extra_search_dirs'} = [];
+
   return;
 }
 
@@ -419,12 +422,6 @@
 
     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();
 
@@ -654,6 +651,9 @@
     $self->opt_n("nroff") unless $self->opt_n;
     $self->add_formatter_option( '__nroffer' => $self->opt_n );
 
+    # Adjust for using translation packages
+    $self->add_translator($self->opt_L) if $self->opt_L;
+
     return;
 }
 
@@ -715,10 +715,14 @@
             next;
         }
 
-        # We must look both in @INC for library modules and in $bindir
-        # for executables, like h2xs or perldoc itself.
+        my @searchdirs;
 
-        my @searchdirs = ($self->{'bindir'}, @INC);
+        # prepend extra search directories (including language specific)
+        push @searchdirs, @{ $self->{'extra_search_dirs'} };
+
+        # We mush look both in @INC for library modules and in $bindir
+        # for executables, like h2xs or perldoc itself.        
+        push @searchdirs, ($self->{'bindir'}, @INC);
         unless ($self->opt_m) {
             if (IS_VMS) {
                 my($i,$trn);
@@ -818,6 +822,39 @@
   return;
 }
 
+#.........................................................................
+
+sub pod_dirs { # @dirs = pod_dirs($translator);
+    my $tr = shift;
+    return $tr->pod_dirs if $tr->can('pod_dirs');
+    
+    my $mod = ref $tr || $tr;
+    $mod =~ s|::|/|g;
+    $mod .= '.pm';
+
+    my $dir = $INC{$mod};
+    $dir =~ s/\.pm\z//;
+    return $dir;
+}
+
+#.........................................................................
+
+sub add_translator { # $self->add_translator($lang);
+    my $self = shift;
+    for my $lang (@_) {
+        my $pack = 'POD2::' . uc($lang);
+        eval "require $pack";
+        if ( $@ ) {
+            # XXX warn: non-installed translator package
+        } else {
+            push @{ $self->{'translators'} }, $pack;
+            push @{ $self->{'extra_search_dirs'} }, pod_dirs($pack);
+            # XXX DEBUG
+        }
+    }
+    return;
+}
+
 #..........................................................................
 
 sub search_perlfunc {
@@ -838,8 +875,8 @@
 
     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');
+        my $tr = $self->{'translators'}->[0];
+        $re =  $tr->search_perlfunc_re if $tr->can('search_perlfunc_re');
     }
 
     # Skip introduction
End of Patch.