From: Jarkko Hietaniemi Date: Sun, 27 Jul 2003 17:51:01 +0000 (+0000) Subject: Upgrade to Pod::Perldoc 3.09. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a60a0c7496116922c40e1fceebde1c1462633587;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Pod::Perldoc 3.09. p4raw-id: //depot/perl@20233 --- diff --git a/lib/Pod/Perldoc.pm b/lib/Pod/Perldoc.pm index 2a5b149..55976b6 100644 --- a/lib/Pod/Perldoc.pm +++ b/lib/Pod/Perldoc.pm @@ -1,5 +1,6 @@ require 5; +use 5.006; # we use some open(X, "<", $y) syntax package Pod::Perldoc; use strict; use warnings; @@ -11,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.08'; +$VERSION = '3.09'; #.......................................................................... BEGIN { # Make a DEBUG constant very first thing... @@ -28,13 +29,6 @@ BEGIN { # Make a DEBUG constant very first thing... use Pod::Perldoc::GetOptsOO; # uses the DEBUG. #.......................................................................... -{ my $pager = $Config{'pager'}; - push @Pagers, $pager if ((-x (split /\s+/, $pager)[0]) || $^O eq 'VMS'); -} -$Bindir = $Config{'scriptdirexp'}; -$Pod2man = "pod2man" . ( $Config{'versiononly'} ? $Config{'version'} : '' ); - -#.......................................................................... sub TRUE () {1} sub FALSE () {return} @@ -52,13 +46,21 @@ $Temp_File_Lifetime ||= 60 * 60 * 24 * 5; # that anyone's still looking at it!! # (Currently used only by the MSWin cleanup routine) + +#.......................................................................... +{ my $pager = $Config{'pager'}; + push @Pagers, $pager if -x (split /\s+/, $pager)[0] or IS_VMS; +} +$Bindir = $Config{'scriptdirexp'}; +$Pod2man = "pod2man" . ( $Config{'versiononly'} ? $Config{'version'} : '' ); + # End of class-init stuff # ########################################################################### # # Option accessors... -foreach my $subname (map "opt_$_", split '', q{mhlvriFfXqnTd}) { +foreach my $subname (map "opt_$_", split '', q{mhlvriFfXqnTdU}) { no strict 'refs'; *$subname = do{ use strict 'refs'; sub () { shift->_elem($subname, @_) } }; } @@ -120,8 +122,6 @@ sub opt_V { # report version and exit exit; } -sub opt_U {} # legacy no-op - sub opt_t { # choose plaintext as output format my $self = shift; $self->opt_o_with('text') if @_ and $_[0]; @@ -214,6 +214,7 @@ sub aside { # If we're in -v or DEBUG mode, say this. my $callsub = (caller(1))[3]; my $package = quotemeta(__PACKAGE__ . '::'); $callsub =~ s/^$package/'/os; + # the o is justified, as $package really won't change. $callsub . ": "; } : '', @_, @@ -359,8 +360,10 @@ sub init_formatter_class_list { $self->opt_M_with('Pod::Perldoc::ToPod'); # the always-there fallthru $self->opt_o_with('text'); - $self->opt_o_with('man') unless IS_MSWin32 || IS_Dos || IS_Cygwin - || !($ENV{TERM} && $ENV{TERM} !~ /dumb|emacs|none|unknown/i); + $self->opt_o_with('man') unless IS_MSWin32 || IS_Dos + || !($ENV{TERM} && ( + ($ENV{TERM} || '') !~ /dumb|emacs|none|unknown/i + )); return; } @@ -482,7 +485,7 @@ sub find_good_formatter_class { } else { $^W = 0; # The average user just has no reason to be seeing - # $^W-suppressable warnings from the require! + # $^W-suppressable warnings from the the require! } eval "require $c"; @@ -732,7 +735,7 @@ sub grand_search_init { $file =~ s/\.(pm|pod)\z//; # XXX: badfs print STDERR "\tperldoc $_\::$file\n"; } - closedir DIR or die "closedir $dir: $!"; + closedir(DIR) or die "closedir $dir: $!"; } } } @@ -804,12 +807,11 @@ sub search_perlfunc { or die("Can't open $perlfunc: $!"); # Functions like -r, -e, etc. are listed under `-X'. - my $search_string = ($self->opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/) - ? 'I<-X' : $self->opt_f ; - + my $search_re = ($self->opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/) + ? '(?:I<)?-X' : quotemeta($self->opt_f) ; + DEBUG > 2 and - print "Going to perlfunc-scan for $search_string in $perlfunc\n"; - + print "Going to perlfunc-scan for $search_re in $perlfunc\n"; # Skip introduction local $_; @@ -821,7 +823,7 @@ sub search_perlfunc { my $found = 0; my $inlist = 0; while () { # "The Mothership Connection is here!" - if (/^=item\s+\Q$search_string\E\b/o) { + if ( m/^=item\s+$search_re\b/ ) { $found = 1; } elsif (/^=item/) { @@ -856,7 +858,9 @@ sub search_perlfaqs { my $found = 0; my %found_in; my $search_key = $self->opt_q; - my $rx = eval { qr/$search_key/ } or die <|]/; - open(INFAQ, "<", $file) or die "Can't read-open $file: $!\nAborting"; + open(INFAQ, "<", $file) # XXX 5.6ism + or die "Can't read-open $file: $!\nAborting"; while () { - if (/^=head2\s+.*(?:$search_key)/oi) { # it's good for only one key + if ( m/^=head2\s+.*(?:$search_key)/i ) { $found = 1; push @$pod, "=head1 Found in $file\n\n" unless $found_in{$file}++; } @@ -1098,7 +1103,7 @@ sub MSWin_perldoc_tempfile { $fh = Symbol::gensym(); } DEBUG > 3 and print "About to try making temp file $spec\n"; - return($fh, $spec) if open($fh, ">", $spec); + return($fh, $spec) if open($fh, ">", $spec); # XXX 5.6ism $self->aside("Can't create temp file $spec: $!\n"); } @@ -1249,7 +1254,7 @@ sub page_module_file { local $_; my $any_error = 0; foreach my $output (@found) { - unless( open(TMP, "<", $output) ) { + unless( open(TMP, "<", $output) ) { # XXX 5.6ism warn("Can't open $output: $!"); $any_error = 1; next; @@ -1337,7 +1342,7 @@ sub containspod { my($self, $file, $readit) = @_; return 1 if !$readit && $file =~ /\.pod\z/i; local($_); - open(TEST,"<", $file) or die "Can't open $file: $!"; + open(TEST,"<", $file) or die "Can't open $file: $!"; # XXX 5.6ism while () { if (/^=head/) { close(TEST) or die "Can't close $file: $!"; @@ -1388,7 +1393,9 @@ sub new_output_file { $fh = Symbol::gensym(); } DEBUG > 3 and print "About to try writing to specified output file $outspec\n"; - die "Can't write-open $outspec: $!" unless open($fh, ">", $outspec); + die "Can't write-open $outspec: $!" + unless open($fh, ">", $outspec); # XXX 5.6ism + DEBUG > 3 and print "Successfully opened $outspec\n"; binmode($fh) if $self->{'output_is_binary'}; return($fh, $outspec); @@ -1447,7 +1454,7 @@ sub page { # apply a pager to the output file my ($self, $output, $output_to_stdout, @pagers) = @_; if ($output_to_stdout) { $self->aside("Sending unpaged output to STDOUT.\n"); - open(TMP, "<", $output) or die "Can't open $output: $!"; + open(TMP, "<", $output) or die "Can't open $output: $!"; # XXX 5.6ism local $_; while () { print or die "Can't print to stdout: $!"; @@ -1609,8 +1616,14 @@ sub drop_privs_maybe { $< = $id; # real uid $> = $id; # effective uid }; - die "Superuser must not run $0 without security audit and taint checks.\n" - unless !$@ && $< && $>; + if( !$@ && $< && $> ) { + DEBUG and print "OK, I dropped privileges.\n"; + } elsif( $self->opt_U ) { + DEBUG and print "Couldn't drop privileges, but in -U mode, so feh." + } else { + DEBUG and print "Hm, couldn't drop privileges. Ah well.\n"; + # We used to die here; but that seemed pointless. + } } return; } @@ -1688,7 +1701,7 @@ __END__ # it'll run faster. # # Version 1.01: Tue May 30 14:47:34 EDT 1995 -# Andy Dougherty +# Andy Dougherty # -added pod documentation. # -added PATH searching. # -added searching pod/ subdirectory (mainly to pick up perlfunc.pod diff --git a/lib/Pod/Perldoc/ToMan.pm b/lib/Pod/Perldoc/ToMan.pm index 371a3be..f9061b8 100644 --- a/lib/Pod/Perldoc/ToMan.pm +++ b/lib/Pod/Perldoc/ToMan.pm @@ -5,7 +5,7 @@ use strict; use warnings; # This class is unlike ToText.pm et al, because we're NOT paging thru -# the output in that our particular format -- we make the output and +# the output in our particular format -- we make the output and # then we run nroff (or whatever) on it, and then page thru the # (plaintext) output of THAT! @@ -54,7 +54,12 @@ sub parse_from_file { ) . " $switches --lax $file | $render -man" ; # no temp file, just a pipe! - + + # I hear persistent reports that adding a -c switch to $render + # solves many people's problems. But I also hear that some mans + # don't have a -c switch, so that adding it here would presumably + # be a Bad Thing -- sburke@cpan.org + $command .= " | col -x" if $^O =~ /hpux/; defined(&Pod::Perldoc::DEBUG)