summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Pod/Simple/Search.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Pod/Simple/Search.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/Search.pm131
1 files changed, 79 insertions, 52 deletions
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/Search.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/Search.pm
index 49df34d3543..d5a4a020811 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/Search.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/Search.pm
@@ -3,7 +3,7 @@ package Pod::Simple::Search;
use strict;
use vars qw($VERSION $MAX_VERSION_WITHIN $SLEEPY);
-$VERSION = '3.29'; ## Current version of this package
+$VERSION = '3.32'; ## Current version of this package
BEGIN { *DEBUG = sub () {0} unless defined &DEBUG; } # set DEBUG level
use Carp ();
@@ -12,12 +12,13 @@ $SLEEPY = 1 if !defined $SLEEPY and $^O =~ /mswin|mac/i;
# flag to occasionally sleep for $SLEEPY - 1 seconds.
$MAX_VERSION_WITHIN ||= 60;
+my $IS_CASE_INSENSITIVE = -e uc __FILE__ && -e lc __FILE__;
#############################################################################
#use diagnostics;
use File::Spec ();
-use File::Basename qw( basename );
+use File::Basename qw( basename dirname );
use Config ();
use Cwd qw( cwd );
@@ -25,6 +26,7 @@ use Cwd qw( cwd );
__PACKAGE__->_accessorize( # Make my dumb accessor methods
'callback', 'progress', 'dir_prefix', 'inc', 'laborious', 'limit_glob',
'limit_re', 'shadows', 'verbose', 'name2path', 'path2name', 'recurse',
+ 'ciseen'
);
#==========================================================================
@@ -51,11 +53,11 @@ sub survey {
$self->_expand_inc( \@search_dirs );
-
$self->{'_scan_count'} = 0;
$self->{'_dirs_visited'} = {};
$self->path2name( {} );
$self->name2path( {} );
+ $self->ciseen( {} );
$self->limit_re( $self->_limit_glob_to_limit_re ) if $self->{'limit_glob'};
my $cwd = cwd();
my $verbose = $self->verbose;
@@ -115,23 +117,33 @@ sub survey {
}
$self->progress and $self->progress->done(
"Noted $$self{'_scan_count'} Pod files total");
+ $self->ciseen( {} );
return unless defined wantarray; # void
return $self->name2path unless wantarray; # scalar
return $self->name2path, $self->path2name; # list
}
-
#==========================================================================
sub _make_search_callback {
my $self = $_[0];
# Put the options in variables, for easy access
my( $laborious, $verbose, $shadows, $limit_re, $callback, $progress,
- $path2name, $name2path, $recurse) =
+ $path2name, $name2path, $recurse, $ciseen) =
map scalar($self->$_()),
qw(laborious verbose shadows limit_re callback progress
- path2name name2path recurse);
+ path2name name2path recurse ciseen);
+ my ($seen, $remember, $files_for);
+ if ($IS_CASE_INSENSITIVE) {
+ $seen = sub { $ciseen->{ lc $_[0] } };
+ $remember = sub { $name2path->{ $_[0] } = $ciseen->{ lc $_[0] } = $_[1]; };
+ $files_for = sub { my $n = lc $_[0]; grep { lc $path2name->{$_} eq $n } %{ $path2name } };
+ } else {
+ $seen = sub { $name2path->{ $_[0] } };
+ $remember = sub { $name2path->{ $_[0] } = $_[1] };
+ $files_for = sub { my $n = $_[0]; grep { $path2name->{$_} eq $n } %{ $path2name } };
+ }
my($file, $shortname, $isdir, $modname_bits);
return sub {
@@ -171,7 +183,6 @@ sub _make_search_callback {
return; # (not pruning);
}
-
# Make sure it's a file even worth even considering
if($laborious) {
unless(
@@ -197,31 +208,26 @@ sub _make_search_callback {
return;
}
- if( !$shadows and $name2path->{$name} ) {
+ if( !$shadows and $seen->($name) ) {
$verbose and print "Not worth considering $file ",
"-- already saw $name as ",
- join(' ', grep($path2name->{$_} eq $name, keys %$path2name)), "\n";
+ join(' ', $files_for->($name)), "\n";
return;
}
-
+
# Put off until as late as possible the expense of
# actually reading the file:
- if( m/\.pod\z/is ) {
- # just assume it has pod, okay?
- } else {
- $progress and $progress->reach($self->{'_scan_count'}, "Scanning $file");
- return unless $self->contains_pod( $file );
- }
+ $progress and $progress->reach($self->{'_scan_count'}, "Scanning $file");
+ return unless $self->contains_pod( $file );
++ $self->{'_scan_count'};
# Or finally take note of it:
- if( $name2path->{$name} ) {
+ if ( my $prev = $seen->($name) ) {
$verbose and print
"Duplicate POD found (shadowing?): $name ($file)\n",
- " Already seen in ",
- join(' ', grep($path2name->{$_} eq $name, keys %$path2name)), "\n";
+ " Already seen in ", join(' ', $files_for->($name)), "\n";
} else {
- $name2path->{$name} = $file; # Noting just the first occurrence
+ $remember->($name, $file); # Noting just the first occurrence
}
$verbose and print " Noting $name = $file\n";
if( $callback ) {
@@ -326,7 +332,14 @@ sub _recurse_dir {
closedir(INDIR);
return
}
- my @items = sort readdir(INDIR);
+
+ # Load all items; put no extension before .pod before .pm before .plx?.
+ my @items = map { $_->[0] }
+ sort { $a->[1] cmp $b->[1] || $b->[2] cmp $a->[2] }
+ map {
+ (my $t = $_) =~ s/[.]p(m|lx?|od)\z//;
+ [$_, $t, lc($1 || 'z') ]
+ } readdir(INDIR);
closedir(INDIR);
push @$modname_bits, $dir_bare unless $dir_bare eq '';
@@ -469,13 +482,15 @@ sub _expand_inc {
my($self, $search_dirs) = @_;
return unless $self->{'inc'};
+ my %seen = map { File::Spec->rel2abs($_) => 1 } @{ $search_dirs };
if ($^O eq 'MacOS') {
push @$search_dirs,
- grep $_ ne File::Spec->curdir, $self->_mac_whammy(@INC);
+ grep { !$seen{ File::Spec->rel2abs($_) }++ } $self->_mac_whammy(@INC);
# Any other OSs need custom handling here?
} else {
- push @$search_dirs, grep $_ ne File::Spec->curdir, @INC;
+ push @$search_dirs,
+ grep { !$seen{ File::Spec->rel2abs($_) }++ } @INC;
}
$self->{'laborious'} = 0; # Since inc said to use INC
@@ -528,6 +543,14 @@ sub _limit_glob_to_limit_re {
# contribution mostly from Tim Jenness <t.jenness@jach.hawaii.edu>
+sub _actual_filenames {
+ my $dir = shift;
+ my $fn = lc shift;
+ opendir my $dh, $dir or return;
+ return map { File::Spec->catdir($dir, $_) }
+ grep { lc $_ eq $fn } readdir $dh;
+}
+
sub find {
my($self, $pod, @search_dirs) = @_;
$self = $self->new unless ref $self; # tolerate being a class method
@@ -544,34 +567,17 @@ sub find {
#@search_dirs = File::Spec->curdir unless @search_dirs;
- if( $self->inc ) {
- if( $^O eq 'MacOS' ) {
- push @search_dirs, $self->_mac_whammy(@INC);
- } else {
- push @search_dirs, @INC;
- }
-
- # Add location of pod documentation for perl man pages (eg perlfunc)
- # This is a pod directory in the private install tree
- #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'},
- # 'pod');
- #push (@search_dirs, $perlpoddir)
- # if -d $perlpoddir;
-
- # Add location of binaries such as pod2text:
- push @search_dirs, $Config::Config{'scriptdir'};
- # and if that's undef or q{} or nonexistent, we just ignore it later
- }
+ $self->_expand_inc(\@search_dirs);
+ # Add location of binaries such as pod2text:
+ push @search_dirs, $Config::Config{'scriptdir'} if $self->inc;
my %seen_dir;
- Dir:
- foreach my $dir ( @search_dirs ) {
+ while (my $dir = shift @search_dirs ) {
next unless defined $dir and length $dir;
next if $seen_dir{$dir};
$seen_dir{$dir} = 1;
unless(-d $dir) {
print "Directory $dir does not exist\n" if $verbose;
- next Dir;
}
print "Looking in directory $dir\n" if $verbose;
@@ -580,16 +586,36 @@ sub find {
foreach my $ext ('', '.pod', '.pm', '.pl') { # possible extensions
my $fullext = $fullname . $ext;
- if( -f $fullext and $self->contains_pod( $fullext ) ){
+ if ( -f $fullext and $self->contains_pod($fullext) ) {
print "FOUND: $fullext\n" if $verbose;
+ if (@parts > 1 && lc $parts[0] eq 'pod' && $IS_CASE_INSENSITIVE && $ext eq '.pod') {
+ # Well, this file could be for a program (perldoc) but we actually
+ # want a module (Pod::Perldoc). So see if there is a .pm with the
+ # proper casing.
+ my $subdir = dirname $fullext;
+ unless (grep { $fullext eq $_ } _actual_filenames $subdir, "$parts[-1].pod") {
+ print "# Looking for alternate spelling in $subdir\n" if $verbose;
+ # Try the .pm file.
+ my $pm = $fullname . '.pm';
+ if ( -f $pm and $self->contains_pod($pm) ) {
+ # Prefer the .pm if its case matches.
+ if (grep { $pm eq $_ } _actual_filenames $subdir, "$parts[-1].pm") {
+ print "FOUND: $fullext\n" if $verbose;
+ return $pm;
+ }
+ }
+ }
+ }
return $fullext;
}
}
- my $subdir = File::Spec->catdir($dir,'pod');
- if(-d $subdir) { # slip in the ./pod dir too
- $verbose and print "Noticing $subdir and stopping there...\n";
- $dir = $subdir;
- redo Dir;
+
+ # Case-insensitively Look for ./pod directories and slip them in.
+ for my $subdir ( _actual_filenames($dir, 'pod') ) {
+ if (-d $subdir) {
+ $verbose and print "Noticing $subdir and looking there...\n";
+ unshift @search_dirs, $subdir;
+ }
}
}
@@ -1005,6 +1031,7 @@ with default attribute values is used.
Returns true if the supplied filename (not POD module) contains some Pod
documentation.
+
=head1 SUPPORT
Questions or discussion about POD and Pod::Simple should be sent to the
@@ -1012,8 +1039,8 @@ pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
-to clone L<git://github.com/theory/pod-simple.git> and send patches!
+L<https://github.com/perl-pod/pod-simple/>. Feel free to fork and contribute, or
+to clone L<git://github.com/perl-pod/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
<bug-pod-simple@rt.cpan.org>.