view release on metacpan or  search on metacpan

script/find2perl  view on Meta::CPAN

#! perl

use strict;
use vars qw/$statdone/;
use File::Spec::Functions 'curdir';
use Config;
my ($perlpath) = $Config{perlpath};
my $startperl = "#! $perlpath -w";

sub tab ();
sub n ($$);
sub fileglob_to_re ($);
sub quote ($);

my @roots = ();
while ($ARGV[0] =~ /^[^-!(]/) {
    push(@roots, shift);
}
@roots = (curdir()) unless @roots;
for (@roots) { $_ = quote($_) }
my $roots = join(', ', @roots);

my $find = "find";
my $indent_depth = 1;
my $stat = 'lstat';
my $decl = '';
my $flushall = '';
my $initfile = '';
my $initnewer = '';
my $out = '';
my $declaresubs = "sub wanted;\n";
my %init = ();
my ($follow_in_effect,$Skip_And) = (0,0);
my $print_needed = 1;

while (@ARGV) {
    $_ = shift;
    s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
    if ($_ eq '(') {
        $out .= tab . "(\n";
        $indent_depth++;
        next;
    } elsif ($_ eq ')') {
        --$indent_depth;
        $out .= tab . ")";
    } elsif ($_ eq 'follow') {
        $follow_in_effect= 1;
        $stat = 'stat';
        $Skip_And= 1;
    } elsif ($_ eq '!') {
        $out .= tab . "!";
        next;
    } elsif (/^(i)?name$/) {
        $out .= tab . '/' . fileglob_to_re(shift) . "/s$1";
    } elsif (/^(i)?path$/) {
        $out .= tab . '$File::Find::name =~ /' . fileglob_to_re(shift) . "/s$1";
    } elsif ($_ eq 'perm') {
        my $onum = shift;
        $onum =~ /^-?[0-7]+$/
            || die "Malformed -perm argument: $onum\n";
        $out .= tab;
        if ($onum =~ s/^-//) {
            $onum = sprintf("0%o", oct($onum) & 07777);
            $out .= "((\$mode & $onum) == $onum)";
        } else {
            $onum =~ s/^0*/0/;
            $out .= "((\$mode & 0777) == $onum)";
        }
    } elsif ($_ eq 'type') {
        (my $filetest = shift) =~ tr/s/S/;
        $out .= tab . "-$filetest _";

script/find2perl  view on Meta::CPAN

        flush($fh, \$tarout{$fh}, 10240)
            while ($l = length($tarout{$fh})) >= 10240;
        while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
            my $slop = length($tarout{$fh}) % 512;
            $tarout{$fh} .= "\0" x (512 - $slop) if $slop;
            flush($fh, \$tarout{$fh}, 10240);
            $l = length($tarout{$fh});
        }
        close IN;
    }
}

sub tflushall () {
    my $len;
    for my $fh (keys %tarout) {
        $len = 10240 - length($tarout{$fh});
        $len += 10240 if $len < 1024;
        $tarout{$fh} .= "\0" x $len;
        flush($fh, \$tarout{$fh}, 10240);
    }
}

END
}

exit;

############################################################################

sub tab () {
    my $tabstring;

    $tabstring = "\t" x ($indent_depth/2) . ' ' x ($indent_depth%2 * 4);
    if (!$statdone) {
        if ($_ =~ /^(?:name|print|prune|exec|ok|\(|\))/) {
            $init{delayedstat} = 1;
        } else {
            my $statcall = '(($dev,$ino,$mode,$nlink,$uid,$gid) = '
                         . $stat . '($_))';
            if (exists $init{saw_or}) {
                $tabstring .= "(\$nlink || $statcall) &&\n" . $tabstring;
            } else {
                $tabstring .= "$statcall &&\n" . $tabstring;
            }
            $statdone = 1;
            $init{declarestat} = 1;
        }
    }
    $tabstring =~ s/^\s+/ / if $out =~ /!$/;
    $tabstring;
}

sub fileglob_to_re ($) {
    my $x = shift;
    $x =~ s#([./^\$()+])#\\$1#g;
    $x =~ s#\*#.*#g;
    $x =~ s#\?#.#g;
    "^$x\\z";
}

sub n ($$) {
    my ($pre, $n) = @_;
    $n =~ s/^-/< / || $n =~ s/^\+/> / || $n =~ s/^/== /;
    $n =~ s/ 0*(\d)/ $1/;
    "($pre $n)";
}

sub quote ($) {
    my $string = shift;
    $string =~ s/\\/\\\\/g;
    $string =~ s/'/\\'/g;
    "'$string'";
}

__END__

=head1 NAME

find2perl - translate find command lines to Perl code

=head1 SYNOPSIS

	find2perl [paths] [predicates] | perl

=head1 DESCRIPTION

find2perl is a little translator to convert find command lines to
equivalent Perl code.  The resulting code is typically faster than
running find itself.

"paths" are a set of paths where find2perl will start its searches and
"predicates" are taken from the following list.

=over 4

=item C<! PREDICATE>

Negate the sense of the following predicate.  The C<!> must be passed as
a distinct argument, so it may need to be surrounded by whitespace and/or
quoted from interpretation by the shell using a backslash (just as with
using C<find(1)>).

=item C<( PREDICATES )>

Group the given PREDICATES.  The parentheses must be passed as distinct
arguments, so they may need to be surrounded by whitespace and/or
quoted from interpretation by the shell using a backslash (just as with
using C<find(1)>).

=item C<PREDICATE1 PREDICATE2>

True if _both_ PREDICATE1 and PREDICATE2 are true; PREDICATE2 is not
evaluated if PREDICATE1 is false.

=item C<PREDICATE1 -o PREDICATE2>

True if either one of PREDICATE1 or PREDICATE2 is true; PREDICATE2 is
not evaluated if PREDICATE1 is true.

=item C<-follow>