Perl: is there a way to programmaticly set file test operators? (i.e. -X)

user_3973175 0
Viewed 122

I often do complex file/directory/symlink tests, and am writing a subroutine to do so.

for example, instead of

if (-x $file)

write

my $test = '-x';
if ($x $file)

and I can vary $x to be -f -r -e or whatever.

I have read the file testing documentation thoroughly, https://perldoc.perl.org/functions/-X

and there doesn't appear to be any trick so that this can be done.

I've read File::Find https://perldoc.perl.org/File::Find but I don't want to write a separate subroutine every time I do a search, which would make the code very ugly and long.

Is there anything or any trick that I've missed?

perl
3 Answers

Here is another approach using a dispatch table:

my $file = 'test.txt';
my %ftest = (
    '-x' => sub {-x $_[0]},
    '-f' => sub {-f $_[0]}
);
my $test = '-x';
if ($ftest{$test}->($file)) {
    say "Executable";
}
else {
    say "Not executable";
}
user_21737730

You could use eval:

#!/usr/bin/perl

use strict;
use warnings;

my @tests=qw(r w x o R W X O e z s f d l p S b c t u g k T B M A C);

for my $file (@ARGV) {
    for my $test (@tests) {
        print "-$test $file ";
        my $rv = eval "-${test} \$file";
        $rv = 'undef' unless defined $rv;
        print "$rv\n";
    }
}

Running this script on itself may give this output:

$ ./perltest.pl perltest.pl
-r perltest.pl 1
-w perltest.pl 1
-x perltest.pl 1
-o perltest.pl 1
-R perltest.pl 1
-W perltest.pl 1
-X perltest.pl 1
-O perltest.pl 1
-e perltest.pl 1
-z perltest.pl
-s perltest.pl 316
-f perltest.pl 1
-d perltest.pl
-l perltest.pl
-p perltest.pl
-S perltest.pl
-b perltest.pl
-c perltest.pl
-t perltest.pl undef
-u perltest.pl
-g perltest.pl
-k perltest.pl
-T perltest.pl 1
-B perltest.pl
-M perltest.pl 1.15740740740741e-05
-A perltest.pl 0
-C perltest.pl 1.15740740740741e-05
user_75822470

[ This is an improvement on Ted Lyngmo's solution and Håkon Hægland's solution. ]

You can use eval EXPR to generate code to perform the tests.

Of note, one can take care to avoid perform an expensive stat call for every test.

#!/usr/bin/perl

use strict;
use warnings;
use feature qw( say );

my @tests = split '', 'rwxoRWXOezsfdpSbctugkTBMACl';

my ($qfn) = @ARGV;
   or die("Usage\n");

stat($qfn)
   or die("Can't stat \"$qfn\": $!\n");

for my $test (@tests) {
   my $rv = eval("-$test " . ( $test eq 'l' ? '$qfn' : '_' ));
   say "  -$test: ",  $rv // "[undef]" || 0;
}

If multiple files need to be processed, the number of calls to the expensive eval can be reduced by using it to create a sub.

#!/usr/bin/perl

use strict;
use warnings;
use feature qw( say );

my @tests = split '', 'rwxoRWXOezsfdpSbctugkTBMACl';
my %tests =
   map { $_ => eval("sub { -$_ shift }") }
      @tests;

for my $qfn (@ARGV) {
   stat($qfn)
      or warn("Can't stat \"$qfn\": $!\n"), next;

   say "$qfn:";
   for my $test (@tests) {
      my $rv = $tests{$test}->( $test eq 'l' ? $qfn : *_ );
      say "  -$test: ",  $rv // "[undef]" || 0;
   }
}
user_5899240
Related