package File::MultiFind;
require 5.000;
use strict;
require Exporter;
require Config;
require Cwd;
require File::Basename;
require Carp;

=head1 NAME

multifind - traverse several file trees in parallel

=head1 SYNOPSIS

    use File::MultiFind;
    multifind(\&wanted, '/foo','/bar');
    sub wanted { ... }
    
=head1 DESCRIPTION

The wanted() function does whatever verifications you want.
@File::MultiFind::dirs contains the current directory names, and $_
the current filename within those directories.
@File::MultiFind::alldirs is similar to @File::MultiFind::dirs, but a
directory name of C<undef> indicates that a directory does not exist
in one of the trees.  $File::MultiFind::names[$i] will contains
C<"$File::MultiFind::dirs[$i]/$_"> (note that some of these may not
exist as files).  You are chdir()'d to $File::MultiFind::dirs[0] when
the function is called.  The function may set $File::MultiFind::prune
to prune the tree.

Set the variable $File::Find::dont_use_nlink if you're using AFS,
since AFS cheats.

=head1 BUGS

This description is currently incomplete and possily incorrect.

=cut

use vars qw( @ISA @EXPORT $VERSION $dont_use_nlink $Is_VMS $prune );
use vars qw( @alldirs @dirs @allnames @names @allroots @roots );
use vars qw( $relative $directories );

@ISA = qw(Exporter);
@EXPORT = qw( multifind prune );

$VERSION = '0.80';

sub all_def (@) { local ($_);  ! scalar(grep( !defined($_), @_ )) }
sub all     (@) { local ($_);  ! scalar(grep( !defined($_) || !$_, @_ )) }
sub any_def (@) { local ($_);    scalar(grep(  defined($_), @_ )) }
sub any     (@) { local ($_);    scalar(grep(  defined($_) &&  $_, @_ )) }

package File::MultiFind::Tree;

use vars qw( $descend_top_links $descend_links );
$descend_top_links = 0;  $descend_links = 0;

use vars '$debug';
$debug=0;

sub new {
  my $class = shift;
  my $root = join('',@_);
  print STDERR "T create   $root, $class\n" if $debug;
  my $self = bless {'root' => $root, 'relative' => '', 'name' => $root},$class;
  $self->_stat($descend_links || $descend_top_links);
}
sub DESTROY {
  my $self = shift;
  print STDERR "T destroy  $self->{'root'}, ".ref($self)."\n" if $debug;
}
sub dup {
  my $self = shift;
  my $class = ref($self);
  print STDERR "T dupli    $self->{'root'}, $class\n" if $debug;
  bless { %$self },$class;
}

sub relative {
  my $self = shift;
  $self->{'relative'} = shift;
  $self->{'name'} = "$self->{'root'}$self->{'relative'}";
  delete $self->{'stat'};  delete $self->{'dir'};
  $self;
}
sub remove_trailing {
  my ($self, $Is_VMS) = @_;
  if ($self->{'relative'}) {
    $self->{'relative'} =~ s,/$,,;
    $self->{'relative'} =~ s/\.dir$// if $Is_VMS;
  } else {
    $self->{'root'} =~ s,/$,,;
    $self->{'root'} =~ s/\.dir$// if $Is_VMS;
  }
  $self->{'name'} = "$self->{'root'}$self->{'relative'}";
  #delete $self->{'stat'};
  #delete $self->{'dir'};
  $self;
}

sub _stat {
  my ($self, $rstat) = @_;
  return $self if $self->{'stat'};
  print STDERR "T stat     $self->{'root'}, $self->{'relative'}\n" if $debug;
  my @stat = $rstat ? stat($self->{'name'}) : lstat($self->{'name'});
  @stat || (warn "Can't (l)stat $self->{'name'}: $!\n", return undef);
  my $stat = $self->{'stat'} = { 'is_dir'     => -d _,
				 'is_symlink' => $rstat ? 0 : -l _,
				 'is_fifo'    => -p _,  'is_socket'  => -S _,
				 'is_blkdev'  => -b _,  'is_chrdev'  => -c _,
				 'is_setuid'  => -u _,  'is_setgid'  => -g _,
				 'is_sticky'  => -k _,  'size'       => -s _ };
  @$stat{'dev','ino','mode','nlink','uid','gid','rdev','size',
	 'atime','mtime','ctime','blksize','blocks'} = @stat;
  $stat->{'subdirs'} = $stat->{'nlink'} - 2;
  $self;
}

sub is_dir {
  my $self = shift;
  print STDERR "T is_dir   $self->{'root'}, $self->{'relative'}\n" if $debug;
  $self->_stat($descend_links) && $self->{'stat'}->{'is_dir'};
}
sub filename { join("/", shift->{'name'}, @_) }
sub root     { $_[0]->{'root'} }

sub _readdir {
  my $self = shift;
  return $self if $self->{'dir'};
  print STDERR "T readdir  $self->{'root'}, $self->{'relative'}\n" if $debug;
  opendir(DIR, $self->{'name'})
    || (warn "Can't open $self->{'name'}: $!\n", return undef);
  $self->{'dir'} = [ sort readdir(DIR) ];
  closedir(DIR);
}

