lib/Pod/Perldoc.pm - make -L more forgiving

From: "Adriano Ferreira" <a.r.ferreira@gmail.com>
Message-ID: <73ddeb6c0708231137w2d436cfbo7409345c37280560@mail.gmail.com>

p4raw-id: //depot/perl@31762

diff --git a/lib/Pod/Perldoc.pm b/lib/Pod/Perldoc.pm
index 8bc0a6d..d2affbb 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.14_01';
+$VERSION = '3.14_02';
 #..........................................................................
 
 BEGIN {  # Make a DEBUG constant very first thing...
@@ -350,6 +350,9 @@ sub init {
   DEBUG > 3 and printf "Formatter switches now: [%s]\n",
    join ' ', map "[@$_]", @{ $self->{'formatter_switches'} };
 
+  $self->{'translators'} = [];
+  $self->{'extra_search_dirs'} = [];
+
   return;
 }
 
@@ -419,12 +422,6 @@ 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();
 
@@ -654,6 +651,9 @@ sub options_processing {
     $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 @@ sub grand_search_init {
             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 @@ sub add_formatter_option { # $self->add_formatter_option('key' => 'value');
   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 @@ sub search_perlfunc {
 
     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