Two choices:
If you are not worried about 'eval' :
#!/usr/bin/perl
use strict;
use warnings;
$SIG{__WARN__} = sub { die $@ };
for my $row (
{ a => 1, b => 2, c => 3, d => 4 },
{ a => 0, b => 2, c => 3, d => 4 },
{ a => 0, b => 2, c => 2, d => 4 },
{ a => 0, b => 2, c => 2, d => 3 },
)
{
use Data::Dump 'dd'; dd 'row', $row;
for my $test ( qw( a>0 a>1 a>2 a>3 d<=3 c>2&d>2 ) )
{
use Data::Dump 'dd'; dd { $test => evaluateRow($test, $row) };
}
print "\n";
}
sub evaluateRow
{
my ($test, $row) = @_;
return eval( $test =~ s(\b[a-z]+\b)( $row->{$&} // '')gier ) ? 1 : 0
+;
}
If you are worried about 'eval' :
#!/usr/bin/perl
use strict;
use warnings;
$SIG{__WARN__} = sub { die $@ };
for my $row (
{ a => 1, b => 2, c => 3, d => 4 },
{ a => 0, b => 2, c => 3, d => 4 },
{ a => 0, b => 2, c => 2, d => 4 },
{ a => 0, b => 2, c => 2, d => 3 },
)
{
use Data::Dump 'dd'; dd 'row', $row;
for my $test ( qw( a>0 a>1 a>2 a>3 d<=3 c>2&d>2 ) )
{
use Data::Dump 'dd'; dd { $test => nonevalRow($test, $row) };
}
print "\n";
}
my $dictionary;
sub error { die $_, s/\G.*//sr =~ tr/\t/ /cr, "^ $_[0] !\n" }
sub want { /\G$_[1]/gc ? shift : error pop }
sub nonevalRow
{
( local $_, $dictionary ) = @_;
$_ .= "\n";
return want(expr(0), "\n", 'Incomplete Parse');
}
sub expr
{
/\G\h+/gc;
my $value =
/\G\d+/gc ? "$&" :
/\G[a-z]\w*/gci ? $dictionary->{"$&"} // error("undefined variable
+ '$&' ") :
/\G\(/gc ? want expr(0), qr/\)/, 'Missing Right Paren' :
/\G\-/gc ? - expr(7) : # unary minus
/\G\+/gc ? + expr(7) : # unary plus
error 'Operand Expected';
$value =
/\G\h+/gc ? $value :
$_[0] <= 6 && /\G\*\*/gcx ? $value ** expr(6) :
$_[0] <= 5 && /\G \* /gcx ? $value * expr(6) :
$_[0] <= 5 && /\G \/ /gcx ? $value / expr(6) :
$_[0] <= 4 && /\G \+ /gcx ? $value + expr(5) :
$_[0] <= 4 && /\G \- /gcx ? $value - expr(5) :
$_[0] <= 3 && /\G <=/gcx ? $value <= expr(4) ? 1 : 0 :
$_[0] <= 3 && /\G >=/gcx ? $value >= expr(4) ? 1 : 0 :
$_[0] <= 3 && /\G < /gcx ? $value < expr(4) ? 1 : 0 :
$_[0] <= 3 && /\G > /gcx ? $value > expr(4) ? 1 : 0 :
$_[0] <= 2 && /\G ==/gcx ? $value == expr(3) ? 1 : 0 :
$_[0] <= 2 && /\G !=/gcx ? $value != expr(3) ? 1 : 0 :
$_[0] <= 1 && /\G & /gcx ? $value & expr(2) :
$_[0] <= 0 && /\G \|/gcx ? $value | expr(1) :
return $value while 1;
}