Use ~-expanded version of privlib
[p5sagit/p5-mst-13.2.git] / lib / finddepth.pl
1 # Usage:
2 #       require "finddepth.pl";
3 #
4 #       &finddepth('/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
30 sub finddepth {
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                 ($fixtopdir = $topdir) =~ s,/$,, ;
38                 &finddepthdir($fixtopdir,$topnlink);
39                 ($dir,$_) = ($fixtopdir,'.');
40                 $name = $fixtopdir;
41                 &wanted;
42             }
43             else {
44                 warn "Can't cd to $topdir: $!\n";
45             }
46         }
47         else {
48             unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) {
49                 ($dir,$_) = ('.', $topdir);
50             }
51             chdir $dir && &wanted;
52         }
53         chdir $cwd;
54     }
55 }
56
57 sub finddepthdir {
58     local($dir,$nlink) = @_;
59     local($dev,$ino,$mode,$subcount);
60     local($name);
61
62     # Get the list of files in the current directory.
63
64     opendir(DIR,'.') || warn "Can't open $dir: $!\n";
65     local(@filenames) = readdir(DIR);
66     closedir(DIR);
67
68     if ($nlink == 2) {        # This dir has no subdirectories.
69         for (@filenames) {
70             next if $_ eq '.';
71             next if $_ eq '..';
72             $name = "$dir/$_";
73             $nlink = 0;
74             &wanted;
75         }
76     }
77     else {                    # This dir has subdirectories.
78         $subcount = $nlink - 2;
79         for (@filenames) {
80             next if $_ eq '.';
81             next if $_ eq '..';
82             $nlink = $prune = 0;
83             $name = "$dir/$_";
84             if ($subcount > 0) {    # Seen all the subdirs?
85
86                 # Get link count and check for directoriness.
87
88                 ($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink;
89                 
90                 if (-d _) {
91
92                     # It really is a directory, so do it recursively.
93
94                     if (!$prune && chdir $_) {
95                         &finddepthdir($name,$nlink);
96                         chdir '..';
97                     }
98                     --$subcount;
99                 }
100             }
101             &wanted;
102         }
103     }
104 }
105 1;