--- /dev/null
+#
+# Copyright (C) 1998 Jeff R. Allen and WebTV Networks, Inc.
+# Copyright (C) 2002 Stanislav Sinyagin
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+# $Id: RPN.pm,v 1.1 2010-12-27 00:03:40 ivan Exp $
+# Stanislav Sinyagin <ssinyagin@yahoo.com>
+
+# a simple little RPN calculator -- implements the same operations
+# that RRDTool does.
+
+# This file is based on Cricket's RPM.pm
+
+package Torrus::RPN;
+
+use strict;
+
+use Torrus::Log;
+use Math::BigFloat;
+
+# Each RPN operator is defined by an array reference with the
+# following elements: <number of args>, <subroutine>, <accepts undef>
+
+my $operators = {
+ '+' => [ 2, sub{ $_[0] + $_[1]; } ],
+ '-' => [ 2, sub{ $_[0] - $_[1]; } ],
+ '*' => [ 2, sub{ $_[0] * $_[1]; } ],
+ '/' => [ 2, sub{ $_[0] / $_[1]; } ],
+ '%' => [ 2, sub{ $_[0] % $_[1]; } ],
+ 'MOD' => [ 2, sub{ $_[0] % $_[1]; } ],
+ 'SIN' => [ 1, sub{ sin($_[0]->bsstr()); } ],
+ 'COS' => [ 1, sub{ cos($_[0]->bsstr()); } ],
+ 'LOG' => [ 1, sub{ log($_[0]); } ],
+ 'EXP' => [ 1, sub{ $_[0]->exponent() } ],
+ 'FLOOR' => [ 1, sub{ $_[0]->bfloor(); } ],
+ 'CEIL' => [ 1, sub{ $_[0]->bceil(); } ],
+ 'LT' => [ 2, sub{ ($_[0] < $_[1]) ? 1:0; } ],
+ 'LE' => [ 2, sub{ ($_[0] <= $_[1]) ? 1:0; } ],
+ 'GT' => [ 2, sub{ ($_[0] > $_[1]) ? 1:0; } ],
+ 'GE' => [ 2, sub{ ($_[0] >= $_[1]) ? 1:0; } ],
+ 'EQ' => [ 2, sub{ ($_[0] == $_[1]) ? 1:0; } ],
+ 'IF' => [ 3, sub{ defined($_[0]) ? ($_[0] ? $_[1] : $_[2]) : undef; }, 1],
+ 'MIN' => [ 2, sub{ ($_[0] < $_[1]) ? $_[0] : $_[1]; } ],
+ 'MAX' => [ 2, sub{ ($_[0] > $_[1]) ? $_[0] : $_[1]; } ],
+ 'UN' => [ 1, sub{ defined($_[0]) ? $_[0]->is_nan() : 1; }, 1 ],
+ 'UNKN' => [ 0, sub{ undef; } ],
+ # Operators not defined in RRDtool graph
+ 'NE' => [ 2, sub{ ($_[0] != $_[1]) ? 1:0; } ],
+ 'AND' => [ 2, sub{ ($_[0] and $_[1]) ? 1:0; } ],
+ 'OR' => [ 2, sub{ ($_[0] or $_[1]) ? 1:0; } ],
+ 'NOT' => [ 1, sub{ (not $_[0]) ? 1:0; } ],
+ 'ABS' => [ 1, sub{ abs($_[0]); } ],
+ 'NOW' => [ 0, sub{ time(); } ],
+ 'DUP' => [ 1, sub{ ($_[0], $_[0]);}, 1 ],
+ 'EXC' => [ 2, sub{ ($_[1], $_[0]); }, 1 ],
+ 'NUM' => [ 1, sub{ defined($_[0]) ? $_[0] : 0; }, 1 ],
+ 'INF' => [ 0, sub{ Math::BigFloat->binf(); } ],
+ 'NEGINF' => [ 0, sub{ Math::BigFloat->binf('-'); } ]
+ };
+
+
+sub new
+{
+ my $type = shift;
+ my $self = {};
+ bless( $self, $type );
+ $self->{'stack'} = [];
+ return $self;
+}
+
+
+sub operator
+{
+ my $self = shift;
+ my $op = shift;
+
+ my $n_args = $operators->{$op}->[0];
+ my $action = $operators->{$op}->[1];
+ my $acceptsUndefined = $operators->{$op}->[2];
+ my @args = ();
+ my $allDefined = 1;
+ for( my $i = 0; $i < $n_args; $i++ )
+ {
+ my $arg = $self->popStack();
+ if( defined( $arg ) or $acceptsUndefined )
+ {
+ push( @args, $arg );
+ }
+ else
+ {
+ $allDefined = 0;
+ }
+ }
+ $self->pushStack( $allDefined ? &{$action}(reverse @args) : undef );
+}
+
+
+sub popStack
+{
+ my $self = shift;
+
+ my $ret;
+ if( scalar( @{$self->{'stack'}} ) == 0 )
+ {
+ Warn("Stack underflow");
+ }
+ else
+ {
+ $ret = pop( @{$self->{'stack'}} );
+ }
+ return $ret;
+}
+
+
+sub pushStack
+{
+ my $self = shift;
+ my @items = @_;
+
+ push( @{$self->{'stack'}}, @items );
+}
+
+
+sub translate
+{
+ my $self = shift;
+ my $string = shift;
+ my $callback = shift;
+
+ # Debug("Translating RPN: $string");
+ my $item;
+ my @new_items;
+ foreach $item ( split( /,/, $string ) )
+ {
+ if( $item =~ /^\{([^\}]*)\}$/ )
+ {
+ my $noderef = $1;
+ my $timeoffset;
+ if( $noderef =~ s/\(([^\)]+)\)// )
+ {
+ $timeoffset = $1;
+ }
+ my $value = &{$callback}( $noderef, $timeoffset );
+ $value = 'UNKN' unless defined( $value );
+ # Debug("$item translated into $value");
+ $item = $value;
+ }
+ elsif( $item eq 'MOD' )
+ {
+ # In Torrus parameter value, percent sign is reserved for
+ # parameter expansion. Rrdtool understands % only.
+ $item = '%';
+ }
+ push( @new_items, $item );
+ }
+
+ $string = join( ',', @new_items );
+ # Debug("RPN translated: $string");
+ return $string;
+}
+
+
+sub run
+{
+ my $self = shift;
+ my $string = shift;
+ my $callback = shift;
+
+ # Debug("Input RPN: $string");
+
+ if( index( $string, '{' ) >= 0 )
+ {
+ $string = $self->translate( $string, $callback );
+ }
+
+ my $item;
+ foreach $item ( split( /,/, $string ) )
+ {
+ if( ref( $operators->{$item} ) )
+ {
+ $self->operator($item);
+ }
+ else
+ {
+ $self->pushStack( Math::BigFloat->new($item) );
+ }
+ }
+
+ my $retval = $self->popStack();
+ # Debug("RPN result: $retval");
+ return $retval;
+}
+
+1;
+
+# Local Variables:
+# mode: perl
+# indent-tabs-mode: nil
+# perl-indent-level: 4
+# End:
projects / freeside.git / blobdiff