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