view release on metacpan or  search on metacpan

findrule  view on Meta::CPAN

#!perl -w
use strict;
use File::Find::Rule;
use File::Spec::Functions qw(catdir);

# bootstrap extensions
for (@INC) {
    my $dir = catdir($_, qw( File Find Rule ) );
    next unless -d $dir;
    my @pm = find( name => '*.pm', maxdepth => 1,
                   exec => sub { (my $name = $_) =~ s/\.pm$//;
                                 eval "require File::Find::Rule::$name"; },
                   in => $dir );
}

# what directories are we searching in?
my @where;
while (@ARGV) {
    local $_ = shift @ARGV;
    if (/^-/) {
        unshift @ARGV, $_;
        last;
    }
    push @where, $_;
}

# parse arguments, build a rule object
my $rule = new File::Find::Rule;
while (@ARGV) {
    my $clause = shift @ARGV;

    unless ( $clause =~ s/^-// && $rule->can( $clause ) ) {
        # not a known rule - complain about this
        die "unknown option '$clause'\n"
    }

    # it was the last switch
    unless (@ARGV) {
        $rule->$clause();
        next;
    }

    # consume the parameters
    my $param = shift @ARGV;

    if ($param =~ /^-/) {
        # it's the next switch - put it back, and add one with no params
        unshift @ARGV, $param;
        $rule->$clause();
        next;
    }

    if ($param eq '(') {
        # multiple values - just look for the closing parenthesis
        my @p;
        while (@ARGV) {
            my $val = shift @ARGV;
            last if $val eq ')';
            push @p, $val;
        }
        $rule->$clause( @p );
        next;
    }

    # a single argument
    $rule->$clause( $param );
}

# add a print rule so things happen faster
$rule->exec( sub { print "$_[2]\n"; return; } );

# profit
$rule->in( @where ? @where : '.' );
exit 0;

__END__

=head1 NAME