From: Gurusamy Sarathy Date: Fri, 17 Mar 2000 16:24:28 +0000 (+0000) Subject: missing file in change#5781 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2773b0134e92133071e6a6e343073023a65dd4d0;p=p5sagit%2Fp5-mst-13.2.git missing file in change#5781 p4raw-link: @5781 on //depot/perl: 564d657a74dccde9ba1d290e8c73ec113622ee81 p4raw-id: //depot/perl@5784 --- diff --git a/lib/Pod/Find.pm b/lib/Pod/Find.pm index 10da904..8de197b 100644 --- a/lib/Pod/Find.pm +++ b/lib/Pod/Find.pm @@ -13,7 +13,7 @@ package Pod::Find; use vars qw($VERSION); -$VERSION = 0.11; ## Current version of this package +$VERSION = 0.12; ## Current version of this package require 5.005; ## requires this Perl version or later ############################################################################# @@ -49,13 +49,15 @@ Only text files containing at least one valid POD command are found. A warning is printed if more than one POD file with the same POD name is found, e.g. F in different directories. This usually -indicates duplicate occurences of modules in the I<@INC> search path. +indicates duplicate occurrences of modules in the I<@INC> search path. The function B is equivalent to B, but also -strips Perl-like extensions (.pm, .pl, .pod). +strips Perl-like extensions (.pm, .pl, .pod) and extensions like +F<.bat>, F<.cmd> on Win32 and OS/2, respectively. Note that neither B nor B are exported by -default so be sure to specify them in the B statement if you need them: +default so be sure to specify them in the B statement if you need +them: use Pod::Find qw(pod_find simplify_name); @@ -86,7 +88,8 @@ B. This is taken from the local L module. =item B<-inc> -Search for PODs in the current Perl interpreter's I<@INC> paths. +Search for PODs in the current Perl interpreter's I<@INC> paths. This +automatically considers paths specified in the C environment. =back @@ -104,6 +107,7 @@ L, L use strict; #use diagnostics; use Exporter; +use File::Spec; use File::Find; use Cwd; @@ -144,7 +148,7 @@ sub pod_find require Config; # this code simplifies the POD name for Perl modules: # * remove "site_perl" - # * remove e.g. "i586-linux" + # * remove e.g. "i586-linux" (from 'archname') # * remove e.g. 5.00503 # * remove pod/ if followed by *.pod (e.g. in pod/perlfunc.pod) $SIMPLIFY_RX = @@ -158,11 +162,12 @@ sub pod_find my $pwd = cwd(); foreach my $try (@search) { - unless($try =~ m:^/:s) { - # make path absolute - $try = join('/',$pwd,$try); - } - $try =~ s:/\.?(?=/|\z)::; # simplify path + unless(File::Spec->file_name_is_absolute($try)) { + # make path absolute + $try = File::Spec->catfile($pwd,$try); + } + # simplify path + $try = File::Spec->canonpath($try); my $name; if(-f $try) { if($name = _check_and_extract_name($try, $opts{-verbose})) { @@ -170,30 +175,30 @@ sub pod_find } next; } - my $root_rx = qq!^\Q$try\E/!; + my $root_rx = qq!^\Q$try\E/!; File::Find::find( sub { - my $item = $File::Find::name; - if(-d) { - if($dirs_visited{$item}) { - warn "Directory '$item' already seen, skipping.\n" - if($opts{-verbose}); - $File::Find::prune = 1; - return; - } - else { - $dirs_visited{$item} = 1; - } - if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) { + my $item = $File::Find::name; + if(-d) { + if($dirs_visited{$item}) { + warn "Directory '$item' already seen, skipping.\n" + if($opts{-verbose}); + $File::Find::prune = 1; + return; + } + else { + $dirs_visited{$item} = 1; + } + if($opts{-perl} && /^(\d+\.[\d_]+)\z/s && eval "$1" != $]) { $File::Find::prune = 1; warn "Perl $] version mismatch on $_, skipping.\n" - if($opts{-verbose}); - } - return; - } + if($opts{-verbose}); + } + return; + } if($name = _check_and_extract_name($item, $opts{-verbose}, $root_rx)) { _check_for_duplicates($item, $name, \%names, \%pods); } - }, $try); # end of File::Find::find + }, $try); # end of File::Find::find } chdir $pwd; %pods; @@ -203,8 +208,8 @@ sub _check_for_duplicates { my ($file, $name, $names_ref, $pods_ref) = @_; if($$names_ref{$name}) { warn "Duplicate POD found (shadowing?): $name ($file)\n"; - warn " Already seen in ", - join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n"; + warn " Already seen in ", + join(' ', grep($$pods_ref{$_} eq $name, keys %$pods_ref)),"\n"; } else { $$names_ref{$name} = 1; @@ -215,15 +220,16 @@ sub _check_for_duplicates { sub _check_and_extract_name { my ($file, $verbose, $root_rx) = @_; - # check extension or executable - unless($file =~ /\.(pod|pm|pl)\z/i || (-f $file && -x _ && -T _)) { + # check extension or executable flag + # this involves testing the .bat extension on Win32! + unless($file =~ /\.(pod|pm|plx?)\z/i || (-f $file && -x _ && -T _)) { return undef; } # check for one line of POD unless(open(POD,"<$file")) { warn "Error: $file is unreadable: $!\n"; - return undef; + return undef; } local $/ = undef; my $pod = ; @@ -245,8 +251,8 @@ sub _check_and_extract_name { else { $name =~ s:^.*/::s; } - $name =~ s/\.(pod|pm|pl)\z//i; - $name =~ s!/+!::!g; + _simplify($name); + $name =~ s!/+!::!g; #/ $name; } @@ -254,10 +260,19 @@ sub _check_and_extract_name { # basename & strip extension sub simplify_name { my ($str) = @_; + # remove all path components $str =~ s:^.*/::s; - $str =~ s:\.p([lm]|od)\z::i; + _simplify($str); $str; } +# internal sub only +sub _simplify { + # strip Perl's own extensions + $_[0] =~ s/\.(pod|pm|plx?)\z//i; + # strip meaningless extensions on Win32 and OS/2 + $_[0] =~ s/\.(bat|exe|cmd)\z//i if($^O =~ /win|os2/i); +} + 1;