#!/usr/bin/perl

#
# This is SmiffyCalc 1.1b - 2008-09-17
# 
# Originally released as:
# http://www.smiffysplace.com/smiffycalc
#
# Re-released with minor modifications for PerlMonks.
#
# This calculator is capable of doing anything to your
# system that Perl is so should be used with care and
# NEVER run as root.
#

use strict;
use Math::Trig;
use DB_File;

# Rude Words(tm) regex - used to determine if the boss
# is swearing at me.  This means that we can vent our
# frustration by closing the app with the command
# '$rude_word off'.
#
# Words should be separated by a pipe | symbol:
#
# word1|word2|word3|etc
#
# A somewhat sanitised version of Smiffy's list is
# presented for public consumption:
my $rudewords='bugger|zark';

# State preservation file location:
my $db=$ENV{HOME} . '/.smiffycalc.db';

# The %v hash needs to be tied to a db file so that 
# we can persist values of variables and parameters.

my (%v,$in,$baddb);

tie(%v,'DB_File',$db) or dberror();

# $v{init} is a flag that we write to the database
# file to confirm that we have preserved previous
# state.
unless ($v{init})
{
	$v{dp}='8'; # default decimal places
	$v{init}=1;
}

# Welcome message.
print "SmiffyCalc: Perl eval calculator - enter expression\nor help for more information.\n\n";

# And how was the boss last time?
if ($v{leftas} eq 'pissy')
{
  print "Hope you're in a better mood than last time, boss.\n\n";
  undef $v{leftas};
}
elsif ($v{leftas} eq 'cool')
{
  print "How ya been, boss?\n\n";
  undef $v{leftas};
}

#
# Main loop
#
while (1)
{
	print "sc ($v{dp}dp): ";
	$in=<STDIN>;
  # Setting variables.
	if ($in=~m/^set\s/i)
	{
		doset();
		next;
	}
  # Polite termination.
  elsif ($in=~m/^quit$|^exit$|^bye$|^goodbye$|^adios$|^auf wiedersehen$|^au revoir$/i)
  {
    $v{leftas}='cool';
    last;
  }
  # Unpolite termination.
  elsif ($in=~m/[$rudewords]\s*off/i)
  {
    print "\nYeah, I love you too.  Quitting \"as requested\".  BASTARD!\n\007\007\007";
    $v{leftas}='pissy';
    last;
  }
  # We don't do loops.
	elsif ($in=~m/^last|^next|^for|^while/i)
	{
		print "Loop functions are not supported.\n";
		next;
	}
  # Help, I'm lost!
	elsif ($in=~m/^help!*$|^hilfe!*$|^au secours!*$|^halp!*$|^\?+$/i)
	{
		dohelp();
		next;
	}
  # Show a variable.
	elsif ($in=~m/^show\s/i)
	{
		doshow();
		next;
	}
  # Clear a variable.
	elsif ($in=~m/^clear\s/i)
	{
		doclear();
		next;
	}

  # Do as previous, assuming there was a previous.
	if ($in=~m/ditto/i)
	{
		if ($v{lasta})
		{
			$in=~s/ditto/$v{lasta}/ig;
		}
		else
		{
			print "There was no previous argument.\n";
			next;
		}
	}
	$v{lasta}=$in;

	# Substitute in the last result, if required.
	if ($in=~m/result/i)
	{
		if ($v{lastr})
		{
			$in=~s/result/$v{lastr}/ig;
		}
		else
		{
			print "There was no previous argument.\n";
			next;
		}
	}

	# Substitute and defined variables.
	for my $thisvar (keys %v)
	{
		$in=~s/\$$thisvar/$v{$thisvar}/g;
	}

	# Print out what we think we are going to evaluate.
	print "Eval: $in\n";

	# Do the eval and print the result.
	$v{lastr}=eval($in);
	my $fmtstr='%0.' . $v{dp} . 'f';
	my $res=sprintf($fmtstr,$v{lastr});
	print "$res\n";
}
# End of loop.

# Dyslexics of the world untie!
untie %v unless $baddb;

exit;

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

# Hey, where's my preferences file?
sub dberror
{
	print "WARNING: Unable to open preferences file $db - cannot preserve\n";
	print "state after this programme has been closed.\n\n";
	$baddb=1;	
}

# Help text - probably needs some work.
sub dohelp
{
print<<EOT;
SmiffyCalc Help
===============

Functions allowed are standard Perl math functions
and those defined in Math::Trig.

Commands in alphabetical order
------------------------------   
* clear - undefine a variable.
* ditto - used in an expression will cause
  'ditto' to be substituted with the last used expression.
* help - displays this text.
* quit - ends the programme.
* result - used in an expression will cause
  'result' to be substituted with the result of the
  last expression.
* set - set a parameter.  Usage is: set {parameter}={value}
  Supported parameters are:
  dp - decimal places to which result is rounded (uses sprintf).
  User-definable variables (see below).
* show - show the value of a variable.

Variables
---------
Variables can contain values or functions.  Their names may be
alphanumeric and contain the underscore (_) character.  Variable
names are case-sensitive.

When calling a variable in an expression, it should be preceded
by the dollar (\$) sign.  EG: 2*\$x

Variable names may not use the following reserved words: init,
lasta, lastr.  It is recommended that function names such
as sin, cos, tan, etc., are not used as variable names to 
avoid confusion or unpredictable behaviour.

EOT
}

#
# Set variables and parameters
#
sub doset
{

	my $setst=$in;
	$setst=~s/^set|\s//ig;

	unless ($setst=~/=/)
	{
		print "Usage: set {parameter}={value}\n";
		return;
	}

	my ($n,$val)=split(/=/,$setst);

	$val=$v{lasta} if $val=~m/ditto/i;

	if ($n=~m/^dp$/i)
	{
		if ($val=~m/^\d+$/)
		{
			$v{dp}=$val;
			print "$val decimal places set.\n";
		}
		else
		{
			print "Number of decimal places must be a positive integer.\n";
		}
	}
	elsif ($n=~m/^init$|^lasta$|^lastr$/i)
	{
		print "$n is a reserved word and may not be used.\n";
	}
	elsif ($n=~m/^[a-zA-Z0-9_]+$/)
	{
		$v{$n}=$val;
		print "Variable \$$n set to $val\n";
	}
	else
	{
		print "$n is not a valid parameter and may not be used as a variable name.\n";
	}
}

# Unset a variable
sub doclear
{
	my $setst=$in;
	$setst=~s/^clear|\s//ig;
	
	unless ($setst=~/^\$/)
	{
		print "Usage: clear \$variable\n";
		return;
	}

	$setst=~s/\$//;

	if (defined $v{$setst})
	{
		delete $v{$setst};
		print "Variable \$$setst cleared.\n";
	}
	else
	{
		print "Variable \$$setst is not defined.\n";
	}
}

# Show the value of a variable
sub doshow
{
	my $setst=$in;
	$setst=~s/^show|\s//ig;

	if ($setst=~/all/i)
	{
		print "Showing all variables/parameters:\n";
		for my $thisvar (keys %v)
		{
			print "$thisvar = $v{$thisvar}\n"; 
		}
		return;
	}

	unless ($setst=~/^\$/)
	{
		print "Usage: show \$variable\n";
		return;
	}

	$setst=~s/\$//;

	if (defined $v{$setst})
	{
		print "Variable \$$setst = $v{$setst}\n";
	}
	else
	{
		print "Variable \$$setst is not defined.\n\n";
	}
}