perl - 根据解析参数检查条件

Question

我有一个要求，我已经收到了从文件到数组的输入。

例如，如果数组的内容为 2，<,3 分别为 $1、$2 和 $3。

我有一个字符串“2<3”。我需要检查条件的有效性，如果真的 2 是否小于 3。

如果输入对我来说是一个字符串，我如何发送 if() 条件的输入？

我最近被介绍给 Perl，并想探索更多。

Answer 1

如果您的输入很简单（数字、运算符、数字），您可以通过以下方式解决：

#!/usr/bin/perl
use warnings;
use strict;

my $input = shift;
my ($num1, $op, $num2) = $input =~ /([0-9]+) *([<=>]) *([0-9]+)/;
if ('=' eq $op and $num1 == $num2
    or
    '<' eq $op and $num1 < $num2
    or
    '>' eq $op and $num1 > $num2) {
    print "Yes\n";
} else {
    print "No\n";
}

或更短，使用“宇宙飞船”运算符<=>：

#!/usr/bin/perl
use warnings;
use strict;

my @operations = qw(= > <);

my $input = shift;
my ($num1, $op, $num2) = $input =~ /([0-9]+) *([<=>]) *([0-9]+)/;
if ($op eq $operations[$num1 <=> $num2]) {
    print "Yes\n";
} else {
    print "No\n";
}

如果表达式是递归的（即(2+3)>(4+7)），您应该学习解析。我会推荐Parse::RecDescent或Marpa::R2。

Answer 2

正如 Jonathan Leffler 所说，这很危险。你永远不应该运行这样的代码。这是非常危险的。

最简单（也是最危险）的方法当然是eval. 请参阅 Jonathan 在他的评论中链接的文档。

更安全的选择是使用Safe。它创建了一个隔间，将语法的使用限制在您可以预先定义的 Perl 非常特定的部分。这是人们用来制作 IRC 机器人或可以运行 Perl 代码的网站的工具。一个很好的例子是 freenode 上#perl 中的 perlbot。

免责声明：请仔细阅读文档！不要只是复制这些东西。阅读有关操作码的说明！

这是一些示例代码。

use strict; use warnings;
use Safe;
$compartment = new Safe;
$compartment->permit(qw(:base_core));
$result = $compartment->reval(" 2 < 3 ? 1 : 0 ");

Answer 3

虽然你可以做一个花哨的if陈述，但它们往往非常冗长，而且容易出错。

if ('=' eq $op and $num1 == $num2
  or
    '<' eq $op and $num1 < $num2
  or
    '>' eq $op and $num1 > $num2) {
  print "Yes\n";
} else {
  print "No\n";
}

或者（如果你小心的话）你可以使用eval().

# check $input here
...
$input =~ s/[^=]=[^=]/==/;
if( eval $input ){ ...

尽管每次使用时都必须编译每个输入。
以这种方式安全使用它也非常困难。

---

相反，我想向您展示一些高级 Perl 黑客技术。

虽然它确实使用eval()它，但它这样做很安全，因为我完全控制了它编译的内容。

#!/usr/bin/perl
use warnings;
use strict;

our %compare;
our $compare_match;
BEGIN{
  # list of simple ops
  my @ops = qw'< <= == != > >= lt le eq gt ge ne';
  for my $op (@ops){
    $compare{$op} = eval"sub{ \$_[0] $op \$_[1]}";
  }

  push @ops, '='; # for $compare_match
  $compare{'='} = $compare{'=='}; # copy sub

  # longest first
  @ops = sort { length($b) <=> length($a) } @ops;
  local $" #"
    = '|';
  $compare_match = eval"qr{(?:@ops)}";
}

sub check{
  my( $num1, $op, $num2 ) = @_;
  if( @_ == 1 ){
    ($num1,$op,$num2) = 
      $_[0] =~ /([0-9]+) \s* ($compare_match) \s* ([0-9]+)/x;
  } elsif( @_ != 3 ){
    die 'wrong number of arguments'; # could be improved
  }
  unless( $op and exists $compare{$op} ){
    die "unknown op of '$op'"; # could be improved
  }

  # the heart of this implementation
  return $compare{$op}->($num1,$num2);
}

if( check('2<3') ){ # one arg
  print "Yes\n"; # <---
}else{
  print "No\n";
}
if( check('2>3') ){ # one arg
  print "Yes\n";
}else{
  print "No\n"; # <---
}

if( check(qw'2 < 3') ){ # three arg
  print "Yes\n"; # <---
}else{
  print "No\n";
}
if( check(qw'2 > 3') ){ # three arg
  print "Yes\n";
}else{
  print "No\n"; # <---
}

# dies
if( check(qw'2 **** 3') ){ ... }

您应该注意到使用此方法添加更多比较操作是多么容易。
（我所要做的就是将它们添加到@opsin BEGIN{}）