Perl：有没有一种方法可以编程设置文件测试运算符？（例如-X）

Question

我往往会进行复杂的文件/目录/符号链接测试，并编写一个子程序来实现。

例如，不要写成： if (-x $file) 而应该写成：

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

我可以把$x变成-f -r -e或其他什么。

我已经彻底阅读了测试文档，https://perldoc.perl.org/functions/-X，但似乎没有任何技巧可以实现这一点。

我已经阅读了File::Find的https://perldoc.perl.org/File::Find，但我不想每次搜索时都编写一个单独的子例程，这会使代码非常丑陋而冗长。

我有漏掉的东西或技巧吗？

- con

Answer 1

以下是使用调度表的另一种方法:

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";
}

- Håkon Hægland

---

你甚至可以使用 eval 来构建调度表。my %ftest = map { $_ => eval "sub { $_ shift }" } qw( -x -f -d -e -z -s ); - tobyink

Answer 2

[这是对Ted Lyngmo的方案和Håkon Hægland的方案的改进。]

你可以使用eval EXPR来生成代码来执行测试。

值得注意的是，可以避免每个测试都执行一次昂贵的stat调用。

#!/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;
}

如果有多个文件需要处理，可以通过使用 eval 创建子程序来减少对昂贵的 eval 的调用次数。

#!/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;
   }
}

- ikegami

---

感谢您的解决方案！它通常比重复评估运行得更快。_*的含义是什么？测试如何返回$l？ - con

“_*”的意思是什么？“-f _”简称为“-f _”。代码中不能在其他地方使用“_”，因此我不得不使用“_”。至于“-f _”的含义，在文档中已经很清楚了（https://perldoc.perl.org/functions/-X）。请搜索“underline”一词。 - ikegami

关于“*how does the test return $l?*”这个问题，我不理解。首先，在代码中没有任何地方出现$l。 - ikegami

Answer 3

你可以使用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";
    }
}

在自身上运行此脚本可能会产生以下输出：

$ ./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

- Ted Lyngmo

---

my @tests = split '', 'rwxoRWXOezsfdlpSbctugkTBMAC'; - Polar Bear

@PolarBear 是的，确实可以节省一些字符 :-) - Ted Lyngmo

@PolarBear 是的。我不确定 OP 会如何使用它。我只是想展示可以为 OP 的 my $test = '-x'; if ($x $file) 情况制作一个通用测试器。 - Ted Lyngmo

@PolarBear 是的，Håkon的回答肯定有一些价值。人们也可以调用stat并一次返回所有数据，然后从中选择，这就是perl的-X测试所做的。我甚至认为perl在内部缓存了stat，因此上面的循环可能通过一个stat解决...如果我记得正确的话。多年来我没有经常使用perl... - Ted Lyngmo

@con，我在这个答案中修复了一个代码注入漏洞。如果你正在使用这个答案，你应该进行相似的代码调整。 - ikegami