package File::FindDir;
require 5.000;
require Exporter;
use Config;
require Cwd;
require File::Basename;

=head1 NAME

finddir - traverse a file tree, one directory at a time.

=head1 SYNOPSIS

    use File::FindDir;
    finddir("H",\&wanted,@ARGV);
    sub wanted { 
      my($level,$dir,$name_array,$dir_hash,$file_hash,$link_hash) = @_;
    }

=head1 DESCRIPTION

The first argument to finddir() specifies the type of recursion desired.
   "L" = logical; follow symlinks to unvisited directories,
   "P" = physical; ignore symlinks that point to directories,
   "H" = half-logical; follow symlinks given as argumments,
   "" or "0" or blank = no recursion.

The wanted() function does whatever processing you want.
It gets called with the following arguments:

   $level = recursion depth.  Starts at 0, when $name_array = \@_.
   $dir = string with the name of the current directory.
   $name_array = reference to an array with the names in the
	directory, excluding '.' and '..'.
   $dir_hash = reference to a hash of directory names.  The hash
	entries are arrays from lstat().
   $file_hash = reference to a hash of non-directory names.  The hash
	entries are arrays from lstat() with a file type appended.
   $link_hash = reference to a hash of symlink targets.  The hash
	entries are arrays from stat() with a file type appended.

To follow symlinks that point to directories, wanted() need only
copy the entry from $file_hash to the $dir_hash.  But then wanted() is
responsible for detecting and avoiding infinite loops.

Unwanted subdirectories can be pruned by deleting their entries
from the $dir_hash.  For example:

    delete $dir_hash->{'.xvpics'};

When wanted() returns, the subdirectories remaining in the $dir_hash will
be processed in alphabetical order.  Set $File::FindDir:sort_dirs = 0
to bypass the sort (processing the subdirectories in random order).

=cut

@ISA = qw(Exporter);
@EXPORT = qw(finddir);

sub finddir {
    my $recursion = shift;	# "P" = physical, "L" = Logical, "H" = Half
    die("finddir: first argument '$recursion' must be one of H, L, P or 0\n")
	unless $recursion =~ /^[HLP 0]$/;
    my $wanted = shift;
    my $cwd = Cwd::cwd();
    %seen = ();				# List of directories already seen
    &do_dir(0,$recursion,$wanted,$cwd,@_);
}

sub do_dir {
    my $level = shift;
    my $recursion = shift;
    my $wanted = shift;
    my $dir = shift;
    my(%dirs,%files,%links,$type);
    foreach $_ ( @_) {
        s%/$%%;
	my(@stat) = (($Is_VMS) ? stat($_) : lstat($_));
	(warn("Can't stat $_: $!\n"), next) unless @stat;
	if (-d _) {
	    $type = "d";
	    push(@stat,$type);
	    $dirs{$_} = \@stat;
	} else {
	    ((-f _) and ($type = "f")) or
	    ((-l _) and ($type = "l")) or
	    ((-p _) and ($type = "p")) or
	    ((-S _) and ($type = "S")) or
	    ((-b _) and ($type = "b")) or
	    ((-c _) and ($type = "c")) or
	    ($type = $stat[2] >> 12);	# 0xD = "door" on Solaris-2.6
	    push(@stat,$type);
	    $files{$_} = \@stat;
	}
	if ($type eq "l") {		# For symlinks, look at the target
	    @stat = stat($_);
	    ((-d _) and ($type = "d")) or
	    ((-f _) and ($type = "f")) or
	    ((-p _) and ($type = "p")) or
	    ((-S _) and ($type = "S")) or
	    ((-b _) and ($type = "b")) or
	    ((-c _) and ($type = "c")) or
	    ($type = $stat[2] >> 12);	# 0xD = "door" on Solaris-2.6
	    push(@stat,$type);
	    $links{$_} = \@stat;
	    if ($type eq "d" and	# Symlink to a directory
		(($level == 0 and $recursion eq "H") or ($recursion eq "L"))
	    ) {
		$dirs{$_} = $links{$_};	# Treat it as a directory
		delete $files{$_};	# and not as a symlink
	    }		
	}
    }

    # To prune a subdirectory, just delete its entry from %dirs.
    # To follow a symlink to a directory, add its entry to %dirs.

    &$wanted($level,$dir,\@_,\%dirs,\%files,\%links);		# Callback
    return if $level > 0 and not $recursion;

    foreach $_ ( $sort_dirs ? sort keys %dirs : keys %dirs ) {
	@stat = @{$dirs{$_}};
	next if $seen{"$stat[0]:$stat[1]"}++;	# Device and inode combination
	my($subdir) = m%^/% ? $_ : "$dir/$_";
	$subdir =~ s/\.dir$// if $Is_VMS;
	$subdir =~ s/\\dir$// if $Is_NT;
	if (chdir $_) {
	    opendir(DIR,'.') || (warn "Can't open $subdir: $!\n", return);
	    my(@names) = readdir(DIR);
	    closedir(DIR);
	    shift(@names) if $names[0] eq "." or $names[0] eq "..";
	    shift(@names) if $names[0] eq ".." or $names[0] eq ".";
	    &do_dir($level+1,$recursion,$wanted,$subdir,@names);
	} else {
	    warn "Can't cd to $subdir: $!\n";
	}
	chdir $dir or warn "Can't cd back to $dir: $!\n";
    }
}

$_ = $Is_NT if $^W;	# Keep "perl -w" happy
$sort_dirs = 1;		# Setting this to zero is slightly quicker

1;