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