From: Adriano Ferreira Date: Thu, 23 Aug 2007 15:37:13 +0000 (-0300) Subject: lib/Pod/Perldoc.pm - make -L more forgiving X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1cba5c45757cdbc76b1124e90b7e13b6d78304c1;p=p5sagit%2Fp5-mst-13.2.git lib/Pod/Perldoc.pm - make -L more forgiving From: "Adriano Ferreira" 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 --- 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