vcs.maemo.org Git - dh-make-perl/blob - dev/i386/libpod-simple-perl/libpod-simple-perl-3.07/lib/Pod/Simple/Search.pm

   1
   2 require 5.005;
   3 package Pod::Simple::Search;
   4 use strict;
   5
   6 use vars qw($VERSION $MAX_VERSION_WITHIN $SLEEPY);
   7 $VERSION = 3.04;   ## Current version of this package
   8
   9 BEGIN { *DEBUG = sub () {0} unless defined &DEBUG; }   # set DEBUG level
  10 use Carp ();
  11
  12 $SLEEPY = 1 if !defined $SLEEPY and $^O =~ /mswin|mac/i;
  13   # flag to occasionally sleep for $SLEEPY - 1 seconds.
  14
  15 $MAX_VERSION_WITHIN ||= 60;
  16
  17 #############################################################################
  18
  19 #use diagnostics;
  20 use File::Spec ();
  21 use File::Basename qw( basename );
  22 use Config ();
  23 use Cwd qw( cwd );
  24
  25 #==========================================================================
  26 __PACKAGE__->_accessorize(  # Make my dumb accessor methods
  27  'callback', 'progress', 'dir_prefix', 'inc', 'laborious', 'limit_glob',
  28  'limit_re', 'shadows', 'verbose', 'name2path', 'path2name',
  29 );
  30 #==========================================================================
  31
  32 sub new {
  33   my $class = shift;
  34   my $self = bless {}, ref($class) || $class;
  35   $self->init;
  36   return $self;
  37 }
  38
  39 sub init {
  40   my $self = shift;
  41   $self->inc(1);
  42   $self->verbose(DEBUG);
  43   return $self;
  44 }
  45
  46 #--------------------------------------------------------------------------
  47
  48 sub survey {
  49   my($self, @search_dirs) = @_;
  50   $self = $self->new unless ref $self; # tolerate being a class method
  51
  52   $self->_expand_inc( \@search_dirs );
  53
  54
  55   $self->{'_scan_count'} = 0;
  56   $self->{'_dirs_visited'} = {};
  57   $self->path2name( {} );
  58   $self->name2path( {} );
  59   $self->limit_re( $self->_limit_glob_to_limit_re ) if $self->{'limit_glob'};
  60   my $cwd = cwd();
  61   my $verbose  = $self->verbose;
  62   local $_; # don't clobber the caller's $_ !
  63
  64   foreach my $try (@search_dirs) {
  65     unless( File::Spec->file_name_is_absolute($try) ) {
  66       # make path absolute
  67       $try = File::Spec->catfile( $cwd ,$try);
  68     }
  69     # simplify path
  70     $try =  File::Spec->canonpath($try);
  71
  72     my $start_in;
  73     my $modname_prefix;
  74     if($self->{'dir_prefix'}) {
  75       $start_in = File::Spec->catdir(
  76         $try,
  77         grep length($_), split '[\\/:]+', $self->{'dir_prefix'}
  78       );
  79       $modname_prefix = [grep length($_), split m{[:/\\]}, $self->{'dir_prefix'}];
  80       $verbose and print "Appending \"$self->{'dir_prefix'}\" to $try, ",
  81         "giving $start_in (= @$modname_prefix)\n";
  82     } else {
  83       $start_in = $try;
  84     }
  85
  86     if( $self->{'_dirs_visited'}{$start_in} ) {
  87       $verbose and print "Directory '$start_in' already seen, skipping.\n";
  88       next;
  89     } else {
  90       $self->{'_dirs_visited'}{$start_in} = 1;
  91     }
  92
  93     unless(-e $start_in) {
  94       $verbose and print "Skipping non-existent $start_in\n";
  95       next;
  96     }
  97
  98     my $closure = $self->_make_search_callback;
  99
 100     if(-d $start_in) {
 101       # Normal case:
 102       $verbose and print "Beginning excursion under $start_in\n";
 103       $self->_recurse_dir( $start_in, $closure, $modname_prefix );
 104       $verbose and print "Back from excursion under $start_in\n\n";
 105
 106     } elsif(-f _) {
 107       # A excursion consisting of just one file!
 108       $_ = basename($start_in);
 109       $verbose and print "Pondering $start_in ($_)\n";
 110       $closure->($start_in, $_, 0, []);
 111
 112     } else {
 113       $verbose and print "Skipping mysterious $start_in\n";
 114     }
 115   }
 116   $self->progress and $self->progress->done(
 117    "Noted $$self{'_scan_count'} Pod files total");
 118
 119   return unless defined wantarray; # void
 120   return $self->name2path unless wantarray; # scalar
 121   return $self->name2path, $self->path2name; # list
 122 }
 123
 124
 125 #==========================================================================
 126 sub _make_search_callback {
 127   my $self = $_[0];
 128
 129   # Put the options in variables, for easy access
 130   my(  $laborious, $verbose, $shadows, $limit_re, $callback, $progress,$path2name,$name2path) =
 131     map scalar($self->$_()),
 132      qw(laborious   verbose   shadows   limit_re   callback   progress  path2name  name2path);
 133
 134   my($file, $shortname, $isdir, $modname_bits);
 135   return sub {
 136     ($file, $shortname, $isdir, $modname_bits) = @_;
 137
 138     if($isdir) { # this never gets called on the startdir itself, just subdirs
 139
 140       if( $self->{'_dirs_visited'}{$file} ) {
 141         $verbose and print "Directory '$file' already seen, skipping.\n";
 142         return 'PRUNE';
 143       }
 144
 145       print "Looking in dir $file\n" if $verbose;
 146
 147       unless ($laborious) { # $laborious overrides pruning
 148         if( m/^(\d+\.[\d_]{3,})\z/s
 149              and do { my $x = $1; $x =~ tr/_//d; $x != $] }
 150            ) {
 151           $verbose and print "Perl $] version mismatch on $_, skipping.\n";
 152           return 'PRUNE';
 153         }
 154
 155         if( m/^([A-Za-z][a-zA-Z0-9_]*)\z/s ) {
 156           $verbose and print "$_ is a well-named module subdir.  Looking....\n";
 157         } else {
 158           $verbose and print "$_ is a fishy directory name.  Skipping.\n";
 159           return 'PRUNE';
 160         }
 161       } # end unless $laborious
 162
 163       $self->{'_dirs_visited'}{$file} = 1;
 164       return; # (not pruning);
 165     }
 166
 167
 168     # Make sure it's a file even worth even considering
 169     if($laborious) {
 170       unless(
 171         m/\.(pod|pm|plx?)\z/i || -x _ and -T _
 172          # Note that the cheapest operation (the RE) is run first.
 173       ) {
 174         $verbose > 1 and print " Brushing off uninteresting $file\n";
 175         return;
 176       }
 177     } else {
 178       unless( m/^[-_a-zA-Z0-9]+\.(?:pod|pm|plx?)\z/is ) {
 179         $verbose > 1 and print " Brushing off oddly-named $file\n";
 180         return;
 181       }
 182     }
 183
 184     $verbose and print "Considering item $file\n";
 185     my $name = $self->_path2modname( $file, $shortname, $modname_bits );
 186     $verbose > 0.01 and print " Nominating $file as $name\n";
 187
 188     if($limit_re and $name !~ m/$limit_re/i) {
 189       $verbose and print "Shunning $name as not matching $limit_re\n";
 190       return;
 191     }
 192
 193     if( !$shadows and $name2path->{$name} ) {
 194       $verbose and print "Not worth considering $file ",
 195         "-- already saw $name as ",
 196         join(' ', grep($path2name->{$_} eq $name, keys %$path2name)), "\n";
 197       return;
 198     }
 199
 200     # Put off until as late as possible the expense of
 201     #  actually reading the file:
 202     if( m/\.pod\z/is ) {
 203       # just assume it has pod, okay?
 204     } else {
 205       $progress and $progress->reach($self->{'_scan_count'}, "Scanning $file");
 206       return unless $self->contains_pod( $file );
 207     }
 208     ++ $self->{'_scan_count'};
 209
 210     # Or finally take note of it:
 211     if( $name2path->{$name} ) {
 212       $verbose and print
 213        "Duplicate POD found (shadowing?): $name ($file)\n",
 214        "    Already seen in ",
 215        join(' ', grep($path2name->{$_} eq $name, keys %$path2name)), "\n";
 216     } else {
 217       $name2path->{$name} = $file; # Noting just the first occurrence
 218     }
 219     $verbose and print "  Noting $name = $file\n";
 220     if( $callback ) {
 221       local $_ = $_; # insulate from changes, just in case
 222       $callback->($file, $name);
 223     }
 224     $path2name->{$file} = $name;
 225     return;
 226   }
 227 }
 228
 229 #==========================================================================
 230
 231 sub _path2modname {
 232   my($self, $file, $shortname, $modname_bits) = @_;
 233
 234   # this code simplifies the POD name for Perl modules:
 235   # * remove "site_perl"
 236   # * remove e.g. "i586-linux" (from 'archname')
 237   # * remove e.g. 5.00503
 238   # * remove pod/ if followed by perl*.pod (e.g. in pod/perlfunc.pod)
 239   # * dig into the file for case-preserved name if not already mixed case
 240
 241   my @m = @$modname_bits;
 242   my $x;
 243   my $verbose = $self->verbose;
 244
 245   # Shaving off leading naughty-bits
 246   while(@m
 247     and defined($x = lc( $m[0] ))
 248     and(  $x eq 'site_perl'
 249        or($x eq 'pod' and @m == 1 and $shortname =~ m{^perl.*\.pod$}s )
 250        or $x =~ m{\\d+\\.z\\d+([_.]?\\d+)?}  # if looks like a vernum
 251        or $x eq lc( $Config::Config{'archname'} )
 252   )) { shift @m }
 253
 254   my $name = join '::', @m, $shortname;
 255   $self->_simplify_base($name);
 256
 257   # On VMS, case-preserved document names can't be constructed from
 258   # filenames, so try to extract them from the "=head1 NAME" tag in the
 259   # file instead.
 260   if ($^O eq 'VMS' && ($name eq lc($name) || $name eq uc($name))) {
 261       open PODFILE, "<$file" or die "_path2modname: Can't open $file: $!";
 262       my $in_pod = 0;
 263       my $in_name = 0;
 264       my $line;
 265       while ($line = <PODFILE>) {
 266         chomp $line;
 267         $in_pod = 1 if ($line =~ m/^=\w/);
 268         $in_pod = 0 if ($line =~ m/^=cut/);
 269         next unless $in_pod;         # skip non-pod text
 270         next if ($line =~ m/^\s*\z/);           # and blank lines
 271         next if ($in_pod && ($line =~ m/^X</)); # and commands
 272         if ($in_name) {
 273           if ($line =~ m/(\w+::)?(\w+)/) {
 274             # substitute case-preserved version of name
 275             my $podname = $2;
 276             my $prefix = $1 || '';
 277             $verbose and print "Attempting case restore of '$name' from '$prefix$podname'\n";
 278             unless ($name =~ s/$prefix$podname/$prefix$podname/i) {
 279               $verbose and print "Attempting case restore of '$name' from '$podname'\n";
 280               $name =~ s/$podname/$podname/i;
 281             }
 282             last;
 283           }
 284         }
 285         $in_name = 1 if ($line =~ m/^=head1 NAME/);
 286     }
 287     close PODFILE;
 288   }
 289
 290   return $name;
 291 }
 292
 293 #==========================================================================
 294
 295 sub _recurse_dir {
 296   my($self, $startdir, $callback, $modname_bits) = @_;
 297
 298   my $maxdepth = $self->{'fs_recursion_maxdepth'} || 10;
 299   my $verbose = $self->verbose;
 300
 301   my $here_string = File::Spec->curdir;
 302   my $up_string   = File::Spec->updir;
 303   $modname_bits ||= [];
 304
 305   my $recursor;
 306   $recursor = sub {
 307     my($dir_long, $dir_bare) = @_;
 308     if( @$modname_bits >= 10 ) {
 309       $verbose and print "Too deep! [@$modname_bits]\n";
 310       return;
 311     }
 312
 313     unless(-d $dir_long) {
 314       $verbose > 2 and print "But it's not a dir! $dir_long\n";
 315       return;
 316     }
 317     unless( opendir(INDIR, $dir_long) ) {
 318       $verbose > 2 and print "Can't opendir $dir_long : $!\n";
 319       closedir(INDIR);
 320       return
 321     }
 322     my @items = sort readdir(INDIR);
 323     closedir(INDIR);
 324
 325     push @$modname_bits, $dir_bare unless $dir_bare eq '';
 326
 327     my $i_full;
 328     foreach my $i (@items) {
 329       next if $i eq $here_string or $i eq $up_string or $i eq '';
 330       $i_full = File::Spec->catfile( $dir_long, $i );
 331
 332       if(!-r $i_full) {
 333         $verbose and print "Skipping unreadable $i_full\n";
 334
 335       } elsif(-f $i_full) {
 336         $_ = $i;
 337         $callback->(          $i_full, $i, 0, $modname_bits );
 338
 339       } elsif(-d _) {
 340         $i =~ s/\.DIR\z//i if $^O eq 'VMS';
 341         $_ = $i;
 342         my $rv = $callback->( $i_full, $i, 1, $modname_bits ) || '';
 343
 344         if($rv eq 'PRUNE') {
 345           $verbose > 1 and print "OK, pruning";
 346         } else {
 347           # Otherwise, recurse into it
 348           $recursor->( File::Spec->catdir($dir_long, $i) , $i);
 349         }
 350       } else {
 351         $verbose > 1 and print "Skipping oddity $i_full\n";
 352       }
 353     }
 354     pop @$modname_bits;
 355     return;
 356   };;
 357
 358   local $_;
 359   $recursor->($startdir, '');
 360
 361   undef $recursor;  # allow it to be GC'd
 362
 363   return;
 364 }
 365
 366
 367 #==========================================================================
 368
 369 sub run {
 370   # A function, useful in one-liners
 371
 372   my $self = __PACKAGE__->new;
 373   $self->limit_glob($ARGV[0]) if @ARGV;
 374   $self->callback( sub {
 375     my($file, $name) = @_;
 376     my $version = '';
 377
 378     # Yes, I know we won't catch the version in like a File/Thing.pm
 379     #  if we see File/Thing.pod first.  That's just the way the
 380     #  cookie crumbles.  -- SMB
 381
 382     if($file =~ m/\.pod$/i) {
 383       # Don't bother looking for $VERSION in .pod files
 384       DEBUG and print "Not looking for \$VERSION in .pod $file\n";
 385     } elsif( !open(INPOD, $file) ) {
 386       DEBUG and print "Couldn't open $file: $!\n";
 387       close(INPOD);
 388     } else {
 389       # Sane case: file is readable
 390       my $lines = 0;
 391       while(<INPOD>) {
 392         last if $lines++ > $MAX_VERSION_WITHIN; # some degree of sanity
 393         if( s/^\s*\$VERSION\s*=\s*//s and m/\d/ ) {
 394           DEBUG and print "Found version line (#$lines): $_";
 395           s/\s*\#.*//s;
 396           s/\;\s*$//s;
 397           s/\s+$//s;
 398           s/\t+/ /s; # nix tabs
 399           # Optimize the most common cases:
 400           $_ = "v$1"
 401             if m{^v?["']?([0-9_]+(\.[0-9_]+)*)["']?$}s
 402              # like in $VERSION = "3.14159";
 403              or m{\$Revision:\s*([0-9_]+(?:\.[0-9_]+)*)\s*\$}s
 404              # like in sprintf("%d.%02d", q$Revision: 4.13 $ =~ /(\d+)\.(\d+)/);
 405           ;
 406
 407           # Like in sprintf("%d.%s", map {s/_//g; $_} q$Name: release-0_55-public $ =~ /-(\d+)_([\d_]+)/)
 408           $_ = sprintf("v%d.%s",
 409             map {s/_//g; $_}
 410               $1 =~ m/-(\d+)_([\d_]+)/) # snare just the numeric part
 411            if m{\$Name:\s*([^\$]+)\$}s
 412           ;
 413           $version = $_;
 414           DEBUG and print "Noting $version as version\n";
 415           last;
 416         }
 417       }
 418       close(INPOD);
 419     }
 420     print "$name\t$version\t$file\n";
 421     return;
 422     # End of callback!
 423   });
 424
 425   $self->survey;
 426 }
 427
 428 #==========================================================================
 429
 430 sub simplify_name {
 431   my($self, $str) = @_;
 432
 433   # Remove all path components
 434   #                             XXX Why not just use basename()? -- SMB
 435
 436   if ($^O eq 'MacOS') { $str =~ s{^.*:+}{}s }
 437   else                { $str =~ s{^.*/+}{}s }
 438
 439   $self->_simplify_base($str);
 440   return $str;
 441 }
 442
 443 #==========================================================================
 444
 445 sub _simplify_base {   # Internal method only
 446
 447   # strip Perl's own extensions
 448   $_[1] =~ s/\.(pod|pm|plx?)\z//i;
 449
 450   # strip meaningless extensions on Win32 and OS/2
 451   $_[1] =~ s/\.(bat|exe|cmd)\z//i if $^O =~ /mswin|os2/i;
 452
 453   # strip meaningless extensions on VMS
 454   $_[1] =~ s/\.(com)\z//i if $^O eq 'VMS';
 455
 456   return;
 457 }
 458
 459 #==========================================================================
 460
 461 sub _expand_inc {
 462   my($self, $search_dirs) = @_;
 463
 464   return unless $self->{'inc'};
 465
 466   if ($^O eq 'MacOS') {
 467     push @$search_dirs,
 468       grep $_ ne File::Spec->curdir, $self->_mac_whammy(@INC);
 469   # Any other OSs need custom handling here?
 470   } else {
 471     push @$search_dirs, grep $_ ne File::Spec->curdir,  @INC;
 472   }
 473
 474   $self->{'laborious'} = 0;   # Since inc said to use INC
 475   return;
 476 }
 477
 478 #==========================================================================
 479
 480 sub _mac_whammy { # Tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS
 481   my @them;
 482   (undef,@them) = @_;
 483   for $_ (@them) {
 484     if ( $_ eq '.' ) {
 485       $_ = ':';
 486     } elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) {
 487       $_ = ':'. $_;
 488     } else {
 489       $_ =~ s|^\./|:|;
 490     }
 491   }
 492   return @them;
 493 }
 494
 495 #==========================================================================
 496
 497 sub _limit_glob_to_limit_re {
 498   my $self = $_[0];
 499   my $limit_glob = $self->{'limit_glob'} || return;
 500
 501   my $limit_re = '^' . quotemeta($limit_glob) . '$';
 502   $limit_re =~ s/\\\?/./g;    # glob "?" => "."
 503   $limit_re =~ s/\\\*/.*?/g;  # glob "*" => ".*?"
 504   $limit_re =~ s/\.\*\?\$$//s; # final glob "*" => ".*?$" => ""
 505
 506   $self->{'verbose'} and print "Turning limit_glob $limit_glob into re $limit_re\n";
 507
 508   # A common optimization:
 509   if(!exists($self->{'dir_prefix'})
 510     and $limit_glob =~ m/^(?:\w+\:\:)+/s  # like "File::*" or "File::Thing*"
 511     # Optimize for sane and common cases (but not things like "*::File")
 512   ) {
 513     $self->{'dir_prefix'} = join "::", $limit_glob =~ m/^(?:\w+::)+/sg;
 514     $self->{'verbose'} and print " and setting dir_prefix to $self->{'dir_prefix'}\n";
 515   }
 516
 517   return $limit_re;
 518 }
 519
 520 #==========================================================================
 521
 522 # contribution mostly from Tim Jenness <t.jenness@jach.hawaii.edu>
 523
 524 sub find {
 525   my($self, $pod, @search_dirs) = @_;
 526   $self = $self->new unless ref $self; # tolerate being a class method
 527
 528   # Check usage
 529   Carp::carp 'Usage: \$self->find($podname, ...)'
 530    unless defined $pod and length $pod;
 531
 532   my $verbose = $self->verbose;
 533
 534   # Split on :: and then join the name together using File::Spec
 535   my @parts = split /::/, $pod;
 536   $verbose and print "Chomping {$pod} => {@parts}\n";
 537
 538   #@search_dirs = File::Spec->curdir unless @search_dirs;
 539
 540   if( $self->inc ) {
 541     if( $^O eq 'MacOS' ) {
 542       push @search_dirs, $self->_mac_whammy(@INC);
 543     } else {
 544       push @search_dirs,                    @INC;
 545     }
 546
 547     # Add location of pod documentation for perl man pages (eg perlfunc)
 548     # This is a pod directory in the private install tree
 549     #my $perlpoddir = File::Spec->catdir($Config::Config{'installprivlib'},
 550     #                                   'pod');
 551     #push (@search_dirs, $perlpoddir)
 552     #  if -d $perlpoddir;
 553
 554     # Add location of binaries such as pod2text:
 555     push @search_dirs, $Config::Config{'scriptdir'};
 556      # and if that's undef or q{} or nonexistent, we just ignore it later
 557   }
 558
 559   my %seen_dir;
 560  Dir:
 561   foreach my $dir ( @search_dirs ) {
 562     next unless defined $dir and length $dir;
 563     next if $seen_dir{$dir};
 564     $seen_dir{$dir} = 1;
 565     unless(-d $dir) {
 566       print "Directory $dir does not exist\n" if $verbose;
 567       next Dir;
 568     }
 569
 570     print "Looking in directory $dir\n" if $verbose;
 571     my $fullname = File::Spec->catfile( $dir, @parts );
 572     print "Filename is now $fullname\n" if $verbose;
 573
 574     foreach my $ext ('', '.pod', '.pm', '.pl') {   # possible extensions
 575       my $fullext = $fullname . $ext;
 576       if( -f $fullext  and  $self->contains_pod( $fullext ) ){
 577         print "FOUND: $fullext\n" if $verbose;
 578         return $fullext;
 579       }
 580     }
 581     my $subdir = File::Spec->catdir($dir,'pod');
 582     if(-d $subdir) {  # slip in the ./pod dir too
 583       $verbose and print "Noticing $subdir and stopping there...\n";
 584       $dir = $subdir;
 585       redo Dir;
 586     }
 587   }
 588
 589   return undef;
 590 }
 591
 592 #==========================================================================
 593
 594 sub contains_pod {
 595   my($self, $file) = @_;
 596   my $verbose = $self->{'verbose'};
 597
 598   # check for one line of POD
 599   $verbose > 1 and print " Scanning $file for pod...\n";
 600   unless( open(MAYBEPOD,"<$file") ) {
 601     print "Error: $file is unreadable: $!\n";
 602     return undef;
 603   }
 604
 605   sleep($SLEEPY - 1) if $SLEEPY;
 606    # avoid totally hogging the processor on OSs with poor process control
 607
 608   local $_;
 609   while( <MAYBEPOD> ) {
 610     if(m/^=(head\d|pod|over|item)\b/s) {
 611       close(MAYBEPOD) || die "Bizarre error closing $file: $!\nAborting";
 612       chomp;
 613       $verbose > 1 and print "  Found some pod ($_) in $file\n";
 614       return 1;
 615     }
 616   }
 617   close(MAYBEPOD) || die "Bizarre error closing $file: $!\nAborting";
 618   $verbose > 1 and print "  No POD in $file, skipping.\n";
 619   return 0;
 620 }
 621
 622 #==========================================================================
 623
 624 sub _accessorize {  # A simple-minded method-maker
 625   shift;
 626   no strict 'refs';
 627   foreach my $attrname (@_) {
 628     *{caller() . '::' . $attrname} = sub {
 629       use strict;
 630       $Carp::CarpLevel = 1,  Carp::croak(
 631        "Accessor usage: \$obj->$attrname() or \$obj->$attrname(\$new_value)"
 632       ) unless (@_ == 1 or @_ == 2) and ref $_[0];
 633
 634       # Read access:
 635       return $_[0]->{$attrname} if @_ == 1;
 636
 637       # Write access:
 638       $_[0]->{$attrname} = $_[1];
 639       return $_[0]; # RETURNS MYSELF!
 640     };
 641   }
 642   # Ya know, they say accessories make the ensemble!
 643   return;
 644 }
 645
 646 #==========================================================================
 647 sub _state_as_string {
 648   my $self = $_[0];
 649   return '' unless ref $self;
 650   my @out = "{\n  # State of $self ...\n";
 651   foreach my $k (sort keys %$self) {
 652     push @out, "  ", _esc($k), " => ", _esc($self->{$k}), ",\n";
 653   }
 654   push @out, "}\n";
 655   my $x = join '', @out;
 656   $x =~ s/^/#/mg;
 657   return $x;
 658 }
 659
 660 sub _esc {
 661   my $in = $_[0];
 662   return 'undef' unless defined $in;
 663   $in =~
 664     s<([^\x20\x21\x23\x27-\x3F\x41-\x5B\x5D-\x7E])>
 665      <'\\x'.(unpack("H2",$1))>eg;
 666   return qq{"$in"};
 667 }
 668
 669 #==========================================================================
 670
 671 run() unless caller;  # run if "perl whatever/Search.pm"
 672
 673 1;
 674
 675 #==========================================================================
 676
 677 __END__
 678
 679
 680 =head1 NAME
 681
 682 Pod::Simple::Search - find POD documents in directory trees
 683
 684 =head1 SYNOPSIS
 685
 686   use Pod::Simple::Search;
 687   my $name2path = Pod::Simple::Search->new->limit_glob('LWP::*')->survey;
 688   print "Looky see what I found: ",
 689     join(' ', sort keys %$name2path), "\n";
 690
 691   print "LWPUA docs = ",
 692     Pod::Simple::Search->new->find('LWP::UserAgent') || "?",
 693     "\n";
 694
 695 =head1 DESCRIPTION
 696
 697 B<Pod::Simple::Search> is a class that you use for running searches
 698 for Pod files.  An object of this class has several attributes
 699 (mostly options for controlling search options), and some methods
 700 for searching based on those attributes.
 701
 702 The way to use this class is to make a new object of this class,
 703 set any options, and then call one of the search options
 704 (probably C<survey> or C<find>).  The sections below discuss the
 705 syntaxes for doing all that.
 706
 707
 708 =head1 CONSTRUCTOR
 709
 710 This class provides the one constructor, called C<new>.
 711 It takes no parameters:
 712
 713   use Pod::Simple::Search;
 714   my $search = Pod::Simple::Search->new;
 715
 716 =head1 ACCESSORS
 717
 718 This class defines several methods for setting (and, occasionally,
 719 reading) the contents of an object. With two exceptions (discussed at
 720 the end of this section), these attributes are just for controlling the
 721 way searches are carried out.
 722
 723 Note that each of these return C<$self> when you call them as
 724 C<< $self->I<whatever(value)> >>.  That's so that you can chain
 725 together set-attribute calls like this:
 726
 727   my $name2path =
 728     Pod::Simple::Search->new
 729     -> inc(0) -> verbose(1) -> callback(\&blab)
 730     ->survey(@there);
 731
 732 ...which works exactly as if you'd done this:
 733
 734   my $search = Pod::Simple::Search->new;
 735   $search->inc(0);
 736   $search->verbose(1);
 737   $search->callback(\&blab);
 738   my $name2path = $search->survey(@there);
 739
 740 =over
 741
 742 =item $search->inc( I<true-or-false> );
 743
 744 This attribute, if set to a true value, means that searches should
 745 implicitly add perl's I<@INC> paths. This
 746 automatically considers paths specified in the C<PERL5LIB> environment
 747 as this is prepended to I<@INC> by the Perl interpreter itself.
 748 This attribute's default value is B<TRUE>.  If you want to search
 749 only specific directories, set $self->inc(0) before calling
 750 $inc->survey or $inc->find.
 751
 752
 753 =item $search->verbose( I<nonnegative-number> );
 754
 755 This attribute, if set to a nonzero positive value, will make searches output
 756 (via C<warn>) notes about what they're doing as they do it.
 757 This option may be useful for debugging a pod-related module.
 758 This attribute's default value is zero, meaning that no C<warn> messages
 759 are produced.  (Setting verbose to 1 turns on some messages, and setting
 760 it to 2 turns on even more messages, i.e., makes the following search(es)
 761 even more verbose than 1 would make them.)
 762
 763
 764 =item $search->limit_glob( I<some-glob-string> );
 765
 766 This option means that you want to limit the results just to items whose
 767 podnames match the given glob/wildcard expression. For example, you
 768 might limit your search to just "LWP::*", to search only for modules
 769 starting with "LWP::*" (but not including the module "LWP" itself); or
 770 you might limit your search to "LW*" to see only modules whose (full)
 771 names begin with "LW"; or you might search for "*Find*" to search for
 772 all modules with "Find" somewhere in their full name. (You can also use
 773 "?" in a glob expression; so "DB?" will match "DBI" and "DBD".)
 774
 775
 776 =item $search->callback( I<\&some_routine> );
 777
 778 This attribute means that every time this search sees a matching
 779 Pod file, it should call this callback routine.  The routine is called
 780 with two parameters: the current file's filespec, and its pod name.
 781 (For example: C<("/etc/perljunk/File/Crunk.pm", "File::Crunk")> would
 782 be in C<@_>.)
 783
 784 The callback routine's return value is not used for anything.
 785
 786 This attribute's default value is false, meaning that no callback
 787 is called.
 788
 789 =item $search->laborious( I<true-or-false> );
 790
 791 Unless you set this attribute to a true value, Pod::Search will
 792 apply Perl-specific heuristics to find the correct module PODs quickly.
 793 This attribute's default value is false.  You won't normally need
 794 to set this to true.
 795
 796 Specifically: Turning on this option will disable the heuristics for
 797 seeing only files with Perl-like extensions, omitting subdirectories
 798 that are numeric but do I<not> match the current Perl interpreter's
 799 version ID, suppressing F<site_perl> as a module hierarchy name, etc.
 800
 801
 802 =item $search->shadows( I<true-or-false> );
 803
 804 Unless you set this attribute to a true value, Pod::Simple::Search will
 805 consider only the first file of a given modulename as it looks thru the
 806 specified directories; that is, with this option off, if
 807 Pod::Simple::Search has seen a C<somepathdir/Foo/Bar.pm> already in this
 808 search, then it won't bother looking at a C<somelaterpathdir/Foo/Bar.pm>
 809 later on in that search, because that file is merely a "shadow". But if
 810 you turn on C<< $self->shadows(1) >>, then these "shadow" files are
 811 inspected too, and are noted in the pathname2podname return hash.
 812
 813 This attribute's default value is false; and normally you won't
 814 need to turn it on.
 815
 816
 817 =item $search->limit_re( I<some-regxp> );
 818
 819 Setting this attribute (to a value that's a regexp) means that you want
 820 to limit the results just to items whose podnames match the given
 821 regexp. Normally this option is not needed, and the more efficient
 822 C<limit_glob> attribute is used instead.
 823
 824
 825 =item $search->dir_prefix( I<some-string-value> );
 826
 827 Setting this attribute to a string value means that the searches should
 828 begin in the specified subdirectory name (like "Pod" or "File::Find",
 829 also expressable as "File/Find"). For example, the search option
 830 C<< $search->limit_glob("File::Find::R*") >>
 831 is the same as the combination of the search options
 832 C<< $search->limit_re("^File::Find::R") -> dir_prefix("File::Find") >>.
 833
 834 Normally you don't need to know about the C<dir_prefix> option, but I
 835 include it in case it might prove useful for someone somewhere.
 836
 837 (Implementationally, searching with limit_glob ends up setting limit_re
 838 and usually dir_prefix.)
 839
 840
 841 =item $search->progress( I<some-progress-object> );
 842
 843 If you set a value for this attribute, the value is expected
 844 to be an object (probably of a class that you define) that has a
 845 C<reach> method and a C<done> method.  This is meant for reporting
 846 progress during the search, if you don't want to use a simple
 847 callback.
 848
 849 Normally you don't need to know about the C<progress> option, but I
 850 include it in case it might prove useful for someone somewhere.
 851
 852 While a search is in progress, the progress object's C<reach> and
 853 C<done> methods are called like this:
 854
 855   # Every time a file is being scanned for pod:
 856   $progress->reach($count, "Scanning $file");   ++$count;
 857
 858   # And then at the end of the search:
 859   $progress->done("Noted $count Pod files total");
 860
 861 Internally, we often set this to an object of class
 862 Pod::Simple::Progress.  That class is probably undocumented,
 863 but you may wish to look at its source.
 864
 865
 866 =item $name2path = $self->name2path;
 867
 868 This attribute is not a search parameter, but is used to report the
 869 result of C<survey> method, as discussed in the next section.
 870
 871 =item $path2name = $self->path2name;
 872
 873 This attribute is not a search parameter, but is used to report the
 874 result of C<survey> method, as discussed in the next section.
 875
 876 =back
 877
 878 =head1 MAIN SEARCH METHODS
 879
 880 Once you've actually set any options you want (if any), you can go
 881 ahead and use the following methods to search for Pod files
 882 in particular ways.
 883
 884
 885 =head2 C<< $search->survey( @directories ) >>
 886
 887 The method C<survey> searches for POD documents in a given set of
 888 files and/or directories.  This runs the search according to the various
 889 options set by the accessors above.  (For example, if the C<inc> attribute
 890 is on, as it is by default, then the perl @INC directories are implicitly
 891 added to the list of directories (if any) that you specify.)
 892
 893 The return value of C<survey> is two hashes:
 894
 895 =over
 896
 897 =item C<name2path>
 898
 899 A hash that maps from each pod-name to the filespec (like
 900 "Stuff::Thing" => "/whatever/plib/Stuff/Thing.pm")
 901
 902 =item C<path2name>
 903
 904 A hash that maps from each Pod filespec to its pod-name (like
 905 "/whatever/plib/Stuff/Thing.pm" => "Stuff::Thing")
 906
 907 =back
 908
 909 Besides saving these hashes as the hashref attributes
 910 C<name2path> and C<path2name>, calling this function also returns
 911 these hashrefs.  In list context, the return value of
 912 C<< $search->survey >> is the list C<(\%name2path, \%path2name)>.
 913 In scalar context, the return value is C<\%name2path>.
 914 Or you can just call this in void context.
 915
 916 Regardless of calling context, calling C<survey> saves
 917 its results in its C<name2path> and C<path2name> attributes.
 918
 919 E.g., when searching in F<$HOME/perl5lib>, the file
 920 F<$HOME/perl5lib/MyModule.pm> would get the POD name I<MyModule>,
 921 whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be
 922 I<Myclass::Subclass>. The name information can be used for POD
 923 translators.
 924
 925 Only text files containing at least one valid POD command are found.
 926
 927 In verbose mode, a warning is printed if shadows are found (i.e., more
 928 than one POD file with the same POD name is found, e.g. F<CPAN.pm> in
 929 different directories).  This usually indicates duplicate occurrences of
 930 modules in the I<@INC> search path, which is occasionally inadvertent
 931 (but is often simply a case of a user's path dir having a more recent
 932 version than the system's general path dirs in general.)
 933
 934 The options to this argument is a list of either directories that are
 935 searched recursively, or files.  (Usually you wouldn't specify files,
 936 but just dirs.)  Or you can just specify an empty-list, as in
 937 $name2path; with the
 938 C<inc> option on, as it is by default, teh
 939
 940 The POD names of files are the plain basenames with any Perl-like
 941 extension (.pm, .pl, .pod) stripped, and path separators replaced by
 942 C<::>'s.
 943
 944 Calling Pod::Simple::Search->search(...) is short for
 945 Pod::Simple::Search->new->search(...).  That is, a throwaway object
 946 with default attribute values is used.
 947
 948
 949 =head2 C<< $search->simplify_name( $str ) >>
 950
 951 The method B<simplify_name> is equivalent to B<basename>, but also
 952 strips Perl-like extensions (.pm, .pl, .pod) and extensions like
 953 F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively.
 954
 955
 956 =head2 C<< $search->find( $pod ) >>
 957
 958 =head2 C<< $search->find( $pod, @search_dirs ) >>
 959
 960 Returns the location of a Pod file, given a Pod/module/script name
 961 (like "Foo::Bar" or "perlvar" or "perldoc"), and an idea of
 962 what files/directories to look in.
 963 It searches according to the various options set by the accessors above.
 964 (For example, if the C<inc> attribute is on, as it is by default, then
 965 the perl @INC directories are implicitly added to the list of
 966 directories (if any) that you specify.)
 967
 968 This returns the full path of the first occurrence to the file.
 969 Package names (eg 'A::B') are automatically converted to directory
 970 names in the selected directory.  Additionally, '.pm', '.pl' and '.pod'
 971 are automatically appended to the search as required.
 972 (So, for example, under Unix, "A::B" is converted to "somedir/A/B.pm",
 973 "somedir/A/B.pod", or "somedir/A/B.pl", as appropriate.)
 974
 975 If no such Pod file is found, this method returns undef.
 976
 977 If any of the given search directories contains a F<pod/> subdirectory,
 978 then it is searched.  (That's how we manage to find F<perlfunc>,
 979 for example, which is usually in F<pod/perlfunc> in most Perl dists.)
 980
 981 The C<verbose> and C<inc> attributes influence the behavior of this
 982 search; notably, C<inc>, if true, adds @INC I<and also
 983 $Config::Config{'scriptdir'}> to the list of directories to search.
 984
 985 It is common to simply say C<< $filename = Pod::Simple::Search-> new
 986 ->find("perlvar") >> so that just the @INC (well, and scriptdir)
 987 directories are searched.  (This happens because the C<inc>
 988 attribute is true by default.)
 989
 990 Calling Pod::Simple::Search->find(...) is short for
 991 Pod::Simple::Search->new->find(...).  That is, a throwaway object
 992 with default attribute values is used.
 993
 994
 995 =head2 C<< $self->contains_pod( $file ) >>
 996
 997 Returns true if the supplied filename (not POD module) contains some Pod
 998 documentation.
 999
1000
1001 =head1 AUTHOR
1002
1003 Sean M. Burke E<lt>sburke@cpan.orgE<gt>
1004 borrowed code from
1005 Marek Rouchal's Pod::Find, which in turn
1006 heavily borrowed code from Nick Ing-Simmons' PodToHtml.
1007
1008 Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt> provided
1009 C<find> and C<contains_pod> to Pod::Find.
1010
1011 =head1 SEE ALSO
1012
1013 L<Pod::Simple>, L<Pod::Perldoc>
1014
1015 =cut
1016