X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FPod%2FPerldoc.pm;h=9ed66e809173a4f164a017619a527c2308b0d84f;hb=5f31e3ad80d9344ef722fe0a658ceb2dc559ea8c;hp=1701a3a272f12433f4efd81688cb9a7115f4c67b;hpb=574d6bae531be70647aa0566b2395a2cd137f71f;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Pod/Perldoc.pm b/lib/Pod/Perldoc.pm index 1701a3a..9ed66e8 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.10'; +$VERSION = '3.14_04'; #.......................................................................... BEGIN { # Make a DEBUG constant very first thing... @@ -39,6 +39,8 @@ BEGIN { *IS_Dos = $^O eq 'dos' ? \&TRUE : \&FALSE unless defined &IS_Dos; *IS_OS2 = $^O eq 'os2' ? \&TRUE : \&FALSE unless defined &IS_OS2; *IS_Cygwin = $^O eq 'cygwin' ? \&TRUE : \&FALSE unless defined &IS_Cygwin; + *IS_Linux = $^O eq 'linux' ? \&TRUE : \&FALSE unless defined &IS_Linux; + *IS_HPUX = $^O =~ m/hpux/ ? \&TRUE : \&FALSE unless defined &IS_HPUX; } $Temp_File_Lifetime ||= 60 * 60 * 24 * 5; @@ -60,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, @_) } }; } @@ -69,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) = @_; @@ -245,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... @@ -289,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 @@ -346,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; } @@ -644,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; } @@ -666,6 +676,16 @@ sub options_sanity { # Any sanity-checking need doing here? + # But does not make sense to set either -f or -q in $ENV{"PERLDOC"} + if( $self->opt_f or $self->opt_q ) { + $self->usage("Only one of -f -or -q") if $self->opt_f and $self->opt_q; + warn + "Perldoc is only really meant for reading one word at a time.\n", + "So these parameters are being ignored: ", + join(' ', @{$self->{'args'}}), + "\n" + if @{$self->{'args'}} + } return; } @@ -695,10 +715,14 @@ sub grand_search_init { next; } + my @searchdirs; + + # prepend extra search directories (including language specific) + push @searchdirs, @{ $self->{'extra_search_dirs'} }; + # We must look both in @INC for library modules and in $bindir # for executables, like h2xs or perldoc itself. - - my @searchdirs = ($self->{'bindir'}, @INC); + push @searchdirs, ($self->{'bindir'}, @INC); unless ($self->opt_m) { if (IS_VMS) { my($i,$trn); @@ -764,9 +788,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; @@ -795,6 +822,44 @@ sub add_formatter_option { # $self->add_formatter_option('key' => 'value'); return; } +#......................................................................... + +sub new_translator { # $tr = $self->new_translator($lang); + my $self = shift; + my $lang = shift; + + my $pack = 'POD2::' . uc($lang); + eval "require $pack"; + if ( !$@ && $pack->can('new') ) { + return $pack->new(); + } + + eval { require POD2::Base }; + return if $@; + + return POD2::Base->new({ lang => $lang }); +} + +#......................................................................... + +sub add_translator { # $self->add_translator($lang); + my $self = shift; + for my $lang (@_) { + my $tr = $self->new_translator($lang); + if ( defined $tr ) { + push @{ $self->{'translators'} }, $tr; + push @{ $self->{'extra_search_dirs'} }, $tr->pod_dirs; + + $self->aside( "translator for '$lang' loaded\n" ); + } else { + # non-installed or bad translator package + warn "Perldoc cannot load translator package for '$lang': ignored\n"; + } + + } + return; +} + #.......................................................................... sub search_perlfunc { @@ -812,11 +877,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 $tr = $self->{'translators'}->[0]; + $re = $tr->search_perlfunc_re if $tr->can('search_perlfunc_re'); + } + # Skip introduction local $_; while () { - last if /^=head2 Alphabetical Listing of Perl Functions/; + last if /^=head2 $re/; } # Look for our function @@ -910,7 +981,7 @@ sub render_findings { die "Nothing found?!"; # should have been caught before here } elsif(@$found_things > 1) { - warn join '', + warn "Perldoc is only really meant for reading one document at a time.\n", "So these parameters are being ignored: ", join(' ', @$found_things[1 .. $#$found_things] ), @@ -1074,7 +1145,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', @@ -1227,6 +1298,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; @@ -1308,10 +1386,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) { @@ -1381,13 +1461,13 @@ sub maybe_diddle_INC { # Does this look like a module or extension directory? - if (-f "Makefile.PL") { + if (-f "Makefile.PL" || -f "Build.PL") { # Add "." and "lib" to @INC (if they exist) eval q{ use lib qw(. lib); 1; } or die; # don't add if superuser - if ($< && $> && -f "blib") { # don't be looking too hard now! + if ($< && $> && -d "blib") { # don't be looking too hard now! eval q{ use blib; 1 }; warn $@ if $@ && $self->opt_v; } @@ -1487,6 +1567,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) { @@ -1513,6 +1599,7 @@ sub searchfor { $self->{'target'} = (splitdir $s)[-1]; # XXX: why not use File::Basename? for ($i=0; $i<@dirs; $i++) { $dir = $dirs[$i]; + next unless -d $dir; ($dir = VMS::Filespec::unixpath($dir)) =~ s!/\z!! if IS_VMS; if ( (! $self->opt_m && ( $ret = $self->check_file($dir,"$s.pod"))) or ( $ret = $self->check_file($dir,"$s.pm"))