find.pm

UNIX下perl实现代码

                warn "Couldn't chdir $abs_dir: $!\n";
                next Proc_Top_Item;
            }

            $name = $abs_dir . $_;

            { &$wanted_callback }; # protect against wild "next"

        }

        $no_chdir or chdir $cwd_untainted;
    }
}

# API:
#  $wanted
#  $p_dir :  "parent directory"
#  $nlink :  what came back from the stat
# preconditions:
#  chdir (if not no_chdir) to dir

sub _find_dir($$$) {
    my ($wanted, $p_dir, $nlink) = @_;
    my ($CdLvl,$Level) = (0,0);
    my @Stack;
    my @filenames;
    my ($subcount,$sub_nlink);
    my $SE= [];
    my $dir_name= $p_dir;
    my $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
    my $dir_rel= '.';      # directory name relative to current directory

    local ($dir, $name, $prune, *DIR);
     
    unless ($no_chdir or $p_dir eq '.') {
	my $udir = $p_dir;
	if ($untaint) {
	    $udir = $1 if $p_dir =~ m|$untaint_pat|;
	    unless (defined $udir) {
		if ($untaint_skip == 0) {
		    die "directory $p_dir is still tainted";
		}
		else {
		    return;
		}
	    }
	}
	unless (chdir $udir) {
	    warn "Can't cd to $udir: $!\n";
	    return;
	}
    }
    
    push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;

    while (defined $SE) {
	unless ($bydepth) {
            $dir= $p_dir;
            $name= $dir_name;
            $_= ($no_chdir ? $dir_name : $dir_rel );
	    # prune may happen here
            $prune= 0;
            { &$wanted_callback }; 	# protect against wild "next"
            next if $prune;
	}
      
	# change to that directory
	unless ($no_chdir or $dir_rel eq '.') {
	    my $udir= $dir_rel;
	    if ($untaint) {
		$udir = $1 if $dir_rel =~ m|$untaint_pat|;
		unless (defined $udir) {
		    if ($untaint_skip == 0) {
			die "directory ("
			    . ($p_dir ne '/' ? $p_dir : '')
			    . "/) $dir_rel is still tainted";
		    }
		}
	    }
	    unless (chdir $udir) {
		warn "Can't cd to ("
		    . ($p_dir ne '/' ? $p_dir : '')
		    . "/) $udir : $!\n";
		next;
	    }
	    $CdLvl++;
	}

	$dir= $dir_name;

	# Get the list of files in the current directory.
	unless (opendir DIR, ($no_chdir ? $dir_name : '.')) {
	    warn "Can't opendir($dir_name): $!\n";
	    next;
	}
	@filenames = readdir DIR;
	closedir(DIR);
	@filenames = &$pre_process(@filenames) if $pre_process;
	push @Stack,[$CdLvl,$dir_name,"",-2]   if $post_process;

	if ($nlink == 2 && !$avoid_nlink) {
	    # This dir has no subdirectories.
	    for my $FN (@filenames) {
		next if $FN =~ /^\.{1,2}\z/;
		
		$name = $dir_pref . $FN;
		$_ = ($no_chdir ? $name : $FN);
		{ &$wanted_callback }; # protect against wild "next"
	    }

	}
	else {
	    # This dir has subdirectories.
	    $subcount = $nlink - 2;

	    for my $FN (@filenames) {
		next if $FN =~ /^\.{1,2}\z/;
		if ($subcount > 0 || $avoid_nlink) {
		    # Seen all the subdirs?
		    # check for directoriness.
		    # stat is faster for a file in the current directory
		    $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3];

		    if (-d _) {
			--$subcount;
			$FN =~ s/\.dir\z// if $Is_VMS;
			push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink];
		    }
		    else {
			$name = $dir_pref . $FN;
			$_= ($no_chdir ? $name : $FN);
			{ &$wanted_callback }; # protect against wild "next"
		    }
		}
		else {
		    $name = $dir_pref . $FN;
		    $_= ($no_chdir ? $name : $FN);
		    { &$wanted_callback }; # protect against wild "next"
		}
	    }
	}
    }
    continue {
	while ( defined ($SE = pop @Stack) ) {
	    ($Level, $p_dir, $dir_rel, $nlink) = @$SE;
	    if ($CdLvl > $Level && !$no_chdir) {
                my $tmp = join('/',('..') x ($CdLvl-$Level));
                die "Can't cd to $dir_name" . $tmp
                    unless chdir ($tmp);
		$CdLvl = $Level;
	    }
	    $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
	    $dir_pref = "$dir_name/";
	    if ( $nlink == -2 ) {
		$name = $dir = $p_dir;
		$_ = ".";
		&$post_process;		# End-of-directory processing
            } elsif ( $nlink < 0 ) {  # must be finddepth, report dirname now
                $name = $dir_name;
                if ( substr($name,-2) eq '/.' ) {
                  $name =~ s|/\.$||;
                }
                $dir = $p_dir;
                $_ = ($no_chdir ? $dir_name : $dir_rel );
                if ( substr($_,-2) eq '/.' ) {
                  s|/\.$||;
                }
                { &$wanted_callback }; # protect against wild "next"
            } else {
                push @Stack,[$CdLvl,$p_dir,$dir_rel,-1]  if  $bydepth;
                last;
            }
	}
    }
}


# API:
#  $wanted
#  $dir_loc : absolute location of a dir
#  $p_dir   : "parent directory"
# preconditions:
#  chdir (if not no_chdir) to dir

