perl 5.0 alpha 9
[p5sagit/p5-mst-13.2.git] / x2p / find2perl
CommitLineData
79072805 1#!/usr/local/bin/perl
2304df62 2#
3# Modified September 26, 1993 to provide proper handling of years after 1999
4# Tom Link <tml+@pitt.edu>
5# University of Pittsburgh
79072805 6
7eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}'
8 if $running_under_some_shell;
9
10$bin = "/usr/local/bin";
11
12
13while ($ARGV[0] =~ /^[^-!(]/) {
14 push(@roots, shift);
15}
16@roots = ('.') unless @roots;
17for (@roots) { $_ = &quote($_); }
18$roots = join(',', @roots);
19
20$indent = 1;
21
22while (@ARGV) {
23 $_ = shift;
24 s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
25 if ($_ eq '(') {
26 $out .= &tab . "(\n";
27 $indent++;
28 next;
29 }
30 elsif ($_ eq ')') {
31 $indent--;
32 $out .= &tab . ")";
33 }
34 elsif ($_ eq '!') {
35 $out .= &tab . "!";
36 next;
37 }
38 elsif ($_ eq 'name') {
39 $out .= &tab;
40 $pat = &fileglob_to_re(shift);
41 $out .= '/' . $pat . "/";
42 }
43 elsif ($_ eq 'perm') {
44 $onum = shift;
45 die "Malformed -perm argument: $onum\n" unless $onum =~ /^-?[0-7]+$/;
46 if ($onum =~ s/^-//) {
47 $onum = '0' . sprintf("%o", oct($onum) & 017777); # s/b 07777 ?
48 $out .= &tab . "((\$mode & $onum) == $onum)";
49 }
50 else {
51 $onum = '0' . $onum unless $onum =~ /^0/;
52 $out .= &tab . "((\$mode & 0777) == $onum)";
53 }
54 }
55 elsif ($_ eq 'type') {
56 ($filetest = shift) =~ tr/s/S/;
57 $out .= &tab . "-$filetest _";
58 }
59 elsif ($_ eq 'print') {
60 $out .= &tab . 'print("$name\n")';
61 }
62 elsif ($_ eq 'print0') {
63 $out .= &tab . 'print("$name\0")';
64 }
65 elsif ($_ eq 'fstype') {
66 $out .= &tab;
67 $type = shift;
68 if ($type eq 'nfs')
2304df62 69 { $out .= '($dev < 0)'; }
79072805 70 else
2304df62 71 { $out .= '($dev >= 0)'; }
79072805 72 }
73 elsif ($_ eq 'user') {
74 $uname = shift;
2304df62 75 $out .= &tab . "(\$uid == \$uid{'$uname'})";
79072805 76 $inituser++;
77 }
78 elsif ($_ eq 'group') {
79 $gname = shift;
2304df62 80 $out .= &tab . "(\$gid == \$gid{'$gname'})";
79072805 81 $initgroup++;
82 }
83 elsif ($_ eq 'nouser') {
84 $out .= &tab . '!defined $uid{$uid}';
85 $inituser++;
86 }
87 elsif ($_ eq 'nogroup') {
88 $out .= &tab . '!defined $gid{$gid}';
89 $initgroup++;
90 }
91 elsif ($_ eq 'links') {
2304df62 92 $out .= &tab . '($nlink ' . &n(shift);
79072805 93 }
94 elsif ($_ eq 'inum') {
2304df62 95 $out .= &tab . '($ino ' . &n(shift);
79072805 96 }
97 elsif ($_ eq 'size') {
2304df62 98 $out .= &tab . '(int(((-s _) + 511) / 512) ' . &n(shift);
79072805 99 }
100 elsif ($_ eq 'atime') {
2304df62 101 $out .= &tab . '(int(-A _) ' . &n(shift);
79072805 102 }
103 elsif ($_ eq 'mtime') {
2304df62 104 $out .= &tab . '(int(-M _) ' . &n(shift);
79072805 105 }
106 elsif ($_ eq 'ctime') {
2304df62 107 $out .= &tab . '(int(-C _) ' . &n(shift);
79072805 108 }
109 elsif ($_ eq 'exec') {
110 for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
111 shift;
112 $_ = "@cmd";
113 if (m#^(/bin/)?rm -f {}$#) {
114 if (!@ARGV) {
115 $out .= &tab . 'unlink($_)';
116 }
117 else {
118 $out .= &tab . '(unlink($_) || 1)';
119 }
120 }
121 elsif (m#^(/bin/)?rm {}$#) {
122 $out .= &tab . '(unlink($_) || warn "$name: $!\n")';
123 }
124 else {
125 for (@cmd) { s/'/\\'/g; }
126 $" = "','";
127 $out .= &tab . "&exec(0, '@cmd')";
128 $" = ' ';
129 $initexec++;
130 }
131 }
132 elsif ($_ eq 'ok') {
133 for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
134 shift;
135 for (@cmd) { s/'/\\'/g; }
136 $" = "','";
137 $out .= &tab . "&exec(1, '@cmd')";
138 $" = ' ';
139 $initexec++;
140 }
141 elsif ($_ eq 'prune') {
142 $out .= &tab . '($prune = 1)';
143 }
144 elsif ($_ eq 'xdev') {
145 $out .= &tab . '(($prune |= ($dev != $topdev)),1)';
146 }
147 elsif ($_ eq 'newer') {
148 $out .= &tab;
149 $file = shift;
150 $newername = 'AGE_OF' . $file;
151 $newername =~ s/[^\w]/_/g;
152 $newername = '$' . $newername;
2304df62 153 $out .= "(-M _ < $newername)";
79072805 154 $initnewer .= "$newername = -M " . &quote($file) . ";\n";
155 }
156 elsif ($_ eq 'eval') {
157 $prog = &quote(shift);
158 $out .= &tab . "eval $prog";
159 }
160 elsif ($_ eq 'depth') {
161 $depth++;
162 next;
163 }
164 elsif ($_ eq 'ls') {
165 $out .= &tab . "&ls";
166 $initls++;
167 }
168 elsif ($_ eq 'tar') {
169 $out .= &tab;
170 die "-tar must have a filename argument\n" unless @ARGV;
171 $file = shift;
172 $fh = 'FH' . $file;
173 $fh =~ s/[^\w]/_/g;
174 $out .= "&tar($fh)";
175 $file = '>' . $file;
176 $initfile .= "open($fh, " . &quote($file) .
177 qq{) || die "Can't open $fh: \$!\\n";\n};
178 $inittar++;
179 $flushall = "\n&tflushall;\n";
180 }
181 elsif (/^n?cpio$/) {
182 $depth++;
183 $out .= &tab;
184 die "-$_ must have a filename argument\n" unless @ARGV;
185 $file = shift;
186 $fh = 'FH' . $file;
187 $fh =~ s/[^\w]/_/g;
188 $out .= "&cpio('" . substr($_,0,1) . "', $fh)";
189 $file = '>' . $file;
190 $initfile .= "open($fh, " . &quote($file) .
191 qq{) || die "Can't open $fh: \$!\\n";\n};
192 $initcpio++;
193 $flushall = "\n&flushall;\n";
194 }
195 else {
196 die "Unrecognized switch: -$_\n";
197 }
198 if (@ARGV) {
199 if ($ARGV[0] eq '-o') {
200 { local($statdone) = 1; $out .= "\n" . &tab . "||\n"; }
201 $statdone = 0 if $indent == 1 && $delayedstat;
202 $saw_or++;
203 shift;
204 }
205 else {
206 $out .= " &&" unless $ARGV[0] eq ')';
207 $out .= "\n";
208 shift if $ARGV[0] eq '-a';
209 }
210 }
211}
212
213print <<"END";
214#!$bin/perl
215
216eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
217 if \$running_under_some_shell;
218
219END
220
221if ($initls) {
222 print <<'END';
223@rwx = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
224@moname = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
225
226END
227}
228
229if ($inituser || $initls) {
230 print 'while (($name, $pw, $uid) = getpwent) {', "\n";
231 print ' $uid{$name} = $uid{$uid} = $uid;', "\n" if $inituser;
232 print ' $user{$uid} = $name unless $user{$uid};', "\n" if $initls;
233 print "}\n\n";
234}
235
236if ($initgroup || $initls) {
237 print 'while (($name, $pw, $gid) = getgrent) {', "\n";
238 print ' $gid{$name} = $gid{$gid} = $gid;', "\n" if $initgroup;
239 print ' $group{$gid} = $name unless $group{$gid};', "\n" if $initls;
240 print "}\n\n";
241}
242
243print $initnewer, "\n" if $initnewer;
244
245print $initfile, "\n" if $initfile;
246
247$find = $depth ? "finddepth" : "find";
248print <<"END";
249require "$find.pl";
250
251# Traverse desired filesystems
252
253&$find($roots);
254$flushall
255exit;
256
257sub wanted {
258$out;
259}
260
261END
262
263if ($initexec) {
264 print <<'END';
265sub exec {
266 local($ok, @cmd) = @_;
267 foreach $word (@cmd) {
268 $word =~ s#{}#$name#g;
269 }
270 if ($ok) {
271 local($old) = select(STDOUT);
272 $| = 1;
273 print "@cmd";
274 select($old);
275 return 0 unless <STDIN> =~ /^y/;
276 }
277 chdir $cwd; # sigh
278 system @cmd;
279 chdir $dir;
280 return !$?;
281}
282
283END
284}
285
286if ($initls) {
287 print <<'END';
288sub ls {
289 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$sizemm,
290 $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
291
292 $pname = $name;
293
294 if (defined $blocks) {
295 $blocks = int(($blocks + 1) / 2);
296 }
297 else {
298 $blocks = int(($size + 1023) / 1024);
299 }
300
301 if (-f _) { $perms = '-'; }
302 elsif (-d _) { $perms = 'd'; }
303 elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
304 elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
305 elsif (-p _) { $perms = 'p'; }
306 elsif (-S _) { $perms = 's'; }
307 else { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
308
309 $tmpmode = $mode;
310 $tmp = $rwx[$tmpmode & 7];
311 $tmpmode >>= 3;
312 $tmp = $rwx[$tmpmode & 7] . $tmp;
313 $tmpmode >>= 3;
314 $tmp = $rwx[$tmpmode & 7] . $tmp;
315 substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
316 substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
317 substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
318 $perms .= $tmp;
319
320 $user = $user{$uid} || $uid;
321 $group = $group{$gid} || $gid;
322
323 ($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
324 $moname = $moname[$mon];
325 if (-M _ > 365.25 / 2) {
2304df62 326 $timeyear = $year + 1900;
79072805 327 }
328 else {
329 $timeyear = sprintf("%02d:%02d", $hour, $min);
330 }
331
332 printf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
333 $ino,
334 $blocks,
335 $perms,
336 $nlink,
337 $user,
338 $group,
339 $sizemm,
340 $moname,
341 $mday,
342 $timeyear,
343 $pname;
344 1;
345}
346
347sub sizemm {
348 sprintf("%3d, %3d", ($rdev >> 8) & 255, $rdev & 255);
349}
350
351END
352}
353
354if ($initcpio) {
355print <<'END';
356sub cpio {
357 local($nc,$fh) = @_;
358 local($text);
359
360 if ($name eq 'TRAILER!!!') {
361 $text = '';
362 $size = 0;
363 }
364 else {
365 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
366 $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
367 if (-f _) {
368 open(IN, "./$_\0") || do {
369 warn "Couldn't open $name: $!\n";
370 return;
371 };
372 }
373 else {
374 $text = readlink($_);
375 $size = 0 unless defined $text;
376 }
377 }
378
379 ($nm = $name) =~ s#^\./##;
380 $nc{$fh} = $nc;
381 if ($nc eq 'n') {
382 $cpout{$fh} .=
383 sprintf("%06o%06o%06o%06o%06o%06o%06o%06o%011lo%06o%011lo%s\0",
384 070707,
385 $dev & 0777777,
386 $ino & 0777777,
387 $mode & 0777777,
388 $uid & 0777777,
389 $gid & 0777777,
390 $nlink & 0777777,
391 $rdev & 0177777,
392 $mtime,
393 length($nm)+1,
394 $size,
395 $nm);
396 }
397 else {
398 $cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
399 $cpout{$fh} .= pack("SSSSSSSSLSLa*",
400 070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
401 length($nm)+1, $size, $nm . (length($nm) & 1 ? "\0" : "\0\0"));
402 }
403 if ($text ne '') {
404 $cpout{$fh} .= $text;
405 }
406 elsif ($size) {
407 &flush($fh) while ($l = length($cpout{$fh})) >= 5120;
408 while (sysread(IN, $cpout{$fh}, 5120 - $l, $l)) {
409 &flush($fh);
410 $l = length($cpout{$fh});
411 }
412 }
413 close IN;
414}
415
416sub flush {
417 local($fh) = @_;
418
419 while (length($cpout{$fh}) >= 5120) {
420 syswrite($fh,$cpout{$fh},5120);
421 ++$blocks{$fh};
422 substr($cpout{$fh}, 0, 5120) = '';
423 }
424}
425
426sub flushall {
427 $name = 'TRAILER!!!';
428 foreach $fh (keys %cpout) {
429 &cpio($nc{$fh},$fh);
430 $cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
431 &flush($fh);
432 print $blocks{$fh} * 10, " blocks\n";
433 }
434}
435
436END
437}
438
439if ($inittar) {
440print <<'END';
441sub tar {
442 local($fh) = @_;
443 local($linkname,$header,$l,$slop);
444 local($linkflag) = "\0";
445
446 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
447 $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
448 $nm = $name;
449 if ($nlink > 1) {
450 if ($linkname = $linkseen{$fh,$dev,$ino}) {
451 $linkflag = 1;
452 }
453 else {
454 $linkseen{$fh,$dev,$ino} = $nm;
455 }
456 }
457 if (-f _) {
458 open(IN, "./$_\0") || do {
459 warn "Couldn't open $name: $!\n";
460 return;
461 };
462 $size = 0 if $linkflag ne "\0";
463 }
464 else {
465 $linkname = readlink($_);
466 $linkflag = 2 if defined $linkname;
467 $nm .= '/' if -d _;
468 $size = 0;
469 }
470
471 $header = pack("a100a8a8a8a12a12a8a1a100",
472 $nm,
473 sprintf("%6o ", $mode & 0777),
474 sprintf("%6o ", $uid & 0777777),
475 sprintf("%6o ", $gid & 0777777),
476 sprintf("%11o ", $size),
477 sprintf("%11o ", $mtime),
478 " ",
479 $linkflag,
480 $linkname);
481 $l = length($header) % 512;
482 substr($header, 148, 6) = sprintf("%6o", unpack("%16C*", $header));
483 substr($header, 154, 1) = "\0"; # blech
484 $tarout{$fh} .= $header;
485 $tarout{$fh} .= "\0" x (512 - $l) if $l;
486 if ($size) {
487 &tflush($fh) while ($l = length($tarout{$fh})) >= 10240;
488 while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
489 $slop = length($tarout{$fh}) % 512;
490 $tarout{$fh} .= "\0" x (512 - $slop) if $slop;
491 &tflush($fh);
492 $l = length($tarout{$fh});
493 }
494 }
495 close IN;
496}
497
498sub tflush {
499 local($fh) = @_;
500
501 while (length($tarout{$fh}) >= 10240) {
502 syswrite($fh,$tarout{$fh},10240);
503 ++$blocks{$fh};
504 substr($tarout{$fh}, 0, 10240) = '';
505 }
506}
507
508sub tflushall {
509 local($len);
510
511 foreach $fh (keys %tarout) {
512 $len = 10240 - length($tarout{$fh});
513 $len += 10240 if $len < 1024;
514 $tarout{$fh} .= "\0" x $len;
515 &tflush($fh);
516 }
517}
518
519END
520}
521
522exit;
523
524############################################################################
525
526sub tab {
527 local($tabstring);
528
529 $tabstring = "\t" x ($indent / 2) . ' ' x ($indent % 2 * 4);
530 if (!$statdone) {
531 if ($_ =~ /^(name|print|prune|exec|ok|\(|\))/) {
532 $delayedstat++;
533 }
534 else {
535 if ($saw_or) {
536 $tabstring .= <<'ENDOFSTAT' . $tabstring;
537($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) &&
538ENDOFSTAT
539 }
540 else {
541 $tabstring .= <<'ENDOFSTAT' . $tabstring;
542(($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
543ENDOFSTAT
544 }
545 $statdone = 1;
546 }
547 }
548 $tabstring =~ s/^\s+/ / if $out =~ /!$/;
549 $tabstring;
550}
551
552sub fileglob_to_re {
553 local($tmp) = @_;
554
2304df62 555 $tmp =~ s#([./^\$()])#\\$1#g;
79072805 556 $tmp =~ s/([?*])/.$1/g;
2304df62 557 "^$tmp\$";
79072805 558}
559
560sub n {
561 local($n) = @_;
562
563 $n =~ s/^-/< / || $n =~ s/^\+/> / || $n =~ s/^/== /;
564 $n =~ s/ 0*(\d)/ $1/;
2304df62 565 $n . ')';
79072805 566}
567
568sub quote {
569 local($string) = @_;
570 $string =~ s/'/\\'/;
571 "'$string'";
572}