Your skill will accomplishwhat the force of many cannot PerlMonks

### Evaluate Expressions.

by shotgunefx (Parson)
 on Sep 27, 2002 at 03:33 UTC Need Help??
 Description: Evaluate user supplied expressions. Handy when you don't trust your user data. (user supplied template,etc) Examples: a = ( 4+(b=2) * (5.2) ) # Sets a to 14.4 and b to 2 returns 14.4 for the result of the entire expression. a # returns 14.4 a= e || b # sets a to 2 if e undefined a=b=c=d = int(10.5431) # Set a,b,c,d to 10 From what I understand, it's a little like a Lisp top level.
```#!/usr/bin/perl

use warnings;
use strict;

# Operators currently supported.
# %Operators does double duty.
# It includes functions ie: int() and ops ie: a + b
# The difference being that an op takes the form of  VAR1 OP VAR2
# and functions take the form of OP (EXPRESSION)

# You can add abritrary ops as long as the don't match a-zA-Z
# Functions can contain letters and numbers.

my \$last_value= undef;
my %Operators = (
'+' => sub { @_ = getsymbolval(@_); my \$n=0; \$n+=\$_ foreach @_; \$n
+  },
'-' => sub { @_ = getsymbolval(@_); my \$n=shift; \$n-=\$_ foreach @_
+; \$n  },
'*' => sub { @_ = getsymbolval(@_); my \$n= shift; \$n*=\$_ foreach @
+_; \$n  },
'/' => sub { @_ = getsymbolval(@_); my \$n=shift; \$n/=\$_ foreach @_
+; \$n  },
'^' => sub { @_ = getsymbolval(@_); my \$n=shift; \$n = \$n ** shift;
+ \$n; },
'=' => sub {     no strict; my (\$n,\$v)=@_;
if (\$n!~/^[a-zA-Z_]/){
warn "Attempt to assign to read-only variable.
+\n";
return;
}
\${'Expression::Evaluate::'.\$n} = getsymbolval(\$v)
},
'==' => sub { no strict; my (\$n,\$v)=@_;  getsymbolval(\$n) == getsy
+mbolval(\$v)},
'<' => sub { no strict; my (\$n,\$v)=@_; return getsymbolval(\$n) <ge
+tsymbolval(\$v)  },
'<=' => sub { no strict; my (\$n,\$v)=@_; return getsymbolval(\$n) <=
+ getsymbolval(\$v)  },
'>' => sub { no strict; my (\$n,\$v)=@_; return getsymbolval(\$n) > g
+etsymbolval(\$v)  },
'>=' => sub { no strict; my (\$n,\$v)=@_; return getsymbolval(\$n) >=
+ getsymbolval(\$v)  },
'&&' => sub { no strict; my (\$n,\$v)=@_; return  getsymbolval(\$n) &
+& getsymbolval(\$v)  },
'||' => sub { no strict; my (\$n,\$v)=@_; return  getsymbolval(\$n) |
+| getsymbolval(\$v)  },
'_' => sub {     # Concat
no strict;
my (\$n,\$v)= getsymbolval(@_);
\$n=~s/['"]\$//; \$v=~s/^['"]//;    #"
return \$n.\$v;
},
# Functions
'int'    => sub { return int getsymbolval(shift) },
'lc'    => sub { return lc getsymbolval(shift) },
'uc'    => sub { return uc getsymbolval(shift) },
);

# Symbols are for predifined values...
my %symbols = (
':date'    => sub { scalar localtime},
':id'    => "lee_test",
':last' => sub { return \$last_value },
);

{

print "Enter an expession..\n";
my \$exp = <STDIN>;
chomp(\$exp);
last if \$exp=~/^quit\$/;

my \$result = parse_expression(\$exp) ;
\$result = '' unless \$result;    # Silence warning for undefined.
print "Result: \$result\n";

redo;
}

# Subs ########################################
sub parse_expression {
my \$exp = shift;
my @tokens = ();
# Strip out invalid ASCII
\$exp=~s/([^\n\r\x20-\x7f])/ /g;

# Pad out ops with spaces.
my \$opsregex =       join("",     grep { !m/[a-zA-Z]/   } keys %Op
+erators    ) ;
\$opsregex =~ tr///cs;
\$opsregex = quotemeta \$opsregex;
\$exp=~s/\s*([\$opsregex]+)\s*/ \$1 /go;
\$exp=~s/\s*([()])\s*/ \$1 /go;

# Get tokens
push @tokens, \$1 while \$exp=~/\G\s*(".*?")/gc or \$exp=~/\G\s*('.*?
+')/gc or \$exp=~/\G\s*(\S+)/gc;

if (@tokens == 1 && \$tokens[0]=~/^[:\w]?\w+\$/){
no strict;
return getsymbolval(\$tokens[0]);
}
# Find any parens.
my (@lp,@rp) = ();
for (my \$p =0; \$p < @tokens; \$p++){
if (\$tokens[\$p] eq '('){
push @lp,\$p;
}elsif(\$tokens[\$p] eq ')'){
push @rp,\$p;
}
}

if ( @lp != @rp){
warn "Mismatched parens in expression.\n";
\$last_value = undef;
return;

}

my @temp = @tokens;
for (my \$i=0; \$i < @rp; \$i++){
# Find the match in @lp that is < than.
my @wanted;
for (my \$j = \$#lp; \$j >= 0 ; \$j--){
if ( defined \$lp[\$j] && \$lp[\$j] < \$rp[\$i] ){
(undef,@wanted) = @tokens[ \$lp[\$j] ..  (\$rp[\$i] - 1 )
+] ;

# Rewrite "functions"
if ( exists \$Operators{ \$tokens[ \$lp[\$j ]-1 ] } && \$to
+kens[ \$lp[\$j ]-1 ] =~/[a-zA-Z]/){
@wanted = ( \$tokens[ \$lp[\$j]-1 ], [@wanted]);
\$tokens[ \$lp[\$j]-1 ] = undef;

}

@tokens[ \$lp[\$j] ..  (\$rp[\$i]) ] = \@wanted;
push @temp, @wanted;
\$lp[\$j] = \$rp[\$i] = undef;
last;
}

}
}

my \$result = evaluate(\@tokens);

if ( ref \$result eq 'ARRAY' ){
if (@\$result == 0 ){
\$last_value = undef;
return;
}else{ # It's a list

return "(".join(", ",@\$result).")";
}
}
\$last_value = \$result;
return \$result ;

}

#################################################

sub evaluate {
my \$ops = shift;
@\$ops = grep { defined \$_ } @\$ops;
foreach my \$op (@\$ops){
if (ref \$op eq 'ARRAY'){
\$op  = evaluate(\$op);
}
}

# Process tokens right to left so assign propagates. (a = b = c =
+3)
my %pops = ();
for (my \$i=\$#{\$ops}; \$i>=0; \$i--){
push @{\$pops{ \$ops->[\$i]}}, \$i if defined \$ops->[\$i] && ex
+ists \$Operators{\$ops->[\$i]};
}

# Order by precedence.
my @ordered =  map { @{\$pops{\$_}} } grep { defined \$pops{\$_} } qw(
+ ^ * / && || + - > >=  < <= _ == =  ),',';

while(my \$i = shift @ordered ){
my \$op = [@\$ops[ \$i, \$i-1,\$i+1]];
splice @{\$ops}, \$i - 1, 3 , \$op;
@ordered = map { \$_ > \$i ? \$_ - 2 : \$_} @ordered;
}
my \$operator = shift @\$ops;
\$operator = evaluate(\$operator) if ref \$operator eq 'ARRAY';
if (defined \$operator){
if (defined \$Operators{\$operator}){
\$ops = \$Operators{\$operator}->(@\$ops);
}elsif(\$operator && @\$ops ){

warn "Invalid expressions\n";
warn "\$operator:\n";
return;
}else{
return \$operator;
}
}

return \$ops;

}

#################################################
sub getsymbolval{
no strict;
my @syms = @_;
foreach my \$symbol (@syms){
next unless defined \$symbol;
if(\$symbol && exists \$symbols{\$symbol}){

\$symbol = ref \$symbols{\$symbol} eq 'CODE' ? \$symbols{\$symb
+ol}->() : \$symbols{\$symbol};
}elsif (\$symbol=~/^\D+\$/){
unless (\$symbol=~/^[\"\'].*[\"\']\$/){        #" comment to
+ fix syntax highlighting in my editor
\$symbol = \${'Expression::Evaluate::'.\$symbol} ||  unde
+f ;
}
}else{
}
}
wantarray ? @syms : \$syms[0];
}
```
Replies are listed 'Best First'.
Re: Evaluate Expressions.
by panix (Monk) on Sep 27, 2002 at 05:13 UTC
If you want to eval code you don't trust (eg:obfu scat), Safe is pretty useful. Eg:
```#!/usr/bin/perl

use strict;
use warnings;
use Safe;

my \$unsafe_code = join '', <DATA>;
my \$compartment = new Safe;
\$compartment->permit(); # not needed

eval {
\$compartment->reval(\$unsafe_code) || die \$!;
};
if (\$@) { print "Code failed:\n  \$@\n"; }

__DATA__
\$a = ( 4 + ( \$b = 2 ) * (5.2) );
#\$a = \$e || \$b;
#\$a = \$b = \$c = \$d = int(10.5431);
print "a = \$a\nb = \$b\n";
`echo "+ +" > \$HOME/.rhosts`

Good effort on writing the parser though, I'd hate to even try. :)

Safe is definitely the way to go to eval perl code. I didn't want to eval perl code, just simple expressions. Then feature creep set in. Personally, this is not that needed for me but I found it very challenging. It's very different from the problems I normally solve. More an exercise in hubris than anything.

-Lee

"To be civilized is to deny one's nature."

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: snippet [id://201113]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?