sub _find_dir_symlnk($$$) {
    my ($wanted, $dir_loc, $p_dir) = @_;
    my @Stack;
    my @filenames;
    my $new_loc;
    my $pdir_loc = $dir_loc;
    my $SE = [];
    my $dir_name = $p_dir;
    my $dir_pref = ( $p_dir   eq '/' ? '/' : "$p_dir/" );
    my $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
    my $dir_rel = '.';		# directory name relative to current directory
    my $byd_flag;               # flag for pending stack entry if $bydepth

    local ($dir, $name, $fullname, $prune, *DIR);
    
    unless ($no_chdir or $p_dir eq '.') {
	my $udir = $dir_loc;
	if ($untaint) {
	    $udir = $1 if $dir_loc =~ m|$untaint_pat|;
	    unless (defined $udir) {
		if ($untaint_skip == 0) {
		    die "directory $dir_loc is still tainted";
		}
		else {
		    return;
		}
	    }
	}
	unless (chdir $udir) {
	    warn "Can't cd to $udir: $!\n";
	    return;
	}
    }

    push @Stack,[$dir_loc,$pdir_loc,$p_dir,$dir_rel,-1]  if  $bydepth;

    while (defined $SE) {

	unless ($bydepth) {
	    # change to parent directory
	    unless ($no_chdir) {
		my $udir = $pdir_loc;
		if ($untaint) {
		    $udir = $1 if $pdir_loc =~ m|$untaint_pat|;
		}
		unless (chdir $udir) {
		    warn "Can't cd to $udir: $!\n";
		    next;
		}
	    }
	    $dir= $p_dir;
            $name= $dir_name;
            $_= ($no_chdir ? $dir_name : $dir_rel );
            $fullname= $dir_loc;
	    # prune may happen here
            $prune= 0;
	    lstat($_); # make sure  file tests with '_' work
            { &$wanted_callback }; # protect against wild "next"
            next if  $prune;
	}

	# change to that directory
	unless ($no_chdir or $dir_rel eq '.') {
	    my $udir = $dir_loc;
	    if ($untaint) {
		$udir = $1 if $dir_loc =~ m|$untaint_pat|;
		unless (defined $udir ) {
		    if ($untaint_skip == 0) {
			die "directory $dir_loc is still tainted";
		    }
		    else {
			next;
		    }
		}
	    }
	    unless (chdir $udir) {
		warn "Can't cd to $udir: $!\n";
		next;
	    }
	}

	$dir = $dir_name;

	# Get the list of files in the current directory.
	unless (opendir DIR, ($no_chdir ? $dir_loc : '.')) {
	    warn "Can't opendir($dir_loc): $!\n";
	    next;
	}
	@filenames = readdir DIR;
	closedir(DIR);

	for my $FN (@filenames) {
	    next if $FN =~ /^\.{1,2}\z/;

	    # follow symbolic links / do an lstat
	    $new_loc = Follow_SymLink($loc_pref.$FN);

	    # ignore if invalid symlink
	    next unless defined $new_loc;
     
	    if (-d _) {
		push @Stack,[$new_loc,$dir_loc,$dir_name,$FN,1];
	    }
	    else {
		$fullname = $new_loc;
		$name = $dir_pref . $FN;
		$_ = ($no_chdir ? $name : $FN);
		{ &$wanted_callback }; # protect against wild "next"
	    }
	}

    }
    continue {
	while (defined($SE = pop @Stack)) {
	    ($dir_loc, $pdir_loc, $p_dir, $dir_rel, $byd_flag) = @$SE;
	    $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel");
	    $dir_pref = "$dir_name/";
	    $loc_pref = "$dir_loc/";
            if ( $byd_flag < 0 ) {  # must be finddepth, report dirname now
	        unless ($no_chdir or $dir_rel eq '.') {
	            my $udir = $pdir_loc;
	            if ($untaint) {
		        $udir = $1 if $dir_loc =~ m|$untaint_pat|;
	            }
	            unless (chdir $udir) {
		        warn "Can't cd to $udir: $!\n";
		        next;
	            }
	        }
	        $fullname = $dir_loc;
	        $name = $dir_name;
                if ( substr($name,-2) eq '/.' ) {
                  $name =~ s|/\.$||;
                }
                $dir = $p_dir;
	        $_ = ($no_chdir ? $dir_name : $dir_rel);
                if ( substr($_,-2) eq '/.' ) {
                  s|/\.$||;
                }

		lstat($_); # make sure  file tests with '_' work
	        { &$wanted_callback }; # protect against wild "next"
            } else {
                push @Stack,[$dir_loc, $pdir_loc, $p_dir, $dir_rel,-1]  if  $bydepth;
                last;
            }
	}
    }
}


sub wrap_wanted {
    my $wanted = shift;
    if ( ref($wanted) eq 'HASH' ) {
	if ( $wanted->{follow} || $wanted->{follow_fast}) {
	    $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip};
	}
	if ( $wanted->{untaint} ) {
	    $wanted->{untaint_pattern} = qr|^([-+@\w./]+)$|  
		unless defined $wanted->{untaint_pattern};
	    $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip};
	}
	return $wanted;
    }
    else {
	return { wanted => $wanted };
    }
}

sub find {
    my $wanted = shift;
    _find_opt(wrap_wanted($wanted), @_);
    %SLnkSeen= ();  # free memory
}

sub finddepth {
    my $wanted = wrap_wanted(shift);
    $wanted->{bydepth} = 1;
    _find_opt($wanted, @_);
    %SLnkSeen= ();  # free memory
}

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

$File::Find::dont_use_nlink = 1
    if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32' ||
       $^O eq 'cygwin' || $^O eq 'epoc';

# 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.
unless ($File::Find::dont_use_nlink) {
    require Config;
    $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
}

1;