view release on metacpan or  search on metacpan

lib/File/Find/Declare.pm  view on Meta::CPAN

        } elsif($directive eq 'r_writable') {
            return 0 if -W $file;
        } elsif($directive eq 'executable') {
            return 0 if -x $file;
        } elsif($directive eq 'r_executable') {
            return 0 if -X $file;
        } elsif($directive eq 'owned') {
            return 0 if -o $file;
        } elsif($directive eq 'r_owned') {
            return 0 if -O $file;
        } elsif($directive eq 'exists') {
            return 0 if -e $file;
        } elsif($directive eq 'file') {
            return 0 if -f $file;
        } elsif($directive eq 'empty') {
            return 0 if -z $file;
        } elsif($directive eq 'directory') {
            return 0 if -d $file;
        } elsif($directive eq 'nonempty') {
            return 0 if -s $file;
        } elsif($directive eq 'symlink') {
            return 0 if -l $file;
        } elsif($directive eq 'fifo') {
            return 0 if -p $file;
        } elsif($directive eq 'setuid') {
            return 0 if -u $file;
        } elsif($directive eq 'socket') {
            return 0 if -S $file;
        } elsif($directive eq 'setgid') {
            return 0 if -g $file;
        } elsif($directive eq 'block') {
            return 0 if -b $file;
        } elsif($directive eq 'sticky') {
            return 0 if -k $file;
        } elsif($directive eq 'character') {
            return 0 if -c $file;
        } elsif($directive eq 'tty') {
            return 0 if -t $file;
        } elsif($directive eq 'modified') {
            return 0 if -M $file;
        } elsif($directive eq 'accessed') {
            return 0 if -A $file;
        } elsif($directive eq 'ascii') {
            return 0 if -T $file;
        } elsif($directive eq 'changed') {
            return 0 if -C $file;
        } elsif($directive eq 'binary') {
            return 0 if -B $file;
        }
    }
    
    return 1;
}

sub _test_owner { #ANY
    my ($self, $file) = @_;
    
    if(!$self->has_owner()) { return 1; }
    
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($file);
    my $name = getpwuid($uid);
    
    foreach my $owner (@{$self->owner()}) {
        return 1 if $owner eq $uid || $owner eq $name;
    }
    
    return 0;
}

sub _test_group { #ANY
    my ($self, $file) = @_;
    
    if(!$self->has_group()) { return 1; }
    
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($file);
    my $name = getgrgid($gid);
    
    foreach my $group (@{$self->group()}) {
        return 1 if $group eq $gid || $group eq $name;
    }
    
    return 0;
}

sub _test_perms { #ANY
    my ($self, $file) = @_;
    
    if(!$self->has_perms()) { return 1; }
    
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($file);
    $mode = $mode & 07777;
    $mode = sprintf('%03o', $mode);
    
    foreach my $perm (@{$self->perms()}) {
        return 1 if $mode == $perm || $mode eq _perm_string_to_octal($perm);
    }
    
    return 0;
}

sub _perm_string_to_octal {
    my $str = shift;
    
    if($str =~ m/^([r-][w-][x-])([r-][w-][x-])([r-][w-][x-])$/) {
    
        my $owner = $1;
        my $group = $2;
        my $other = $3;
        
        my $vals = {
            '---' => 0,
            '--x' => 1,
            '-w-' => 2,
            '-wx' => 3,
            'r--' => 4,
            'r-x' => 5,
            'rw-' => 6,
            'rwx' => 7,
        };
        
        return $vals->{$owner} * 100 + $vals->{$group} * 10 + $vals->{$other};