sub first_entry {
  my $self = shift;
  $self->_readdir || return undef;
  print STDERR "T first_e  $self->{'root'}, $self->{'dir'}->[0]\n" if $debug;
  $self->{'dir'}->[0];
}
sub skip_entry {
  my ($self, $entry) = @_;
  $self->_readdir || return undef;
  print STDERR "T skip_e   $self->{'root'}, $self->{'dir'}->[0]<=>$entry\n"
    if $debug;
  @{$self->{'dir'}} && ($self->{'dir'}->[0] eq $entry) && shift(@{$self->{'dir'}});
}
sub n_entries {
  my ($self, $entry) = @_;
  $self->_readdir || return undef;
  print STDERR "T n_entr   $self->{'root'}, $#{$self->{'dir'}}\n" if $debug;
  scalar(@{$self->{'dir'}});
}

sub nlink_subdirs {
  $_[0]->_stat || return 0;
  print STDERR "T subdirs  $_[0]->{'name'}, $_[0]->{'stat'}->{'subdirs'}\n"
    if $debug;
  $_[0]->{'stat'}->{'subdirs'};
}
sub decrement_nlink_subdirs {
  $_[0]->_stat || return 0;
  print STDERR "T dec_sub  $_[0]->{'name'}, $_[0]->{'stat'}->{'subdirs'}\n"
    if $debug;
  --$_[0]->{'stat'}->{'subdirs'};
}

sub chdir {
  my $self = shift;
  print STDERR "T chdir    $self->{'root'}, $self->{'relative'}\n" if $debug;
  chdir($_->{'name'}) || (warn "Can't cd to $_->{'name'}: $!\n", return 0);
}

package File::MultiFind;

sub prune () { $prune = 1; }

sub multifind {
  my $wanted = shift;
  my (@topstats, @topdirs);
  local (@alldirs, @dirs, @allnames, @names, @allroots, @roots, $_);

  my $cwd = Cwd::cwd();
  
  @topstats = map File::MultiFind::Tree->new($_), @_;

  # BAD KLUDGE: cd to $topstats[0]; if we can't, then $topstats[1]; etc.
  grep ($_ && $_->chdir, reverse @topstats);

  deal_with_files($wanted, '', '', @topstats);
  deal_with_dirs ($wanted, '', '', @topstats);

  chdir $cwd;
}

sub multifinddir {
  my ($wanted, $relative, @trees) = @_;
  my ($entry, @matching);
  # some variables have been localized in multifind()

  # if (!$dont_use_nlink && all map !$_->nlink_subdirs, @trees) {
  if (0) {
  } else {                    # This dir has subdirectories.
    while (any map($_ && $_->n_entries, @trees)) {

      # find the next entry; we proceed alphabetically.
      $entry = (sort grep $_, map($_ && $_->first_entry, @trees))[0];

      # find all trees which actually contain that entry (also, skip entries)
      @matching = map ($_ && $_->skip_entry($entry) && $_, @trees);

      next if ($entry eq '.') || ($entry eq '..');

      if ($dont_use_nlink || any map $_->nlink_subdirs, @matching) {

	# use a copy of all objects, so we don't destroy state
	my @subentries = map ($_ && ($_=$_->dup)->relative("$relative/$entry"),
			      @matching);

	deal_with_files($wanted, $entry, $relative, @subentries);
	deal_with_dirs ($wanted, $entry, $relative, @subentries);
      }
    }
  }
}

sub deal_with_dirs {
  my ($wanted, $entry, $old_relative, @maybedirs) = @_;
  local ($relative) = $entry ? "$old_relative/$entry" : $old_relative;
  local ($directories) = 1;

  # select real directories
  @maybedirs = map ($_ && $_->is_dir && $_, @maybedirs);
	
  if (any @maybedirs) {
    my $cwd = Cwd::cwd();

    # recurse...
    @allnames = @alldirs = map  $_ && $_->filename, @maybedirs;
    @names =    @dirs =    grep $_, @alldirs;
    @allroots = map  $_ && $_->root, @maybedirs;
    @roots = grep $_, @allroots;
    $_ = $entry || '.';
    $prune = 0;
    &$wanted();

    # eliminate directories we can't chdir to (leaving us in the first)
    @maybedirs = reverse map ($_ && $_->chdir && $_, reverse @maybedirs);

    if (!$prune && any @maybedirs) {
      map ($_ && $_->remove_trailing($Is_VMS), @maybedirs);
      &multifinddir($wanted, $relative, @maybedirs);
    }

    chdir $cwd;
  }
}

sub deal_with_files {
  my ($wanted, $entry, $old_relative, @maybefiles) = @_;
  local ($relative) = $entry ? "$old_relative/$entry" : $old_relative;
  local ($directories) = 0;

  # select real directories
  @maybefiles = map ($_ && !($_->is_dir) && $_, @maybefiles);

  if (any @maybefiles) {
    @allnames = map  $_ && $_->filename, @maybefiles;
    @names =    grep $_, @allnames;
    @allroots = map  $_ && $_->root, @maybefiles;
    @roots = grep $_, @allroots;
    @alldirs = map $_ && "$_$old_relative", @allroots;
    @dirs = grep $_, @alldirs;
    $_ = $entry;
    &$wanted();
  }
}

# Set dont_use_nlink in your hint file if your system's stat doesn't
# report the number of links in a directory as an indication
# of the number of files.
# See, e.g. hints/machten.sh for MachTen 2.2.
$dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});

# These are hard-coded for now, but may move to hint files.
if ($Config::Config{'osname'} eq 'VMS') {
  $Is_VMS = 1;
  $dont_use_nlink = 1;
}

$dont_use_nlink = 1 if $Config::Config{'osname'} =~ m:^os/?2$:i ;
$dont_use_nlink = 1 if $Config::Config{'osname'} =~ m:^mswin32$:i ;

$dont_use_nlink = 1 if $Config::Config{'afs'} eq 'true';

1;
