[perldoc] make -L more forgiving

[email protected] ("Adriano Ferreira")
Newsgroups perl.pod-people
Message-ID <[email protected]>
I waiting for thumbs-up from Pod::Perldoc maintainers about becoming
yet another maintainer for this module as well.

For reference, I released development releases 3.14_01 and 3.14_02 to
CPAN (which were marked UNAUTHORIZED) because I don't have credentials
for official releases yet.

3.14_01 - applies the bleedperl changes that separate the current CPAN
version (3.14) and the code released with 5.9.5 and which is going to
be shipped with 5.10

3.14_02 - makes -L more forgiving (according to the message and patch
below, just sent to perl5-porters)

Any comments will be welcome.

Regards,
Adriano Ferreira

---------- Forwarded message ----------
From: Adriano Ferreira <[email protected]>
Date: Aug 23, 2007 3:37 PM
Subject: [PATCH] lib/Pod/Perldoc.pm - make -L more forgiving
To: [email protected]


The recently introduced switch -L started an effort to support for
reading Perl documentation in other languages but English via the
standard utility "perldoc". The CPAN related projects that are more
advanced are POD2::IT and POD2::FR (respectively, the Italian and the
French translation).

The patch that introduced the switch " -L language_code " took care of
ignoring the option if the corresponding module was not installed.

But (after installed)

$ perldoc -L it perlintro

works because there is a translated perlintro.pod, while

$ perldoc -L it perldoc

does not. I don't think the following message

No documentation found for "POD2::IT::perldoc".

is what users expect. To tell the truth, if they typed that, they
expected the Italian translation of perldoc.pod (which is not ready
yet), but I think falling back to the standard (English) page is more
useful.

The attached patch implements just this.

Regards,
Adriano Ferreira
perldoc.diff (application/txt, 3.3 KB)
--- ../tags/Pod-Perldoc-3.14_01/lib/Pod/Perldoc.pm	Thu Aug 16 13:06:37 2007
+++ lib/Pod/Perldoc.pm	Thu Aug 23 15:01:37 2007
@@ -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 "[@$_]", @{ $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
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.