view release on metacpan or  search on metacpan

inc/File/Find/Rule.pm  view on Meta::CPAN

sub new {
    my $referent = shift;
    my $class = ref $referent || $referent;
    bless {
        rules    => [],  # [0]
        subs     => [],  # [1]
        iterator => [],
        extras   => {},
        maxdepth => undef,
        mindepth => undef,
    }, $class;
}

sub _force_object {
    my $object = shift;
    $object = $object->new()
      unless ref $object;
    $object;
}

#line 139

sub _flatten {
    my @flat;
    while (@_) {
        my $item = shift;
        ref $item eq 'ARRAY' ? push @_, @{ $item } : push @flat, $item;
    }
    return @flat;
}

sub name {
    my $self = _force_object shift;
    my @names = map { ref $_ eq "Regexp" ? $_ : glob_to_regex $_ } _flatten( @_ );

    push @{ $self->{rules} }, {
        rule => 'name',
        code => join( ' || ', map { "m($_)" } @names ),
        args => \@_,
    };

    $self;
}

#line 195

use vars qw( %X_tests );
%X_tests = (
    -r  =>  readable           =>  -R  =>  r_readable      =>
    -w  =>  writeable          =>  -W  =>  r_writeable     =>
    -w  =>  writable           =>  -W  =>  r_writable      =>
    -x  =>  executable         =>  -X  =>  r_executable    =>
    -o  =>  owned              =>  -O  =>  r_owned         =>

    -e  =>  exists             =>  -f  =>  file            =>
    -z  =>  empty              =>  -d  =>  directory       =>
    -s  =>  nonempty           =>  -l  =>  symlink         =>
                               =>  -p  =>  fifo            =>
    -u  =>  setuid             =>  -S  =>  socket          =>
    -g  =>  setgid             =>  -b  =>  block           =>
    -k  =>  sticky             =>  -c  =>  character       =>
                               =>  -t  =>  tty             =>
    -M  =>  modified                                       =>
    -A  =>  accessed           =>  -T  =>  ascii           =>
    -C  =>  changed            =>  -B  =>  binary          =>
   );

for my $test (keys %X_tests) {
    my $sub = eval 'sub () {
        my $self = _force_object shift;
        push @{ $self->{rules} }, {
            code => "' . $test . ' \$_",
            rule => "'.$X_tests{$test}.'",
        };
        $self;
    } ';
    no strict 'refs';
    *{ $X_tests{$test} } = $sub;
}


#line 248

use vars qw( @stat_tests );
@stat_tests = qw( dev ino mode nlink uid gid rdev
                  size atime mtime ctime blksize blocks );
{
    my $i = 0;
    for my $test (@stat_tests) {
        my $index = $i++; # to close over
        my $sub = sub {
            my $self = _force_object shift;

            my @tests = map { Number::Compare->parse_to_perl($_) } @_;

            push @{ $self->{rules} }, {
                rule => $test,
                args => \@_,
                code => 'do { my $val = (stat $_)['.$index.'] || 0;'.
                  join ('||', map { "(\$val $_)" } @tests ).' }',
            };
            $self;
        };
        no strict 'refs';
        *$test = $sub;
    }
}

#line 289

sub any {
    my $self = _force_object shift;
    my @rulesets = @_;

    push @{ $self->{rules} }, {
        rule => 'any',
        code => '(' . join( ' || ', map {
            "( " . $_->_compile( $self->{subs} ) . " )"
        } @_ ) . ")",
        args => \@_,
    };
    $self;
}

*or = \&any;

#line 318

sub not {
    my $self = _force_object shift;
    my @rulesets = @_;

    push @{ $self->{rules} }, {
        rule => 'not',
        args => \@rulesets,
        code => '(' . join ( ' && ', map {
            "!(". $_->_compile( $self->{subs} ) . ")"
        } @_ ) . ")",
    };
    $self;
}

*none = \¬

#line 340