2 # Copyright (C) 1998 Jeff R. Allen and WebTV Networks, Inc.
3 # Copyright (C) 2002 Stanislav Sinyagin
5 # This program is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 2 of the License, or
8 # (at your option) any later version.
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
19 # $Id: RPN.pm,v 1.1 2010-12-27 00:03:40 ivan Exp $
20 # Stanislav Sinyagin <ssinyagin@yahoo.com>
22 # a simple little RPN calculator -- implements the same operations
25 # This file is based on Cricket's RPM.pm
34 # Each RPN operator is defined by an array reference with the
35 # following elements: <number of args>, <subroutine>, <accepts undef>
38 '+' => [ 2, sub{ $_[0] + $_[1]; } ],
39 '-' => [ 2, sub{ $_[0] - $_[1]; } ],
40 '*' => [ 2, sub{ $_[0] * $_[1]; } ],
41 '/' => [ 2, sub{ $_[0] / $_[1]; } ],
42 '%' => [ 2, sub{ $_[0] % $_[1]; } ],
43 'MOD' => [ 2, sub{ $_[0] % $_[1]; } ],
44 'SIN' => [ 1, sub{ sin($_[0]->bsstr()); } ],
45 'COS' => [ 1, sub{ cos($_[0]->bsstr()); } ],
46 'LOG' => [ 1, sub{ log($_[0]); } ],
47 'EXP' => [ 1, sub{ $_[0]->exponent() } ],
48 'FLOOR' => [ 1, sub{ $_[0]->bfloor(); } ],
49 'CEIL' => [ 1, sub{ $_[0]->bceil(); } ],
50 'LT' => [ 2, sub{ ($_[0] < $_[1]) ? 1:0; } ],
51 'LE' => [ 2, sub{ ($_[0] <= $_[1]) ? 1:0; } ],
52 'GT' => [ 2, sub{ ($_[0] > $_[1]) ? 1:0; } ],
53 'GE' => [ 2, sub{ ($_[0] >= $_[1]) ? 1:0; } ],
54 'EQ' => [ 2, sub{ ($_[0] == $_[1]) ? 1:0; } ],
55 'IF' => [ 3, sub{ defined($_[0]) ? ($_[0] ? $_[1] : $_[2]) : undef; }, 1],
56 'MIN' => [ 2, sub{ ($_[0] < $_[1]) ? $_[0] : $_[1]; } ],
57 'MAX' => [ 2, sub{ ($_[0] > $_[1]) ? $_[0] : $_[1]; } ],
58 'UN' => [ 1, sub{ defined($_[0]) ? $_[0]->is_nan() : 1; }, 1 ],
59 'UNKN' => [ 0, sub{ undef; } ],
60 # Operators not defined in RRDtool graph
61 'NE' => [ 2, sub{ ($_[0] != $_[1]) ? 1:0; } ],
62 'AND' => [ 2, sub{ ($_[0] and $_[1]) ? 1:0; } ],
63 'OR' => [ 2, sub{ ($_[0] or $_[1]) ? 1:0; } ],
64 'NOT' => [ 1, sub{ (not $_[0]) ? 1:0; } ],
65 'ABS' => [ 1, sub{ abs($_[0]); } ],
66 'NOW' => [ 0, sub{ time(); } ],
67 'DUP' => [ 1, sub{ ($_[0], $_[0]);}, 1 ],
68 'EXC' => [ 2, sub{ ($_[1], $_[0]); }, 1 ],
69 'NUM' => [ 1, sub{ defined($_[0]) ? $_[0] : 0; }, 1 ],
70 'INF' => [ 0, sub{ Math::BigFloat->binf(); } ],
71 'NEGINF' => [ 0, sub{ Math::BigFloat->binf('-'); } ]
79 bless( $self, $type );
80 $self->{'stack'} = [];
90 my $n_args = $operators->{$op}->[0];
91 my $action = $operators->{$op}->[1];
92 my $acceptsUndefined = $operators->{$op}->[2];
95 for( my $i = 0; $i < $n_args; $i++ )
97 my $arg = $self->popStack();
98 if( defined( $arg ) or $acceptsUndefined )
107 $self->pushStack( $allDefined ? &{$action}(reverse @args) : undef );
116 if( scalar( @{$self->{'stack'}} ) == 0 )
118 Warn("Stack underflow");
122 $ret = pop( @{$self->{'stack'}} );
133 push( @{$self->{'stack'}}, @items );
141 my $callback = shift;
143 # Debug("Translating RPN: $string");
146 foreach $item ( split( /,/, $string ) )
148 if( $item =~ /^\{([^\}]*)\}$/ )
152 if( $noderef =~ s/\(([^\)]+)\)// )
156 my $value = &{$callback}( $noderef, $timeoffset );
157 $value = 'UNKN' unless defined( $value );
158 # Debug("$item translated into $value");
161 elsif( $item eq 'MOD' )
163 # In Torrus parameter value, percent sign is reserved for
164 # parameter expansion. Rrdtool understands % only.
167 push( @new_items, $item );
170 $string = join( ',', @new_items );
171 # Debug("RPN translated: $string");
180 my $callback = shift;
182 # Debug("Input RPN: $string");
184 if( index( $string, '{' ) >= 0 )
186 $string = $self->translate( $string, $callback );
190 foreach $item ( split( /,/, $string ) )
192 if( ref( $operators->{$item} ) )
194 $self->operator($item);
198 $self->pushStack( Math::BigFloat->new($item) );
202 my $retval = $self->popStack();
203 # Debug("RPN result: $retval");
211 # indent-tabs-mode: nil
212 # perl-indent-level: 4