1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
|
;# $Id: eval.pl 1 2006-08-24 13:24:12Z rmanfredi $
;#
;# Copyright (c) 1990-2006, Raphael Manfredi
;#
;# You may redistribute only under the terms of the Artistic License,
;# as specified in the README file that comes with the distribution.
;# You may reuse parts of this distribution only within the terms of
;# that same Artistic License; a copy of which may be found at the root
;# of the source tree for mailagent 3.0.
;#
;# $Log: eval.pl,v $
;# Revision 3.0.1.2 1995/01/03 18:07:10 ram
;# patch24: simplified hash table initialization -- code still unused
;#
;# Revision 3.0.1.1 1994/09/22 14:18:11 ram
;# patch12: replaced all deprecated 'do sub' calls with '&sub'
;#
;# Revision 3.0 1993/11/29 13:48:42 ram
;# Baseline for mailagent 3.0 netwide release.
;#
;#
#
# The built-in expression interpreter
#
# Initialize the interpreter
sub init_interpreter {
&set_priorities; # Fill in %Priority
&set_functions; # Fill in %Function
$macro_T = "the Epoch"; # Default value for %T macro substitution
}
# Priorities for operators -- magic numbers :-)
# An operator with higher priority will evaluate before another with a lower
# one. For instance, given the priorities listed hereinafter, a && b == c
# would evaluate as a && (b == c).
sub set_priorities {
%Priority = (
'&&', 4,
'||', 3,
'>=', 6,
'<=', 6,
'<', 6,
'>', 6,
'==', 6,
'!=', 6,
'=~', 6,
'!~', 6,
);
}
# Perl functions handling operators
sub set_functions {
%Function = (
'&&', 'f_and', # Boolean AND
'||', 'f_or', # Boolean OR
'>=', 'f_ge', # Greated or equal
'<=', 'f_le', # Lesser or equal
'>', 'f_gt', # Greater than
'<', 'f_lt', # Lesser than
'==', 'f_eq', # Equal as strings
'!=', 'f_ne', # Different (not equal)
'=~', 'f_match', # Match
'!~', 'f_nomatch', # No match
);
}
# Print error messages -- asssumes $unit and $. correctly set.
sub error {
&add_log("ERROR @_") if $loglvl > 1;
}
# Add a value on the stack, modified by all the monadic operators.
# We use the locals @val and @mono from eval_expr.
sub push_val {
local($val) = shift(@_);
while ($#mono >= 0) {
# Cheat... the only monadic operator is '!'.
pop(@mono);
$val = !$val;
}
push(@val, $val);
}
# Execute a stacked operation, leave result in stack.
# We use the locals @val and @op from eval_expr.
# If the value stack holds only one operand, do nothing.
sub execute {
return unless $#val > 0;
local($op) = pop(@op); # The operator
local($val2) = pop(@val); # Right value in algebraic notation
local($val1) = pop(@val); # Left value in algebraic notation
local($func) = $Function{$op}; # Function to be called
¯os_subst(*val1); # Expand macros
¯os_subst(*val2);
push(@val, eval("&$func($val1, $val2)") ? 1: 0);
}
# Given an operator, either we add it in the stack @op, because its
# priority is lower than the one on top of the stack, or we first execute
# the stacked operations until we reach the end of stack or an operand
# whose priority is lower than ours.
# We use the locals @val and @op from eval_expr.
sub update_stack {
local($op) = shift(@_); # Operator
if (!$Priority{$op}) {
&error("illegal operator $op");
return;
} else {
if ($#val < 0) {
&error("missing first operand for '$op' (diadic operator)");
return;
}
# Because of a bug in perl 4.0 PL19, I'm using a loop construct
# instead of a while() modifier.
while (
$Priority{$op[$#op]} > $Priority{$op} # Higher priority op
&& $#val > 0 # At least 2 values
) {
&execute; # Execute an higer priority stacked operation
}
push(@op, $op); # Everything at higher priority has been executed
}
}
# This is the heart of our little interpreter. Here, we evaluate
# a logical expression and return its value.
sub eval_expr {
local(*expr) = shift(@_); # Expression to parse
local(@val) = (); # Stack of values
local(@op) = (); # Stack of diadic operators
local(@mono) =(); # Stack of monadic operators
local($tmp);
$_ = $expr;
while (1) {
s/^\s+//; # Remove spaces between words
# A perl statement <<command>>
if (s/^<<//) {
if (s/^(.*)>>//) {
&push_val((system
('perl','-e', "if ($1) {exit 0;} else {exit 1;}"
))? 0 : 1);
} else {
&error("incomplete perl statement");
}
}
# A shell statement <command>
elsif (s/^<//) {
if (s/^(.*)>//) {
&push_val((system
("if $1 >/dev/null 2>&1; then exit 0; else exit 1; fi"
))? 0 : 1);
} else {
&error("incomplete shell statement");
}
}
# The '(' construct
elsif (s/^\(//) {
&push_val(&eval_expr(*_));
# A final '\' indicates an end of line
&error("missing final parenthesis") if !s/^\\//;
}
# Found a ')' or end of line
elsif (/^\)/ || /^$/) {
s/^\)/\\/; # Signals: left parenthesis found
$expr = $_; # Remove interpreted stuff
&execute while $#val > 0; # Executed stacked operations
while ($#op >= 0) {
$_ = pop(@op);
&error("missing second operand for '$_' (diadic operator)");
}
return $val[0];
}
# Diadic operators
elsif (s/^(\|\||&&|>=|<=|>|<|==|!=|=|\/=)//) {
&update_stack($1);
}
# Unary operator '!'
elsif (s/^!//) {
push(@mono,'!');
}
# Everything else is a value which stands for itself (atom)
elsif (s/^([\w'"%]+)//) {
&push_val($1);
}
# Syntax error
else {
print "Syntax error: remaining is >>>$_<<<\n";
$_ = "";
}
}
}
# Call eval_expr and check that everything is ok (e.g. the stack must be empty)
sub evaluate {
local($val); # Value returned
local(*expr) = shift(@_); # Expression to be parsed
while ($expr) {
$val = &eval_expr(*expr); # Expression will be modified
print "extra closing parenthesis ignored.\n" if $expr =~ s/^\\\)*//;
$expr = $val . $expr if $expr ne '';
}
$val;
}
#
# Boolean functions used by the interpreter. They all take two arguments
# and return 0 if false and 1 if true.
#
sub f_and { $_[0] && $_[1]; } # Boolean AND
sub f_or { $_[0] || $_[1]; } # Boolean OR
sub f_ge { $_[0] >= $_[1]; } # Greater or equal
sub f_le { $_[0] <= $_[1]; } # Lesser or equal
sub f_lt { $_[0] < $_[1]; } # Lesser than
sub f_gt { $_[0] > $_[1]; } # Greater than
sub f_eq { "$_[0]" eq "$_[1]"; } # Equal
sub f_ne { "$_[0]" ne "$_[1]"; } # Not equal
sub f_match { $_[0] =~ /$_[1]/; } # Pattern matches
sub f_nomatch { $_[0] !~ /$_[1]/; } # Pattern does not match
|
