view release on metacpan or  search on metacpan

bin/findorule  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;

use File::Find::Object::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 = $_[0];
            $name =~ s/\.pm$//;
            eval "require File::Find::Object::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::Object::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