view release on metacpan or  search on metacpan

lib/Pod/Simple/Search.pm  view on Meta::CPAN

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', 'is_case_insensitive'
);
#==========================================================================

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);
  $self->is_case_insensitive(-e uc __FILE__ && -e lc __FILE__);
  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, $is_case_insensitive) =
    map scalar($self->$_()),
     qw(laborious verbose shadows limit_re callback progress
        path2name name2path recurse ciseen is_case_insensitive);
  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 } };