package File::Find;
+use 5.006;
use strict;
use warnings;
-use 5.6.0;
-our $VERSION = '1.01';
+our $VERSION = '1.02';
require Exporter;
require Cwd;
C<follow_skip==2> causes File::Find to ignore any duplicate files and
directories but to proceed normally otherwise.
+=item C<dangling_symlinks>
+
+If true and a code reference, will be called with the symbolic link
+name and the directory it lives in as arguments. Otherwise, if true
+and warnings are on, warning "symbolic_link_name is a dangling
+symbolic link\n" will be issued. If false, the dangling symbolic link
+will be silently ignored.
=item C<no_chdir>
See above. This should be set using the C<qr> quoting operator.
The default is set to C<qr|^([-+@\w./]+)$|>.
-Note that the parantheses are vital.
+Note that the parentheses are vital.
=item C<untaint_skip>
($File::Find::prune = 1);
}
+Notice the C<_> in the above C<int(-M _)>: the C<_> is a magical
+filehandle that caches the information from the preceding
+stat(), lstat(), or filetest.
+
Set the variable C<$File::Find::dont_use_nlink> if you're using AFS,
since AFS cheats.
-
-Here's another interesting wanted function. It will find all symlinks
-that don't resolve:
+Here's another interesting wanted function. It will find all symbolic
+links that don't resolve:
sub wanted {
-l && !-e && print "bogus link: $File::Find::name\n";
use Mac::Files;
# invisible() -- returns 1 if file/directory is invisible,
- # 0 if it's visible or undef if an error occured
+ # 0 if it's visible or undef if an error occurred
sub invisible($) {
my $file = shift;
our %SLnkSeen;
our ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
$follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
- $pre_process, $post_process);
+ $pre_process, $post_process, $dangling_symlinks);
sub contract_name {
my ($cdir,$fn) = @_;
local %SLnkSeen;
local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
$follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
- $pre_process, $post_process);
+ $pre_process, $post_process, $dangling_symlinks);
local($dir, $name, $fullname, $prune);
- my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::cwd();
- my $cwd_untainted = $cwd;
- my $check_t_cwd = 1;
- $wanted_callback = $wanted->{wanted};
- $bydepth = $wanted->{bydepth};
- $pre_process = $wanted->{preprocess};
- $post_process = $wanted->{postprocess};
- $no_chdir = $wanted->{no_chdir};
- $full_check = $wanted->{follow};
- $follow = $full_check || $wanted->{follow_fast};
- $follow_skip = $wanted->{follow_skip};
- $untaint = $wanted->{untaint};
- $untaint_pat = $wanted->{untaint_pattern};
- $untaint_skip = $wanted->{untaint_skip};
-
- # for compatability reasons (find.pl, find2perl)
+ my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
+ my $cwd_untainted = $cwd;
+ my $check_t_cwd = 1;
+ $wanted_callback = $wanted->{wanted};
+ $bydepth = $wanted->{bydepth};
+ $pre_process = $wanted->{preprocess};
+ $post_process = $wanted->{postprocess};
+ $no_chdir = $wanted->{no_chdir};
+ $full_check = $wanted->{follow};
+ $follow = $full_check || $wanted->{follow_fast};
+ $follow_skip = $wanted->{follow_skip};
+ $untaint = $wanted->{untaint};
+ $untaint_pat = $wanted->{untaint_pattern};
+ $untaint_skip = $wanted->{untaint_skip};
+ $dangling_symlinks = $wanted->{dangling_symlinks};
+
+ # for compatibility reasons (find.pl, find2perl)
local our ($topdir, $topdev, $topino, $topmode, $topnlink);
# a symbolic link to a directory doesn't increase the link count
}
$abs_dir= Follow_SymLink($abs_dir);
unless (defined $abs_dir) {
- warn "$top_item is a dangling symbolic link\n" if $^W;
+ if ($dangling_symlinks) {
+ if (ref $dangling_symlinks eq 'CODE') {
+ $dangling_symlinks->($top_item, $cwd);
+ } else {
+ warn "$top_item is a dangling symbolic link\n" if $^W;
+ }
+ }
next Proc_Top_Item;
}
my $SE= [];
my $dir_name= $p_dir;
my $dir_pref;
- my $dir_rel;
+ my $dir_rel = $File::Find::current_dir;
my $tainted = 0;
if ($Is_MacOS) {
$dir_pref= ($p_dir =~ /:$/) ? $p_dir : "$p_dir:"; # preface
- $dir_rel= ':'; # directory name relative to current directory
}
else {
$dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" );
- $dir_rel= '.'; # directory name relative to current directory
}
local ($dir, $name, $prune, *DIR);
if ( $nlink == -2 ) {
$name = $dir = $p_dir; # $File::Find::name / dir
- if ($Is_MacOS) {
- $_ = ':'; # $_
- }
- else {
- $_ = '.';
- }
+ $_ = $File::Find::current_dir;
&$post_process; # End-of-directory processing
}
elsif ( $nlink < 0 ) { # must be finddepth, report dirname now
my $dir_name = $p_dir;
my $dir_pref;
my $loc_pref;
- my $dir_rel;
+ my $dir_rel = $File::Find::current_dir;
my $byd_flag; # flag for pending stack entry if $bydepth
my $tainted = 0;
my $ok = 1;
if ($Is_MacOS) {
$dir_pref = ($p_dir =~ /:$/) ? "$p_dir" : "$p_dir:";
$loc_pref = ($dir_loc =~ /:$/) ? "$dir_loc" : "$dir_loc:";
- $dir_rel = ':'; # directory name relative to current directory
} else {
$dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" );
$loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" );
- $dir_rel = '.'; # directory name relative to current directory
}
local ($dir, $name, $fullname, $prune, *DIR);
projects / p5sagit/p5-mst-13.2.git / blobdiff