| Subject: | perldoc -m misidentifies files and displays binaries |
Hello,
perldoc does not find modules reliably if -m is passed, and may display
binary executables. To reproduce:
perldoc -m File::Spec::Unix
displays /usr/bin/file .
This demonstrates two bugs. The first is caused by minus_f_nocase(),
which does not check that a readable file it finds corresponds to all
the searched-for path rather than a directory component. So
/usr/bin/file is considered a candidate for File/Spec/Unix. My patch
adds a comparison of the full path.
The second issue is that binary files are not guarded against. I have
written a function isprintable() which corresponds to containspod() and
looks at the first kilobyte of the file. Like containspod(), it only
checks files that do not have a file name extension that indicates
eligible files.
Best regards,
Volker
| Subject: | Perldoc.pm.diff |
*** Perldoc.pm.3.15 Sat Nov 1 14:45:35 2008
--- Perldoc.pm Sat Sep 18 20:04:33 2010
***************
*** 1328,1338 ****
$self->aside( "Found as $tmp_path but directory\n" );
}
}
! elsif (-f _ && -r _) {
return $try;
}
elsif (-f _) {
! warn "Ignored $try: unreadable\n";
}
elsif (-d catdir(@p)) { # at least we see the containing directory!
my $found = 0;
--- 1328,1338 ----
$self->aside( "Found as $tmp_path but directory\n" );
}
}
! elsif (-f _ && -r _ && lc($try) eq lc($path)) {
return $try;
}
elsif (-f _) {
! warn "Ignored $try: unreadable or file/dir mismatch\n";
}
elsif (-d catdir(@p)) { # at least we see the containing directory!
my $found = 0;
***************
*** 1485,1501 ****
return "";
}
! if ($self->opt_m) {
! return $self->minus_f_nocase($dir,$file);
! }
!
! else {
! my $path = $self->minus_f_nocase($dir,$file);
! if( length $path and $self->containspod($path) ) {
! DEBUG > 3 and print
! " The file $path indeed looks promising!\n";
! return $path;
! }
}
DEBUG > 3 and print " No good: $file in $dir\n";
--- 1485,1496 ----
return "";
}
! my $path = $self->minus_f_nocase($dir,$file);
! if( length $path and ($self->opt_m ? $self->isprintable($path)
! : $self->containspod($path)) ) {
! DEBUG > 3 and print
! " The file $path indeed looks promising!\n";
! return $path;
}
DEBUG > 3 and print " No good: $file in $dir\n";
***************
*** 1542,1547 ****
--- 1537,1561 ----
#..........................................................................
+ sub isprintable {
+ my($self, $file, $readit) = @_;
+ my $size= 1024;
+ my $maxunprintfrac= 0.2; # tolerate some unprintables for UTF8 comments etc.
+
+ return 1 if !$readit && $file =~ /\.(?:pl|pm|pod|cmd|com|bat)\z/i;
+
+ my $data;
+ local($_);
+ open(TEST,"<", $file) or die "Can't open $file: $!"; # XXX 5.6ism
+ read TEST, $data, $size;
+ close TEST;
+ $size= length($data);
+ $data =~ tr/\x09-\x0D\x20-\x7E//d;
+ return length($data) <= $size*$maxunprintfrac;
+ }
+
+ #..........................................................................
+
sub maybe_diddle_INC {
my $self = shift;