source: trunk/third/perl/x2p/find2perl.PL @ 14545

Revision 14545, 23.5 KB checked in by ghudson, 24 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r14544, which included commits to RCS files with non-trunk default branches.
Line 
1#!/usr/local/bin/perl
2
3use Config;
4use File::Basename qw(&basename &dirname);
5use Cwd;
6
7# List explicitly here the variables you want Configure to
8# generate.  Metaconfig only looks for shell variables, so you
9# have to mention them as if they were shell variables, not
10# %Config entries.  Thus you write
11#  $startperl
12# to ensure Configure will look for $Config{startperl}.
13
14# This forces PL files to create target in same directory as PL file.
15# This is so that make depend always knows where to find PL derivatives.
16$origdir = cwd;
17chdir dirname($0);
18$file = basename($0, '.PL');
19$file .= '.com' if $^O eq 'VMS';
20
21open OUT,">$file" or die "Can't create $file: $!";
22
23print "Extracting $file (with variable substitutions)\n";
24
25# In this section, perl variables will be expanded during extraction.
26# You can use $Config{...} to use Configure variables.
27
28print OUT <<"!GROK!THIS!";
29$Config{startperl}
30    eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
31      if \$running_under_some_shell;
32my \$perlpath = "$Config{perlpath}";
33!GROK!THIS!
34
35# In the following, perl variables are not expanded during extraction.
36
37print OUT <<'!NO!SUBS!';
38use strict;
39use vars qw/$statdone/;
40my $startperl = "#! $perlpath -w";
41
42#
43# Modified September 26, 1993 to provide proper handling of years after 1999
44#   Tom Link <tml+@pitt.edu>
45#   University of Pittsburgh
46#
47# Modified April 7, 1998 with nasty hacks to implement the troublesome -follow
48#  Billy Constantine <wdconsta@cs.adelaide.edu.au> <billy@smug.adelaide.edu.au>
49#  University of Adelaide, Adelaide, South Australia
50#
51# Modified 1999-06-10, 1999-07-07 to migrate to cleaner perl5 usage
52#   Ken Pizzini <ken@halcyon.com>
53#
54# Modified 2000-01-28 to use the 'follow' option of File::Find
55
56my @roots = ();
57while ($ARGV[0] =~ /^[^-!(]/) {
58    push(@roots, shift);
59}
60@roots = ('.') unless @roots;
61for (@roots) { $_ = &quote($_) }
62my $roots = join(', ', @roots);
63
64my $find = "find";
65my $indent_depth = 1;
66my $stat = 'lstat';
67my $decl = '';
68my $flushall = '';
69my $initfile = '';
70my $initnewer = '';
71my $out = '';
72my %init = ();
73my ($follow_in_effect,$Skip_And) = (0,0);
74
75while (@ARGV) {
76    $_ = shift;
77    s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
78    if ($_ eq '(') {
79        $out .= &tab . "(\n";
80        $indent_depth++;
81        next;
82    } elsif ($_ eq ')') {
83        --$indent_depth;
84        $out .= &tab . ")";
85    } elsif ($_ eq 'follow') {
86        $follow_in_effect= 1;
87        $stat = 'stat';
88        $Skip_And= 1;
89    } elsif ($_ eq '!') {
90        $out .= &tab . "!";
91        next;
92    } elsif ($_ eq 'name') {
93        $out .= &tab . '/' . &fileglob_to_re(shift) . "/s";
94    } elsif ($_ eq 'perm') {
95        my $onum = shift;
96        $onum =~ /^-?[0-7]+$/
97            || die "Malformed -perm argument: $onum\n";
98        $out .= &tab;
99        if ($onum =~ s/^-//) {
100            $onum = sprintf("0%o", oct($onum) & 07777);
101            $out .= "((\$mode & $onum) == $onum)";
102        } else {
103            $onum =~ s/^0*/0/;
104            $out .= "((\$mode & 0777) == $onum)";
105        }
106    } elsif ($_ eq 'type') {
107        (my $filetest = shift) =~ tr/s/S/;
108        $out .= &tab . "-$filetest _";
109    } elsif ($_ eq 'print') {
110        $out .= &tab . 'print("$name\n")';
111    } elsif ($_ eq 'print0') {
112        $out .= &tab . 'print("$name\0")';
113    } elsif ($_ eq 'fstype') {
114        my $type = shift;
115        $out .= &tab;
116        if ($type eq 'nfs') {
117            $out .= '($dev < 0)';
118        } else {
119            $out .= '($dev >= 0)'; #XXX
120        }
121    } elsif ($_ eq 'user') {
122        my $uname = shift;
123        $out .= &tab . "(\$uid == \$uid{'$uname'})";
124        $init{user} = 1;
125    } elsif ($_ eq 'group') {
126        my $gname = shift;
127        $out .= &tab . "(\$gid == \$gid{'$gname'})";
128        $init{group} = 1;
129    } elsif ($_ eq 'nouser') {
130        $out .= &tab . '!exists $uid{$uid}';
131        $init{user} = 1;
132    } elsif ($_ eq 'nogroup') {
133        $out .= &tab . '!exists $gid{$gid}';
134        $init{group} = 1;
135    } elsif ($_ eq 'links') {
136        $out .= &tab . &n('$nlink', shift);
137    } elsif ($_ eq 'inum') {
138        $out .= &tab . &n('$ino', shift);
139    } elsif ($_ eq 'size') {
140        $_ = shift;
141        my $n = 'int(((-s _) + 511) / 512)';
142        if (s/c\z//) {
143            $n = 'int(-s _)';
144        } elsif (s/k\z//) {
145            $n = 'int(((-s _) + 1023) / 1024)';
146        }
147        $out .= &tab . &n($n, $_);
148    } elsif ($_ eq 'atime') {
149        $out .= &tab . &n('int(-A _)', shift);
150    } elsif ($_ eq 'mtime') {
151        $out .= &tab . &n('int(-M _)', shift);
152    } elsif ($_ eq 'ctime') {
153        $out .= &tab . &n('int(-C _)', shift);
154    } elsif ($_ eq 'exec') {
155        my @cmd = ();
156        while (@ARGV && $ARGV[0] ne ';')
157            { push(@cmd, shift) }
158        shift;
159        $out .= &tab;
160        if ($cmd[0] =~m#^(?:(?:/usr)?/bin/)?rm$#
161                && $cmd[$#cmd] eq '{}'
162                && (@cmd == 2 || (@cmd == 3 && $cmd[1] eq '-f'))) {
163            if (@cmd == 2) {
164                $out .= '(unlink($_) || warn "$name: $!\n")';
165            } elsif (!@ARGV) {
166                $out .= 'unlink($_)';
167            } else {
168                $out .= '(unlink($_) || 1)';
169            }
170        } else {
171            for (@cmd)
172                { s/'/\\'/g }
173            { local $" = "','"; $out .= "&doexec(0, '@cmd')"; }
174            $init{doexec} = 1;
175        }
176    } elsif ($_ eq 'ok') {
177        my @cmd = ();
178        while (@ARGV && $ARGV[0] ne ';')
179            { push(@cmd, shift) }
180        shift;
181        $out .= &tab;
182        for (@cmd)
183            { s/'/\\'/g }
184        { local $" = "','"; $out .= "&doexec(0, '@cmd')"; }
185        $init{doexec} = 1;
186    } elsif ($_ eq 'prune') {
187        $out .= &tab . '($File::Find::prune = 1)';
188    } elsif ($_ eq 'xdev') {
189        $out .= &tab . '!($File::Find::prune |= ($dev != $File::Find::topdev))'
190;
191    } elsif ($_ eq 'newer') {
192        my $file = shift;
193        my $newername = 'AGE_OF' . $file;
194        $newername =~ s/\W/_/g;
195        $newername = '$' . $newername;
196        $out .= &tab . "(-M _ < $newername)";
197        $initnewer .= "my $newername = -M " . &quote($file) . ";\n";
198    } elsif ($_ eq 'eval') {
199        my $prog = shift;
200        $prog =~ s/'/\\'/g;
201        $out .= &tab . "eval {$prog}";
202    } elsif ($_ eq 'depth') {
203        $find = 'finddepth';
204        next;
205    } elsif ($_ eq 'ls') {
206        $out .= &tab . "&ls";
207        $init{ls} = 1;
208    } elsif ($_ eq 'tar') {
209        die "-tar must have a filename argument\n" unless @ARGV;
210        my $file = shift;
211        my $fh = 'FH' . $file;
212        $fh =~ s/\W/_/g;
213        $out .= &tab . "&tar(*$fh, \$name)";
214        $flushall .= "&tflushall;\n";
215        $initfile .= "open($fh, " . &quote('> ' . $file) .
216                     qq{) || die "Can't open $fh: \$!\\n";\n};
217        $init{tar} = 1;
218    } elsif (/^(n?)cpio\z/) {
219        die "-$_ must have a filename argument\n" unless @ARGV;
220        my $file = shift;
221        my $fh = 'FH' . $file;
222        $fh =~ s/\W/_/g;
223        $out .= &tab . "&cpio(*$fh, \$name, '$1')";
224        $find = 'finddepth';
225        $flushall .= "&cflushall;\n";
226        $initfile .= "open($fh, " . &quote('> ' . $file) .
227                     qq{) || die "Can't open $fh: \$!\\n";\n};
228        $init{cpio} = 1;
229    } else {
230        die "Unrecognized switch: -$_\n";
231    }
232
233    if (@ARGV) {
234        if ($ARGV[0] eq '-o') {
235            { local($statdone) = 1; $out .= "\n" . &tab . "||\n"; }
236            $statdone = 0 if $indent_depth == 1 && exists $init{delayedstat};
237            $init{saw_or} = 1;
238            shift;
239        } else {
240            $out .= " &&" unless $Skip_And || $ARGV[0] eq ')';
241            $out .= "\n";
242            shift if $ARGV[0] eq '-a';
243        }
244    }
245}
246
247
248print <<"END";
249$startperl
250    eval 'exec $perlpath -S \$0 \${1+"\$@"}'
251        if 0; #\$running_under_some_shell
252
253use strict;
254use File::Find ();
255
256# Set the variable \$File::Find::dont_use_nlink if you're using AFS,
257# since AFS cheats.
258
259# for the convenience of &wanted calls, including -eval statements:
260use vars qw/*name *dir *prune/;
261*name   = *File::Find::name;
262*dir    = *File::Find::dir;
263*prune  = *File::Find::prune;
264
265END
266
267
268if (exists $init{ls}) {
269    print <<'END';
270my @rwx = qw(--- --x -w- -wx r-- r-x rw- rwx);
271my @moname = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
272
273END
274}
275
276if (exists $init{user} || exists $init{ls} || exists $init{tar}) {
277    print "my (%uid, %user);\n";
278    print "while (my (\$name, \$pw, \$uid) = getpwent) {\n";
279    print '    $uid{$name} = $uid{$uid} = $uid;', "\n"
280        if exists $init{user};
281    print '    $user{$uid} = $name unless exists $user{$uid};', "\n"
282        if exists $init{ls} || exists $init{tar};
283    print "}\n\n";
284}
285
286if (exists $init{group} || exists $init{ls} || exists $init{tar}) {
287    print "my (%gid, %group);\n";
288    print "while (my (\$name, \$pw, \$gid) = getgrent) {\n";
289    print '    $gid{$name} = $gid{$gid} = $gid;', "\n"
290        if exists $init{group};
291    print '    $group{$gid} = $name unless exists $group{$gid};', "\n"
292        if exists $init{ls} || exists $init{tar};
293    print "}\n\n";
294}
295
296print $initnewer, "\n" if $initnewer ne '';
297print $initfile, "\n" if $initfile ne '';
298$flushall .= "exit;\n";
299if (exists $init{declarestat}) {
300    $out = <<'END' . $out;
301    my ($dev,$ino,$mode,$nlink,$uid,$gid);
302
303END
304}
305
306if ( $follow_in_effect ) {
307$out =~ s/lstat\(\$_\)/lstat(_)/;
308print <<"END";
309$decl
310# Traverse desired filesystems
311File::Find::$find( {wanted => \\&wanted, follow => 1}, $roots);
312$flushall
313
314sub wanted {
315$out;
316}
317
318END
319} else {
320print <<"END";
321$decl
322# Traverse desired filesystems
323File::Find::$find({wanted => \\&wanted}, $roots);
324$flushall
325
326sub wanted {
327$out;
328}
329
330END
331}
332
333if (exists $init{doexec}) {
334    print <<'END';
335
336BEGIN {
337    require Cwd;
338    my $cwd = Cwd::cwd();
339}
340
341sub doexec {
342    my $ok = shift;
343    for my $word (@_)
344        { $word =~ s#{}#$name#g }
345    if ($ok) {
346        my $old = select(STDOUT);
347        $| = 1;
348        print "@_";
349        select($old);
350        return 0 unless <STDIN> =~ /^y/;
351    }
352    chdir $cwd; #sigh
353    system @_;
354    chdir $File::Find::dir;
355    return !$?;
356}
357
358END
359}
360
361if (exists $init{ls}) {
362    print <<'INTRO', <<"SUB", <<'END';
363
364sub sizemm {
365    my $rdev = shift;
366    sprintf("%3d, %3d", ($rdev >> 8) & 0xff, $rdev & 0xff);
367}
368
369sub ls {
370    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
371INTRO
372        \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat(_);
373SUB
374    my $pname = $name;
375
376    $blocks
377        or $blocks = int(($size + 1023) / 1024);
378
379    my $perms = $rwx[$mode & 7];
380    $mode >>= 3;
381    $perms = $rwx[$mode & 7] . $perms;
382    $mode >>= 3;
383    $perms = $rwx[$mode & 7] . $perms;
384    substr($perms, 2, 1) =~ tr/-x/Ss/ if -u _;
385    substr($perms, 5, 1) =~ tr/-x/Ss/ if -g _;
386    substr($perms, 8, 1) =~ tr/-x/Tt/ if -k _;
387    if    (-f _) { $perms = '-' . $perms; }
388    elsif (-d _) { $perms = 'd' . $perms; }
389    elsif (-l _) { $perms = 'l' . $perms; $pname .= ' -> ' . readlink($_); }
390    elsif (-c _) { $perms = 'c' . $perms; $size = sizemm($rdev); }
391    elsif (-b _) { $perms = 'b' . $perms; $size = sizemm($rdev); }
392    elsif (-p _) { $perms = 'p' . $perms; }
393    elsif (-S _) { $perms = 's' . $perms; }
394    else         { $perms = '?' . $perms; }
395
396    my $user = $user{$uid} || $uid;
397    my $group = $group{$gid} || $gid;
398
399    my ($sec,$min,$hour,$mday,$mon,$timeyear) = localtime($mtime);
400    if (-M _ > 365.25 / 2) {
401        $timeyear += 1900;
402    } else {
403        $timeyear = sprintf("%02d:%02d", $hour, $min);
404    }
405
406    printf "%5lu %4ld %-10s %3d %-8s %-8s %8s %s %2d %5s %s\n",
407            $ino,
408                 $blocks,
409                      $perms,
410                            $nlink,
411                                $user,
412                                     $group,
413                                          $size,
414                                              $moname[$mon],
415                                                 $mday,
416                                                     $timeyear,
417                                                         $pname;
418    1;
419}
420
421END
422}
423
424
425if (exists $init{cpio} || exists $init{tar}) {
426print <<'END';
427
428my %blocks = ();
429
430sub flush {
431    my ($fh, $varref, $blksz) = @_;
432
433    while (length($$varref) >= $blksz) {
434        no strict qw/refs/;
435        syswrite($fh, $$varref, $blksz);
436        substr($$varref, 0, $blksz) = '';
437        ++$blocks{$fh};
438    }
439}
440
441END
442}
443
444
445if (exists $init{cpio}) {
446    print <<'INTRO', <<"SUB", <<'END';
447
448my %cpout = ();
449my %nc = ();
450
451sub cpio {
452    my ($fh, $fname, $nc) = @_;
453    my $text = '';
454    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
455        $atime,$mtime,$ctime,$blksize,$blocks);
456    local (*IN);
457
458    if ( ! defined $fname ) {
459        $fname = 'TRAILER!!!';
460        ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
461          $atime,$mtime,$ctime,$blksize,$blocks) = (0) x 13;
462    } else {
463        ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
464INTRO
465          \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat(_);
466SUB
467        if (-f _) {
468            open(IN, "./$_\0") || do {
469                warn "Couldn't open $fname: $!\n";
470                return;
471            }
472        } else {
473            $text = readlink($_);
474            $size = 0 unless defined $text;
475        }
476    }
477
478    $fname =~ s#^\./##;
479    $nc{$fh} = $nc;
480    if ($nc eq 'n') {
481        $cpout{$fh} .=
482          sprintf("%06o%06o%06o%06o%06o%06o%06o%06o%011lo%06o%011lo%s\0",
483            070707,
484            $dev & 0777777,
485            $ino & 0777777,
486            $mode & 0777777,
487            $uid & 0777777,
488            $gid & 0777777,
489            $nlink & 0777777,
490            $rdev & 0177777,
491            $mtime,
492            length($fname)+1,
493            $size,
494            $fname);
495    } else {
496        $cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
497        $cpout{$fh} .= pack("SSSSSSSSLSLa*",
498            070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
499            length($fname)+1, $size,
500            $fname . (length($fname) & 1 ? "\0" : "\0\0"));
501    }
502
503    if ($text ne '') {
504        $cpout{$fh} .= $text;
505    } elsif ($size) {
506        my $l;
507        flush($fh, \$cpout{$fh}, 5120)
508            while ($l = length($cpout{$fh})) >= 5120;
509        while (sysread(IN, $cpout{$fh}, 5120 - $l, $l)) {
510            flush($fh, \$cpout{$fh}, 5120);
511            $l = length($cpout{$fh});
512        }
513        close IN;
514    }
515}
516
517sub cflushall {
518    for my $fh (keys %cpout) {
519        &cpio($fh, undef, $nc{$fh});
520        $cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
521        flush($fh, \$cpout{$fh}, 5120);
522        print $blocks{$fh} * 10, " blocks\n";
523    }
524}
525
526END
527}
528
529if (exists $init{tar}) {
530    print <<'INTRO', <<"SUB", <<'END';
531
532my %tarout = ();
533my %linkseen = ();
534
535sub tar {
536    my ($fh, $fname) = @_;
537    my $prefix = '';
538    my $typeflag = '0';
539    my $linkname;
540    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
541INTRO
542        \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat(_);
543SUB
544    local (*IN);
545
546    if ($nlink > 1) {
547        if ($linkname = $linkseen{$fh, $dev, $ino}) {
548            if (length($linkname) > 100) {
549                warn "$0: omitting file with linkname ",
550                     "too long for tar output: $linkname\n";
551                return;
552            }
553            $typeflag = '1';
554            $size = 0;
555        } else {
556            $linkseen{$fh, $dev, $ino} = $fname;
557        }
558    }
559    if ($typeflag eq '0') {
560        if (-f _) {
561            open(IN, "./$_\0") || do {
562                warn "Couldn't open $fname: $!\n";
563                return;
564            }
565        } else {
566            $linkname = readlink($_);
567            if (defined $linkname) { $typeflag = '2' }
568            elsif (-c _) { $typeflag = '3' }
569            elsif (-b _) { $typeflag = '4' }
570            elsif (-d _) { $typeflag = '5' }
571            elsif (-p _) { $typeflag = '6' }
572        }
573    }
574
575    if (length($fname) > 100) {
576        ($prefix, $fname) = ($fname =~ m#\A(.*?)/(.{,100})\Z(?!\n)#);
577        if (!defined($fname) || length($prefix) > 155) {
578            warn "$0: omitting file with name too long for tar output: ",
579                 $fname, "\n";
580            return;
581        }
582    }
583
584    $size = 0 if $typeflag ne '0';
585    my $header = pack("a100a8a8a8a12a12a8a1a100a6a2a32a32a8a8a155",
586                        $fname,
587                        sprintf("%7o ", $mode &    0777),
588                        sprintf("%7o ", $uid  & 0777777),
589                        sprintf("%7o ", $gid  & 0777777),
590                        sprintf("%11o ", $size),
591                        sprintf("%11o ", $mtime),
592                        ' 'x8,
593                        $typeflag,
594                        defined $linkname ? $linkname : '',
595                        "ustar\0",
596                        "00",
597                        $user{$uid},
598                        $group{$gid},
599                        ($rdev >> 8) & 0xff,
600                        $rdev & 0xff,
601                        $prefix,
602                     );
603    substr($header, 148, 8) = sprintf("%7o ", unpack("%16C*", $header));
604    my $l = length($header) % 512;
605    $tarout{$fh} .= $header;
606    $tarout{$fh} .= "\0" x (512 - $l) if $l;
607
608    if ($size) {
609        flush($fh, \$tarout{$fh}, 10240)
610            while ($l = length($tarout{$fh})) >= 10240;
611        while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
612            my $slop = length($tarout{$fh}) % 512;
613            $tarout{$fh} .= "\0" x (512 - $slop) if $slop;
614            flush($fh, \$tarout{$fh}, 10240);
615            $l = length($tarout{$fh});
616        }
617        close IN;
618    }
619}
620
621sub tflushall {
622    my $len;
623    for my $fh (keys %tarout) {
624        $len = 10240 - length($tarout{$fh});
625        $len += 10240 if $len < 1024;
626        $tarout{$fh} .= "\0" x $len;
627        flush($fh, \$tarout{$fh}, 10240);
628    }
629}
630
631END
632}
633
634exit;
635
636############################################################################
637
638sub tab {
639    my $tabstring;
640
641    $tabstring = "\t" x ($indent_depth/2) . ' ' x ($indent_depth%2 * 4);
642    if (!$statdone) {
643        if ($_ =~ /^(?:name|print|prune|exec|ok|\(|\))/) {
644            $init{delayedstat} = 1;
645        } else {
646            my $statcall = '(($dev,$ino,$mode,$nlink,$uid,$gid) = '
647                         . $stat . '($_))';
648            if (exists $init{saw_or}) {
649                $tabstring .= "(\$nlink || $statcall) &&\n" . $tabstring;
650            } else {
651                $tabstring .= "$statcall &&\n" . $tabstring;
652            }
653            $statdone = 1;
654            $init{declarestat} = 1;
655        }
656    }
657    $tabstring =~ s/^\s+/ / if $out =~ /!$/;
658    $tabstring;
659}
660
661sub fileglob_to_re {
662    my $x = shift;
663    $x =~ s#([./^\$()])#\\$1#g;
664    $x =~ s#([?*])#.$1#g;
665    "^$x\\z";
666}
667
668sub n {
669    my ($pre, $n) = @_;
670    $n =~ s/^-/< / || $n =~ s/^\+/> / || $n =~ s/^/== /;
671    $n =~ s/ 0*(\d)/ $1/;
672    "($pre $n)";
673}
674
675sub quote {
676    my $string = shift;
677    $string =~ s/'/\\'/g;
678    "'$string'";
679}
680
681__END__
682
683=head1 NAME
684
685find2perl - translate find command lines to Perl code
686
687=head1 SYNOPSIS
688
689        find2perl [paths] [predicates] | perl
690
691=head1 DESCRIPTION
692
693find2perl is a little translator to convert find command lines to
694equivalent Perl code.  The resulting code is typically faster than
695running find itself.
696
697"paths" are a set of paths where find2perl will start its searches and
698"predicates" are taken from the following list.
699
700=over 4
701
702=item C<! PREDICATE>
703
704Negate the sense of the following predicate.  The C<!> must be passed as
705a distinct argument, so it may need to be surrounded by whitespace and/or
706quoted from interpretation by the shell using a backslash (just as with
707using C<find(1)>).
708
709=item C<( PREDICATES )>
710
711Group the given PREDICATES.  The parentheses must be passed as distinct
712arguments, so they may need to be surrounded by whitespace and/or
713quoted from interpretation by the shell using a backslash (just as with
714using C<find(1)>).
715
716=item C<PREDICATE1 PREDICATE2>
717
718True if _both_ PREDICATE1 and PREDICATE2 are true; PREDICATE2 is not
719evaluated if PREDICATE1 is false.
720
721=item C<PREDICATE1 -o PREDICATE2>
722
723True if either one of PREDICATE1 or PREDICATE2 is true; PREDICATE2 is
724not evaluated if PREDICATE1 is true.
725
726=item C<-follow>
727
728Follow (dereference) symlinks.  The checking of file attributes depends
729on the position of the C<-follow> option. If it precedes the file
730check option, an C<stat> is done which means the file check applies to the
731file the symbolic link is pointing to. If C<-follow> option follows the
732file check option, this now applies to the symbolic link itself, i.e.
733an C<lstat> is done.
734
735=item C<-depth>
736
737Change directory traversal algorithm from breadth-first to depth-first.
738
739=item C<-prune>
740
741Do not descend into the directory currently matched.
742
743=item C<-xdev>
744
745Do not traverse mount points (prunes search at mount-point directories).
746
747=item C<-name GLOB>
748
749File name matches specified GLOB wildcard pattern.  GLOB may need to be
750quoted to avoid interpretation by the shell (just as with using
751C<find(1)>).
752
753=item C<-perm PERM>
754
755Low-order 9 bits of permission match octal value PERM.
756
757=item C<-perm -PERM>
758
759The bits specified in PERM are all set in file's permissions.
760
761=item C<-type X>
762
763The file's type matches perl's C<-X> operator.
764
765=item C<-fstype TYPE>
766
767Filesystem of current path is of type TYPE (only NFS/non-NFS distinction
768is implemented).
769
770=item C<-user USER>
771
772True if USER is owner of file.
773
774=item C<-group GROUP>
775
776True if file's group is GROUP.
777
778=item C<-nouser>
779
780True if file's owner is not in password database.
781
782=item C<-nogroup>
783
784True if file's group is not in group database.
785
786=item C<-inum INUM>
787
788True file's inode number is INUM.
789
790=item C<-links N>
791
792True if (hard) link count of file matches N (see below).
793
794=item C<-size N>
795
796True if file's size matches N (see below) N is normally counted in
797512-byte blocks, but a suffix of "c" specifies that size should be
798counted in characters (bytes) and a suffix of "k" specifes that
799size should be counted in 1024-byte blocks.
800
801=item C<-atime N>
802
803True if last-access time of file matches N (measured in days) (see
804below).
805
806=item C<-ctime N>
807
808True if last-changed time of file's inode matches N (measured in days,
809see below).
810
811=item C<-mtime N>
812
813True if last-modified time of file matches N (measured in days, see below).
814
815=item C<-newer FILE>
816
817True if last-modified time of file matches N.
818
819=item C<-print>
820
821Print out path of file (always true).
822
823=item C<-print0>
824
825Like -print, but terminates with \0 instead of \n.
826
827=item C<-exec OPTIONS ;>
828
829exec() the arguments in OPTIONS in a subprocess; any occurence of {} in
830OPTIONS will first be substituted with the path of the current
831file.  Note that the command "rm" has been special-cased to use perl's
832unlink() function instead (as an optimization).  The C<;> must be passed as
833a distinct argument, so it may need to be surrounded by whitespace and/or
834quoted from interpretation by the shell using a backslash (just as with
835using C<find(1)>).
836
837=item C<-ok OPTIONS ;>
838
839Like -exec, but first prompts user; if user's response does not begin
840with a y, skip the exec.  The C<;> must be passed as
841a distinct argument, so it may need to be surrounded by whitespace and/or
842quoted from interpretation by the shell using a backslash (just as with
843using C<find(1)>).
844
845=item C<-eval EXPR>
846
847Has the perl script eval() the EXPR. 
848
849=item C<-ls>
850
851Simulates C<-exec ls -dils {} ;>
852
853=item C<-tar FILE>
854
855Adds current output to tar-format FILE.
856
857=item C<-cpio FILE>
858
859Adds current output to old-style cpio-format FILE.
860
861=item C<-ncpio FILE>
862
863Adds current output to "new"-style cpio-format FILE.
864
865=back
866
867Predicates which take a numeric argument N can come in three forms:
868
869   * N is prefixed with a +: match values greater than N
870   * N is prefixed with a -: match values less than N
871   * N is not prefixed with either + or -: match only values equal to N
872
873=head1 SEE ALSO
874
875find
876
877=cut
878!NO!SUBS!
879
880close OUT or die "Can't close $file: $!";
881chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
882exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
883chdir $origdir;
Note: See TracBrowser for help on using the repository browser.