perl 4.0 patch 29: patch #20, continued
[p5sagit/p5-mst-13.2.git] / lib / find.pl
CommitLineData
6e21c824 1# Usage:
2# require "find.pl";
3#
4# &find('/foo','/bar');
5#
6# sub wanted { ... }
7# where wanted does whatever you want. $dir contains the
8# current directory name, and $_ the current filename within
9# that directory. $name contains "$dir/$_". You are cd'ed
10# to $dir when the function is called. The function may
11# set $prune to prune the tree.
12#
13# This library is primarily for find2perl, which, when fed
14#
15# find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune
16#
17# spits out something like this
18#
19# sub wanted {
20# /^\.nfs.*$/ &&
21# (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
22# int(-M _) > 7 &&
23# unlink($_)
24# ||
25# ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
26# $dev < 0 &&
27# ($prune = 1);
28# }
29
30sub find {
31 chop($cwd = `pwd`);
32 foreach $topdir (@_) {
33 (($topdev,$topino,$topmode,$topnlink) = stat($topdir))
34 || (warn("Can't stat $topdir: $!\n"), next);
35 if (-d _) {
36 if (chdir($topdir)) {
37 ($dir,$_) = ($topdir,'.');
38 $name = $topdir;
39 &wanted;
40 $topdir =~ s,/$,, ;
41 &finddir($topdir,$topnlink);
42 }
43 else {
44 warn "Can't cd to $topdir: $!\n";
45 }
46 }
47 else {
48 unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
49 ($dir,$_) = ('.', $topdir);
50 }
8adcabd8 51 $name = $topdir;
6e21c824 52 chdir $dir && &wanted;
53 }
54 chdir $cwd;
55 }
56}
57
58sub finddir {
59 local($dir,$nlink) = @_;
60 local($dev,$ino,$mode,$subcount);
61 local($name);
62
63 # Get the list of files in the current directory.
64
8adcabd8 65 opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return);
6e21c824 66 local(@filenames) = readdir(DIR);
67 closedir(DIR);
68
69 if ($nlink == 2) { # This dir has no subdirectories.
70 for (@filenames) {
71 next if $_ eq '.';
72 next if $_ eq '..';
73 $name = "$dir/$_";
74 $nlink = 0;
75 &wanted;
76 }
77 }
78 else { # This dir has subdirectories.
79 $subcount = $nlink - 2;
80 for (@filenames) {
81 next if $_ eq '.';
82 next if $_ eq '..';
83 $nlink = $prune = 0;
84 $name = "$dir/$_";
85 &wanted;
86 if ($subcount > 0) { # Seen all the subdirs?
87
88 # Get link count and check for directoriness.
89
90 ($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
91
92 if (-d _) {
93
94 # It really is a directory, so do it recursively.
95
96 if (!$prune && chdir $_) {
97 &finddir($name,$nlink);
98 chdir '..';
99 }
100 --$subcount;
101 }
102 }
103 }
104 }
105}
1061;