App-find2perl

 view release on metacpan or  search on metacpan

script/find2perl  view on Meta::CPAN

292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
print $initfile, "\n" if $initfile ne '';
$flushall .= "exit;\n";
if (exists $init{declarestat}) {
    $out = <<'END' . $out;
    my ($dev,$ino,$mode,$nlink,$uid,$gid);
 
END
}
 
if ( $follow_in_effect ) {
$out =~ s/lstat\(\$_\)/lstat(_)/;
print <<"END";
$decl
# Traverse desired filesystems
File::Find::$find( {wanted => \\&wanted, follow => 1}, $roots);
$flushall
 
sub wanted {
$out;
}

script/find2perl  view on Meta::CPAN

353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
    print <<'INTRO', <<"SUB", <<'END';
 
sub sizemm {
    my $rdev = shift;
    sprintf("%3d, %3d", ($rdev >> 8) & 0xff, $rdev & 0xff);
}
 
sub ls () {
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
INTRO
        \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat(_);
SUB
    my $pname = $name;
 
    $blocks
        or $blocks = int(($size + 1023) / 1024);
 
    my $perms = $rwx[$mode & 7];
    $mode >>= 3;
    $perms = $rwx[$mode & 7] . $perms;
    $mode >>= 3;

script/find2perl  view on Meta::CPAN

446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
        $atime,$mtime,$ctime,$blksize,$blocks);
    local (*IN);
 
    if ( ! defined $fname ) {
        $fname = 'TRAILER!!!';
        ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
          $atime,$mtime,$ctime,$blksize,$blocks) = (0) x 13;
    } else {
        ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
INTRO
          \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat(_);
SUB
        if (-f _) {
            open(IN, "./$_\0") || do {
                warn "Couldn't open $fname: $!\n";
                return;
            }
        } else {
            $text = readlink($_);
            $size = 0 unless defined $text;
        }

script/find2perl  view on Meta::CPAN

523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
my %tarout = ();
my %linkseen = ();
 
sub tar {
    my ($fh, $fname) = @_;
    my $prefix = '';
    my $typeflag = '0';
    my $linkname;
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
INTRO
        \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat(_);
SUB
    local (*IN);
 
    if ($nlink > 1) {
        if ($linkname = $linkseen{$fh, $dev, $ino}) {
            if (length($linkname) > 100) {
                warn "$0: omitting file with linkname ",
                     "too long for tar output: $linkname\n";
                return;
            }