I've just uploaded a new Pod::Perldoc to CPAN. Here's the new
changelog entry, and attached is the diff to Pod/Perldoc.pm,
if anyone's interested.
Revision history for Perl module group Pod::Perldoc
Time-stamp: "2003-07-24 06:33:17 ADT"
2003-07-24 Sean M. Burke [EMAIL PROTECTED]
* Release 3.09.
Notable changes:
* perldoc when run as root no longer dies when it can't manage to
drop privileges. This is by popular demand.
* perldoc -f -X now properly sees an -X entry regardless of
whether it's coded as =item -X or =item I<-X>.
* In README, changed "This is an experimental distribution of
Perldoc," to "This is the distribution of Perldoc,"
Wee little things:
* Added a "use 5.006;" to the start of Perldoc.pm and the
Makefile.PL, since we do actually need that version of perl
for the module to even compile right. (Altho backporting is an
option later, if we remove the 5.6-isms.)
* Perldoc.pm has a new constant IS_Cygwin if we ever need it.
* Added a bit of IS_VMS logic.
* Minor cosmetic changes to handling of -U.
* Added a few comments here and there.
diff Perldoc~308.pm Perldoc.pm
--- Perldoc~308.pm Sat Jan 18 18:40:40 2003
+++ Perldoc.pm Thu Jul 24 06:06:48 2003
@@ -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 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,14 +29,7 @@
use Pod::Perldoc::GetOptsOO; # uses the DEBUG.
#..........................................................................
-{ my $pager = $Config{'pager'};
- push @Pagers, $pager if -x (split /\s+/, $pager)[0];
-}
-$Bindir = $Config{'scriptdirexp'};
-$Pod2man = "pod2man" . ( $Config{'versiononly'} ? $Config{'version'} : '' );
-#..........................................................................
-
sub TRUE () {1}
sub FALSE () {return}
@@ -44,6 +38,7 @@
*IS_MSWin32 = $^O eq 'MSWin32' ? \&TRUE : \&FALSE unless defined &IS_MSWin32;
*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;
}
$Temp_File_Lifetime ||= 60 * 60 * 24 * 5;
@@ -51,13 +46,21 @@
# 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, @_) } };
}
@@ -119,8 +122,6 @@
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];
@@ -213,6 +214,7 @@
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,7 +361,9 @@
$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
- || !($ENV{TERM} && $ENV{TERM} !~ /dumb|emacs|none|unknown/i);
+ || !($ENV{TERM} && (
+ ($ENV{TERM} || '') !~ /dumb|emacs|none|unknown/i
+ ));
return;
}
@@ -731,7 +735,7 @@
$file =~ s/\.(pm|pod)\z//; # XXX: badfs
print STDERR "\tperldoc $_\::$file\n";
}
- closedir DIR or die "closedir $dir: $!";
+ closedir(DIR) or die "closedir $dir: $!";
}
}
}
@@ -803,13 +807,12 @@
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 $_;
while (<PFUNC>) {
@@ -820,7 +823,7 @@
my $found = 0;
my $inlist = 0;
while (<PFUNC>) { # "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/) {
@@ -855,7 +858,9 @@
my $found = 0;
my %found_in;
my $search_key = $self->opt_q;
- my $rx = eval { qr/$search_key/ } or die <<EOD;
+
+ my $rx = eval { qr/$search_key/ }
+ or die <<EOD;
Invalid regular expression '$search_key' given as -q pattern:
$@
Did you mean \\Q$search_key ?
@@ -865,9 +870,10 @@
local $_;
foreach my $file (@$found_things) {
die "invalid file spec: $!" if $file =~ /[<>|]/;
- 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 (<INFAQ>) {
- 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}++;
}
@@ -1097,7 +1103,7 @@
$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");
}
@@ -1248,7 +1254,7 @@
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;
@@ -1336,7 +1342,7 @@
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 (<TEST>) {
if (/^=head/) {
close(TEST) or die "Can't close $file: $!";
@@ -1387,7 +1393,9 @@
$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);
@@ -1446,7 +1454,7 @@
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 (<TMP>) {
print or die "Can't print to stdout: $!";
@@ -1608,8 +1616,14 @@
$< = $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;
}
--
Sean M. Burke http://search.cpan.org/~sburke/
