whoami7 - Manager
:
/
proc
/
self
/
root
/
usr
/
share
/
perl5
/
vendor_perl
/
Pod
/
Simple
/
Upload File:
files >> //proc/self/root/usr/share/perl5/vendor_perl/Pod/Simple/Search.pm
require 5.005; package Pod::Simple::Search; use strict; use vars qw($VERSION $MAX_VERSION_WITHIN $SLEEPY); $VERSION = '3.35'; ## Current version of this package BEGIN { *DEBUG = sub () {0} unless defined &DEBUG; } # set DEBUG level use Carp (); $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 dirname ); use Config (); 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' ); #========================================================================== sub new { my $class = shift; my $self = bless {}, ref($class) || $class; $self->init; return $self; } sub init { my $self = shift; $self->inc(1); $self->recurse(1); $self->verbose(DEBUG); return $self; } #-------------------------------------------------------------------------- sub survey { my($self, @search_dirs) = @_; $self = $self->new unless ref $self; # tolerate being a class method $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; local $_; # don't clobber the caller's $_ ! foreach my $try (@search_dirs) { unless( File::Spec->file_name_is_absolute($try) ) { # make path absolute $try = File::Spec->catfile( $cwd ,$try); } # simplify path $try = File::Spec->canonpath($try); my $start_in; my $modname_prefix; if($self->{'dir_prefix'}) { $start_in = File::Spec->catdir( $try, grep length($_), split '[\\/:]+', $self->{'dir_prefix'} ); $modname_prefix = [grep length($_), split m{[:/\\]}, $self->{'dir_prefix'}]; $verbose and print "Appending \"$self->{'dir_prefix'}\" to $try, ", "giving $start_in (= @$modname_prefix)\n"; } else { $start_in = $try; } if( $self->{'_dirs_visited'}{$start_in} ) { $verbose and print "Directory '$start_in' already seen, skipping.\n"; next; } else { $self->{'_dirs_visited'}{$start_in} = 1; } unless(-e $start_in) { $verbose and print "Skipping non-existent $start_in\n"; next; } my $closure = $self->_make_search_callback; if(-d $start_in) { # Normal case: $verbose and print "Beginning excursion under $start_in\n"; $self->_recurse_dir( $start_in, $closure, $modname_prefix ); $verbose and print "Back from excursion under $start_in\n\n"; } elsif(-f _) { # A excursion consisting of just one file! $_ = basename($start_in); $verbose and print "Pondering $start_in ($_)\n"; $closure->($start_in, $_, 0, []); } else { $verbose and print "Skipping mysterious $start_in\n"; } } $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, $ciseen) = map scalar($self->$_()), qw(laborious verbose shadows limit_re callback progress 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 { ($file, $shortname, $isdir, $modname_bits) = @_; if($isdir) { # this never gets called on the startdir itself, just subdirs unless( $recurse ) { $verbose and print "Not recursing into '$file' as per requested.\n"; return 'PRUNE'; } if( $self->{'_dirs_visited'}{$file} ) { $verbose and print "Directory '$file' already seen, skipping.\n"; return 'PRUNE'; } print "Looking in dir $file\n" if $verbose; unless ($laborious) { # $laborious overrides pruning if( m/^(\d+\.[\d_]{3,})\z/s and do { my $x = $1; $x =~ tr/_//d; $x != $] } ) { $verbose and print "Perl $] version mismatch on $_, skipping.\n"; return 'PRUNE'; } if( m/^([A-Za-z][a-zA-Z0-9_]*)\z/s ) { $verbose and print "$_ is a well-named module subdir. Looking....\n"; } else { $verbose and print "$_ is a fishy directory name. Skipping.\n"; return 'PRUNE'; } } # end unless $laborious $self->{'_dirs_visited'}{$file} = 1; return; # (not pruning); } # Make sure it's a file even worth even considering if($laborious) { unless( m/\.(pod|pm|plx?)\z/i || -x _ and -T _ # Note that the cheapest operation (the RE) is run first. ) { $verbose > 1 and print " Brushing off uninteresting $file\n"; return; } } else { unless( m/^[-_a-zA-Z0-9]+\.(?:pod|pm|plx?)\z/is ) { $verbose > 1 and print " Brushing off oddly-named $file\n"; return; } } $verbose and print "Considering item $file\n"; my $name = $self->_path2modname( $file, $shortname, $modname_bits ); $verbose > 0.01 and print " Nominating $file as $name\n"; if($limit_re and $name !~ m/$limit_re/i) { $verbose and print "Shunning $name as not matching $limit_re\n"; return; } if( !$shadows and $seen->($name) ) { $verbose and print "Not worth considering $file ", "-- already saw $name as ", join(' ', $files_for->($name)), "\n"; return; } # Put off until as late as possible the expense of # actually reading the 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 ( my $prev = $seen->($name) ) { $verbose and print "Duplicate POD found (shadowing?): $name ($file)\n", " Already seen in ", join(' ', $files_for->($name)), "\n"; } else { $remember->($name, $file); # Noting just the first occurrence } $verbose and print " Noting $name = $file\n"; if( $callback ) { local $_ = $_; # insulate from changes, just in case $callback->($file, $name); } $path2name->{$file} = $name; return; } } #========================================================================== sub _path2modname { my($self, $file, $shortname, $modname_bits) = @_; # this code simplifies the POD name for Perl modules: # * remove "site_perl" # * remove e.g. "i586-linux" (from 'archname') # * remove e.g. 5.00503 # * remove pod/ if followed by perl*.pod (e.g. in pod/perlfunc.pod) # * dig into the file for case-preserved name if not already mixed case my @m = @$modname_bits; my $x; my $verbose = $self->verbose; # Shaving off leading naughty-bits while(@m and defined($x = lc( $m[0] )) and( $x eq 'site_perl' or($x eq 'pod' and @m == 1 and $shortname =~ m{^perl.*\.pod$}s ) or $x =~ m{\\d+\\.z\\d+([_.]?\\d+)?} # if looks like a vernum or $x eq lc( $Config::Config{'archname'} ) )) { shift @m } my $name = join '::', @m, $shortname; $self->_simplify_base($name); # On VMS, case-preserved document names can't be constructed from # filenames, so try to extract them from the "=head1 NAME" tag in the # file instead. if ($^O eq 'VMS' && ($name eq lc($name) || $name eq uc($name))) { open PODFILE, "<$file" or die "_path2modname: Can't open $file: $!"; my $in_pod = 0; my $in_name = 0; my $line; while ($line = <PODFILE>) { chomp $line; $in_pod = 1 if ($line =~ m/^=\w/); $in_pod = 0 if ($line =~ m/^=cut/); next unless $in_pod; # skip non-pod text next if ($line =~ m/^\s*\z/); # and blank lines next if ($in_pod && ($line =~ m/^X</)); # and commands if ($in_name) { if ($line =~ m/(\w+::)?(\w+)/) { # substitute case-preserved version of name my $podname = $2; my $prefix = $1 || ''; $verbose and print "Attempting case restore of '$name' from '$prefix$podname'\n"; unless ($name =~ s/$prefix$podname/$prefix$podname/i) { $verbose and print "Attempting case restore of '$name' from '$podname'\n"; $name =~ s/$podname/$podname/i; } last; } } $in_name = 1 if ($line =~ m/^=head1 NAME/); } close PODFILE; } return $name; } #========================================================================== sub _recurse_dir { my($self, $startdir, $callback, $modname_bits) = @_; my $maxdepth = $self->{'fs_recursion_maxdepth'} || 10; my $verbose = $self->verbose; my $here_string = File::Spec->curdir; my $up_string = File::Spec->updir; $modname_bits ||= []; my $recursor; $recursor = sub { my($dir_long, $dir_bare) = @_; if( @$modname_bits >= 10 ) { $verbose and print "Too deep! [@$modname_bits]\n"; return; } unless(-d $dir_long) { $verbose > 2 and print "But it's not a dir! $dir_long\n"; return; } unless( opendir(INDIR, $dir_long) ) { $verbose > 2 and print "Can't opendir $dir_long : $!\n"; closedir(INDIR); return } # 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 ''; my $i_full; foreach my $i (@items) { next if $i eq $here_string or $i eq $up_string or $i eq ''; $i_full = File::Spec->catfile( $dir_long, $i ); if(!-r $i_full) { $verbose and print "Skipping unreadable $i_full\n"; } elsif(-f $i_full) { $_ = $i; $callback->( $i_full, $i, 0, $modname_bits ); } elsif(-d _) { $i =~ s/\.DIR\z//i if $^O eq 'VMS'; $_ = $i; my $rv = $callback->( $i_full, $i, 1, $modname_bits ) || ''; if($rv eq 'PRUNE') { $verbose > 1 and print "OK, pruning"; } else { # Otherwise, recurse into it $recursor->( File::Spec->catdir($dir_long, $i) , $i); } } else { $verbose > 1 and print "Skipping oddity $i_full\n"; } } pop @$modname_bits; return; };; local $_; $recursor->($startdir, ''); undef $recursor; # allow it to be GC'd return; } #========================================================================== sub run { # A function, useful in one-liners my $self = __PACKAGE__->new; $self->limit_glob($ARGV[0]) if @ARGV; $self->callback( sub { my($file, $name) = @_; my $version = ''; # Yes, I know we won't catch the version in like a File/Thing.pm # if we see File/Thing.pod first. That's just the way the # cookie crumbles. -- SMB if($file =~ m/\.pod$/i) { # Don't bother looking for $VERSION in .pod files DEBUG and print "Not looking for \$VERSION in .pod $file\n"; } elsif( !open(INPOD, $file) ) { DEBUG and print "Couldn't open $file: $!\n"; close(INPOD); } else { # Sane case: file is readable my $lines = 0; while(<INPOD>) { last if $lines++ > $MAX_VERSION_WITHIN; # some degree of sanity if( s/^\s*\$VERSION\s*=\s*//s and m/\d/ ) { DEBUG and print "Found version line (#$lines): $_"; s/\s*\#.*//s; s/\;\s*$//s; s/\s+$//s; s/\t+/ /s; # nix tabs # Optimize the most common cases: $_ = "v$1" if m{^v?["']?([0-9_]+(\.[0-9_]+)*)["']?$}s # like in $VERSION = "3.14159"; or m{\$Revision:\s*([0-9_]+(?:\.[0-9_]+)*)\s*\$}s # like in sprintf("%d.%02d", q$Revision: 4.13 $ =~ /(\d+)\.(\d+)/); ; # Like in sprintf("%d.%s", map {s/_//g; $_} q$Name: release-0_55-public $ =~ /-(\d+)_([\d_]+)/) $_ = sprintf("v%d.%s", map {s/_//g; $_} $1 =~ m/-(\d+)_([\d_]+)/) # snare just the numeric part if m{\$Name:\s*([^\$]+)\$}s ; $version = $_; DEBUG and print "Noting $version as version\n"; last; } } close(INPOD); } print "$name\t$version\t$file\n"; return; # End of callback! }); $self->survey; } #========================================================================== sub simplify_name { my($self, $str) = @_; # Remove all path components # XXX Why not just use basename()? -- SMB if ($^O eq 'MacOS') { $str =~ s{^.*:+}{}s } else { $str =~ s{^.*/+}{}s } $self->_simplify_base($str); return $str; } #========================================================================== sub _simplify_base { # Internal method only # strip Perl's own extensions $_[1] =~ s/\.(pod|pm|plx?)\z//i; # strip meaningless extensions on Win32 and OS/2 $_[1] =~ s/\.(bat|exe|cmd)\z//i if $^O =~ /mswin|os2/i; # strip meaningless extensions on VMS $_[1] =~ s/\.(com)\z//i if $^O eq 'VMS'; return; } #========================================================================== 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 { !$seen{ File::Spec->rel2abs($_) }++ } $self->_mac_whammy(@INC); # Any other OSs need custom handling here? } else { push @$search_dirs, grep { !$seen{ File::Spec->rel2abs($_) }++ } @INC; } $self->{'laborious'} = 0; # Since inc said to use INC return; } #========================================================================== sub _mac_whammy { # Tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS my @them; (undef,@them) = @_; for $_ (@them) { if ( $_ eq '.' ) { $_ = ':'; } elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) { $_ = ':'. $_; } else { $_ =~ s|^\./|:|; } } return @them; } #========================================================================== sub _limit_glob_to_limit_re { my $self = $_[0]; my $limit_glob = $self->{'limit_glob'} || return; my $limit_re = '^' . quotemeta($limit_glob) . '$'; $limit_re =~ s/\\\?/./g; # glob "?" => "." $limit_re =~ s/\\\*/.*?/g; # glob "*" => ".*?" $limit_re =~ s/\.\*\?\$$//s; # final glob "*" => ".*?$" => "" $self->{'verbose'} and print "Turning limit_glob $limit_glob into re $limit_re\n"; # A common optimization: if(!exists($self->{'dir_prefix'}) and $limit_glob =~ m/^(?:\w+\:\:)+/s # like "File::*" or "File::Thing*" # Optimize for sane and common cases (but not things like "*::File") ) { $self->{'dir_prefix'} = join "::", $limit_glob =~ m/^(?:\w+::)+/sg; $self->{'verbose'} and print " and setting dir_prefix to $self->{'dir_prefix'}\n"; } return $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 # Check usage Carp::carp 'Usage: \$self->find($podname, ...)' unless defined $pod and length $pod; my $verbose = $self->verbose; # Split on :: and then join the name together using File::Spec my @parts = split /::/, $pod; $verbose and print "Chomping {$pod} => {@parts}\n"; #@search_dirs = File::Spec->curdir unless @search_dirs; $self->_expand_inc(\@search_dirs); # Add location of binaries such as pod2text: push @search_dirs, $Config::Config{'scriptdir'} if $self->inc; my %seen_dir; 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; } print "Looking in directory $dir\n" if $verbose; my $fullname = File::Spec->catfile( $dir, @parts ); print "Filename is now $fullname\n" if $verbose; foreach my $ext ('', '.pod', '.pm', '.pl') { # possible extensions my $fullext = $fullname . $ext; 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; } } # 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; } } } return undef; } #========================================================================== sub contains_pod { my($self, $file) = @_; my $verbose = $self->{'verbose'}; # check for one line of POD $verbose > 1 and print " Scanning $file for pod...\n"; unless( open(MAYBEPOD,"<$file") ) { print "Error: $file is unreadable: $!\n"; return undef; } sleep($SLEEPY - 1) if $SLEEPY; # avoid totally hogging the processor on OSs with poor process control local $_; while( <MAYBEPOD> ) { if(m/^=(head\d|pod|over|item)\b/s) { close(MAYBEPOD) || die "Bizarre error closing $file: $!\nAborting"; chomp; $verbose > 1 and print " Found some pod ($_) in $file\n"; return 1; } } close(MAYBEPOD) || die "Bizarre error closing $file: $!\nAborting"; $verbose > 1 and print " No POD in $file, skipping.\n"; return 0; } #========================================================================== sub _accessorize { # A simple-minded method-maker shift; no strict 'refs'; foreach my $attrname (@_) { *{caller() . '::' . $attrname} = sub { use strict; $Carp::CarpLevel = 1, Carp::croak( "Accessor usage: \$obj->$attrname() or \$obj->$attrname(\$new_value)" ) unless (@_ == 1 or @_ == 2) and ref $_[0]; # Read access: return $_[0]->{$attrname} if @_ == 1; # Write access: $_[0]->{$attrname} = $_[1]; return $_[0]; # RETURNS MYSELF! }; } # Ya know, they say accessories make the ensemble! return; } #========================================================================== sub _state_as_string { my $self = $_[0]; return '' unless ref $self; my @out = "{\n # State of $self ...\n"; foreach my $k (sort keys %$self) { push @out, " ", _esc($k), " => ", _esc($self->{$k}), ",\n"; } push @out, "}\n"; my $x = join '', @out; $x =~ s/^/#/mg; return $x; } sub _esc { my $in = $_[0]; return 'undef' unless defined $in; $in =~ s<([^\x20\x21\x23\x27-\x3F\x41-\x5B\x5D-\x7E])> <'\\x'.(unpack("H2",$1))>eg; return qq{"$in"}; } #========================================================================== run() unless caller; # run if "perl whatever/Search.pm" 1; #========================================================================== __END__ =head1 NAME Pod::Simple::Search - find POD documents in directory trees =head1 SYNOPSIS use Pod::Simple::Search; my $name2path = Pod::Simple::Search->new->limit_glob('LWP::*')->survey; print "Looky see what I found: ", join(' ', sort keys %$name2path), "\n"; print "LWPUA docs = ", Pod::Simple::Search->new->find('LWP::UserAgent') || "?", "\n"; =head1 DESCRIPTION B<Pod::Simple::Search> is a class that you use for running searches for Pod files. An object of this class has several attributes (mostly options for controlling search options), and some methods for searching based on those attributes. The way to use this class is to make a new object of this class, set any options, and then call one of the search options (probably C<survey> or C<find>). The sections below discuss the syntaxes for doing all that. =head1 CONSTRUCTOR This class provides the one constructor, called C<new>. It takes no parameters: use Pod::Simple::Search; my $search = Pod::Simple::Search->new; =head1 ACCESSORS This class defines several methods for setting (and, occasionally, reading) the contents of an object. With two exceptions (discussed at the end of this section), these attributes are just for controlling the way searches are carried out. Note that each of these return C<$self> when you call them as C<< $self->I<whatever(value)> >>. That's so that you can chain together set-attribute calls like this: my $name2path = Pod::Simple::Search->new -> inc(0) -> verbose(1) -> callback(\&blab) ->survey(@there); ...which works exactly as if you'd done this: my $search = Pod::Simple::Search->new; $search->inc(0); $search->verbose(1); $search->callback(\&blab); my $name2path = $search->survey(@there); =over =item $search->inc( I<true-or-false> ); This attribute, if set to a true value, means that searches should implicitly add perl's I<@INC> paths. This automatically considers paths specified in the C<PERL5LIB> environment as this is prepended to I<@INC> by the Perl interpreter itself. This attribute's default value is B<TRUE>. If you want to search only specific directories, set $self->inc(0) before calling $inc->survey or $inc->find. =item $search->verbose( I<nonnegative-number> ); This attribute, if set to a nonzero positive value, will make searches output (via C<warn>) notes about what they're doing as they do it. This option may be useful for debugging a pod-related module. This attribute's default value is zero, meaning that no C<warn> messages are produced. (Setting verbose to 1 turns on some messages, and setting it to 2 turns on even more messages, i.e., makes the following search(es) even more verbose than 1 would make them.) =item $search->limit_glob( I<some-glob-string> ); This option means that you want to limit the results just to items whose podnames match the given glob/wildcard expression. For example, you might limit your search to just "LWP::*", to search only for modules starting with "LWP::*" (but not including the module "LWP" itself); or you might limit your search to "LW*" to see only modules whose (full) names begin with "LW"; or you might search for "*Find*" to search for all modules with "Find" somewhere in their full name. (You can also use "?" in a glob expression; so "DB?" will match "DBI" and "DBD".) =item $search->callback( I<\&some_routine> ); This attribute means that every time this search sees a matching Pod file, it should call this callback routine. The routine is called with two parameters: the current file's filespec, and its pod name. (For example: C<("/etc/perljunk/File/Crunk.pm", "File::Crunk")> would be in C<@_>.) The callback routine's return value is not used for anything. This attribute's default value is false, meaning that no callback is called. =item $search->laborious( I<true-or-false> ); Unless you set this attribute to a true value, Pod::Search will apply Perl-specific heuristics to find the correct module PODs quickly. This attribute's default value is false. You won't normally need to set this to true. Specifically: Turning on this option will disable the heuristics for seeing only files with Perl-like extensions, omitting subdirectories that are numeric but do I<not> match the current Perl interpreter's version ID, suppressing F<site_perl> as a module hierarchy name, etc. =item $search->recurse( I<true-or-false> ); Unless you set this attribute to a false value, Pod::Search will recurse into subdirectories of the search directories. =item $search->shadows( I<true-or-false> ); Unless you set this attribute to a true value, Pod::Simple::Search will consider only the first file of a given modulename as it looks thru the specified directories; that is, with this option off, if Pod::Simple::Search has seen a C<somepathdir/Foo/Bar.pm> already in this search, then it won't bother looking at a C<somelaterpathdir/Foo/Bar.pm> later on in that search, because that file is merely a "shadow". But if you turn on C<< $self->shadows(1) >>, then these "shadow" files are inspected too, and are noted in the pathname2podname return hash. This attribute's default value is false; and normally you won't need to turn it on. =item $search->limit_re( I<some-regxp> ); Setting this attribute (to a value that's a regexp) means that you want to limit the results just to items whose podnames match the given regexp. Normally this option is not needed, and the more efficient C<limit_glob> attribute is used instead. =item $search->dir_prefix( I<some-string-value> ); Setting this attribute to a string value means that the searches should begin in the specified subdirectory name (like "Pod" or "File::Find", also expressible as "File/Find"). For example, the search option C<< $search->limit_glob("File::Find::R*") >> is the same as the combination of the search options C<< $search->limit_re("^File::Find::R") -> dir_prefix("File::Find") >>. Normally you don't need to know about the C<dir_prefix> option, but I include it in case it might prove useful for someone somewhere. (Implementationally, searching with limit_glob ends up setting limit_re and usually dir_prefix.) =item $search->progress( I<some-progress-object> ); If you set a value for this attribute, the value is expected to be an object (probably of a class that you define) that has a C<reach> method and a C<done> method. This is meant for reporting progress during the search, if you don't want to use a simple callback. Normally you don't need to know about the C<progress> option, but I include it in case it might prove useful for someone somewhere. While a search is in progress, the progress object's C<reach> and C<done> methods are called like this: # Every time a file is being scanned for pod: $progress->reach($count, "Scanning $file"); ++$count; # And then at the end of the search: $progress->done("Noted $count Pod files total"); Internally, we often set this to an object of class Pod::Simple::Progress. That class is probably undocumented, but you may wish to look at its source. =item $name2path = $self->name2path; This attribute is not a search parameter, but is used to report the result of C<survey> method, as discussed in the next section. =item $path2name = $self->path2name; This attribute is not a search parameter, but is used to report the result of C<survey> method, as discussed in the next section. =back =head1 MAIN SEARCH METHODS Once you've actually set any options you want (if any), you can go ahead and use the following methods to search for Pod files in particular ways. =head2 C<< $search->survey( @directories ) >> The method C<survey> searches for POD documents in a given set of files and/or directories. This runs the search according to the various options set by the accessors above. (For example, if the C<inc> attribute is on, as it is by default, then the perl @INC directories are implicitly added to the list of directories (if any) that you specify.) The return value of C<survey> is two hashes: =over =item C<name2path> A hash that maps from each pod-name to the filespec (like "Stuff::Thing" => "/whatever/plib/Stuff/Thing.pm") =item C<path2name> A hash that maps from each Pod filespec to its pod-name (like "/whatever/plib/Stuff/Thing.pm" => "Stuff::Thing") =back Besides saving these hashes as the hashref attributes C<name2path> and C<path2name>, calling this function also returns these hashrefs. In list context, the return value of C<< $search->survey >> is the list C<(\%name2path, \%path2name)>. In scalar context, the return value is C<\%name2path>. Or you can just call this in void context. Regardless of calling context, calling C<survey> saves its results in its C<name2path> and C<path2name> attributes. E.g., when searching in F<$HOME/perl5lib>, the file F<$HOME/perl5lib/MyModule.pm> would get the POD name I<MyModule>, whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be I<Myclass::Subclass>. The name information can be used for POD translators. Only text files containing at least one valid POD command are found. In verbose mode, a warning is printed if shadows are found (i.e., more than one POD file with the same POD name is found, e.g. F<CPAN.pm> in different directories). This usually indicates duplicate occurrences of modules in the I<@INC> search path, which is occasionally inadvertent (but is often simply a case of a user's path dir having a more recent version than the system's general path dirs in general.) The options to this argument is a list of either directories that are searched recursively, or files. (Usually you wouldn't specify files, but just dirs.) Or you can just specify an empty-list, as in $name2path; with the C<inc> option on, as it is by default. The POD names of files are the plain basenames with any Perl-like extension (.pm, .pl, .pod) stripped, and path separators replaced by C<::>'s. Calling Pod::Simple::Search->search(...) is short for Pod::Simple::Search->new->search(...). That is, a throwaway object with default attribute values is used. =head2 C<< $search->simplify_name( $str ) >> The method B<simplify_name> is equivalent to B<basename>, but also strips Perl-like extensions (.pm, .pl, .pod) and extensions like F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively. =head2 C<< $search->find( $pod ) >> =head2 C<< $search->find( $pod, @search_dirs ) >> Returns the location of a Pod file, given a Pod/module/script name (like "Foo::Bar" or "perlvar" or "perldoc"), and an idea of what files/directories to look in. It searches according to the various options set by the accessors above. (For example, if the C<inc> attribute is on, as it is by default, then the perl @INC directories are implicitly added to the list of directories (if any) that you specify.) This returns the full path of the first occurrence to the file. Package names (eg 'A::B') are automatically converted to directory names in the selected directory. Additionally, '.pm', '.pl' and '.pod' are automatically appended to the search as required. (So, for example, under Unix, "A::B" is converted to "somedir/A/B.pm", "somedir/A/B.pod", or "somedir/A/B.pl", as appropriate.) If no such Pod file is found, this method returns undef. If any of the given search directories contains a F<pod/> subdirectory, then it is searched. (That's how we manage to find F<perlfunc>, for example, which is usually in F<pod/perlfunc> in most Perl dists.) The C<verbose> and C<inc> attributes influence the behavior of this search; notably, C<inc>, if true, adds @INC I<and also $Config::Config{'scriptdir'}> to the list of directories to search. It is common to simply say C<< $filename = Pod::Simple::Search-> new ->find("perlvar") >> so that just the @INC (well, and scriptdir) directories are searched. (This happens because the C<inc> attribute is true by default.) Calling Pod::Simple::Search->find(...) is short for Pod::Simple::Search->new->find(...). That is, a throwaway object with default attribute values is used. =head2 C<< $self->contains_pod( $file ) >> 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 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/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>. =head1 COPYRIGHT AND DISCLAIMERS Copyright (c) 2002 Sean M. Burke. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. =head1 AUTHOR Pod::Simple was created by Sean M. Burke <sburke@cpan.org> with code borrowed from Marek Rouchal's L<Pod::Find>, which in turn heavily borrowed code from Nick Ing-Simmons' C<PodToHtml>. But don't bother him, he's retired. Pod::Simple is maintained by: =over =item * Allison Randal C<allison@perl.org> =item * Hans Dieter Pearcey C<hdp@cpan.org> =item * David E. Wheeler C<dwheeler@cpan.org> =back =cut
Copyright ©2021 || Defacer Indonesia