X-Git-Url: https://vcs.maemo.org/git/?a=blobdiff_plain;f=dev%2Fi386%2Flibpod-simple-perl%2Flibpod-simple-perl-3.07%2Flib%2FPod%2FSimple%2FSearch.pm;fp=dev%2Fi386%2Flibpod-simple-perl%2Flibpod-simple-perl-3.07%2Flib%2FPod%2FSimple%2FSearch.pm;h=980b3b7739c9150da9f2df7a3d5cab678cc01bc4;hb=8977e561d8a9eae6959218b0306c9df2056a38a9;hp=0000000000000000000000000000000000000000;hpb=df794b845212301ea0d267c919232538bfef356a;p=dh-make-perl diff --git a/dev/i386/libpod-simple-perl/libpod-simple-perl-3.07/lib/Pod/Simple/Search.pm b/dev/i386/libpod-simple-perl/libpod-simple-perl-3.07/lib/Pod/Simple/Search.pm new file mode 100644 index 0000000..980b3b7 --- /dev/null +++ b/dev/i386/libpod-simple-perl/libpod-simple-perl-3.07/lib/Pod/Simple/Search.pm @@ -0,0 +1,1016 @@ + +require 5.005; +package Pod::Simple::Search; +use strict; + +use vars qw($VERSION $MAX_VERSION_WITHIN $SLEEPY); +$VERSION = 3.04; ## 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; + +############################################################################# + +#use diagnostics; +use File::Spec (); +use File::Basename qw( basename ); +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', +); +#========================================================================== + +sub new { + my $class = shift; + my $self = bless {}, ref($class) || $class; + $self->init; + return $self; +} + +sub init { + my $self = shift; + $self->inc(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->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"); + + 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) = + map scalar($self->$_()), + qw(laborious verbose shadows limit_re callback progress path2name name2path); + + 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 + + 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 $name2path->{$name} ) { + $verbose and print "Not worth considering $file ", + "-- already saw $name as ", + join(' ', grep($path2name->{$_} eq $name, keys %$path2name)), "\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 ); + } + ++ $self->{'_scan_count'}; + + # Or finally take note of it: + if( $name2path->{$name} ) { + $verbose and print + "Duplicate POD found (shadowing?): $name ($file)\n", + " Already seen in ", + join(' ', grep($path2name->{$_} eq $name, keys %$path2name)), "\n"; + } else { + $name2path->{$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 = ) { + 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{'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 + } + my @items = sort 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() { + 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'}; + + if ($^O eq 'MacOS') { + push @$search_dirs, + grep $_ ne File::Spec->curdir, $self->_mac_whammy(@INC); + # Any other OSs need custom handling here? + } else { + push @$search_dirs, grep $_ ne File::Spec->curdir, @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 + +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; + + 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 + } + + my %seen_dir; + Dir: + foreach my $dir ( @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; + 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; + 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; + } + } + + 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( ) { + 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 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 or C). The sections below discuss the +syntaxes for doing all that. + + +=head1 CONSTRUCTOR + +This class provides the one constructor, called C. +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 >>. 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 ); + +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 environment +as this is prepended to I<@INC> by the Perl interpreter itself. +This attribute's default value is B. If you want to search +only specific directories, set $self->inc(0) before calling +$inc->survey or $inc->find. + + +=item $search->verbose( I ); + +This attribute, if set to a nonzero positive value, will make searches output +(via C) 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 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 ); + +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 ); + +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 match the current Perl interpreter's +version ID, suppressing F as a module hierarchy name, etc. + + +=item $search->shadows( I ); + +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 already in this +search, then it won't bother looking at a C +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 ); + +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 attribute is used instead. + + +=item $search->dir_prefix( I ); + +Setting this attribute to a string value means that the searches should +begin in the specified subdirectory name (like "Pod" or "File::Find", +also expressable 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 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 ); + +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 method and a C 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 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 and +C 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 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 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 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 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 is two hashes: + +=over + +=item C + +A hash that maps from each pod-name to the filespec (like +"Stuff::Thing" => "/whatever/plib/Stuff/Thing.pm") + +=item C + +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 and C, 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 saves +its results in its C and C attributes. + +E.g., when searching in F<$HOME/perl5lib>, the file +F<$HOME/perl5lib/MyModule.pm> would get the POD name I, +whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be +I. 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 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 option on, as it is by default, teh + +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 is equivalent to B, 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 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 subdirectory, +then it is searched. (That's how we manage to find F, +for example, which is usually in F in most Perl dists.) + +The C and C attributes influence the behavior of this +search; notably, C, if true, adds @INC I 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 +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 AUTHOR + +Sean M. Burke Esburke@cpan.orgE +borrowed code from +Marek Rouchal's Pod::Find, which in turn +heavily borrowed code from Nick Ing-Simmons' PodToHtml. + +Tim Jenness Et.jenness@jach.hawaii.eduE provided +C and C to Pod::Find. + +=head1 SEE ALSO + +L, L + +=cut +