package RPN;

use strict;
use warnings;
use Math::Trig;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use RPN ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw( rpn ) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw( );

our $VERSION = '1.0';


# Preloaded methods go here.

my %operations = (
    "POP"  => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 1)
			{
				return undef;
			}	

			pop @$stackRef;
		}
	),
    "DUP" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 1)
			{
				return undef;
			}	

			push (@$stackRef, @$stackRef[-1]);
		}
	),
    "PI" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 0)
			{
				return undef;
			}	

			push (@$stackRef, 4.0*atan2(1.0,1.0));
		}
	),
    "++" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 1)
			{
				return undef;
			}	

			@$stackRef[-1]++;
		}
	),
    "--" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 1)
			{
				return undef;
			}	
			
			@$stackRef[-1]--;
		}
	),
    "ABS" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 1)
			{
				return undef;
			}	

			push (@$stackRef, abs pop (@$stackRef));
		}
	),
    "COS" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 1)
			{
				return undef;
			}	

			push (@$stackRef, cos pop (@$stackRef));
		}
	),
    "EXP" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 1)
			{
				return undef;
			}	

			push (@$stackRef, exp pop (@$stackRef));
		}
	),
    "INT" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 1)
			{
				return undef;
			}	

			push (@$stackRef, int pop (@$stackRef));
		}
	),
    "LOG" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 1)
			{
				return undef;
			}	

			push (@$stackRef, log pop (@$stackRef));
		}
	),
    "ROUND" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 1)
			{
				return undef;
			}	

			push (@$stackRef, sprintf ("%.0f", pop (@$stackRef)));
		}
	),
    "SIN" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 1)
			{
				return undef;
			}	

			push (@$stackRef, sin pop (@$stackRef));
		}
	),
    "SQRT" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 1)
			{
				return undef;
			}	

			push (@$stackRef, sqrt pop (@$stackRef));
		}
	),
    "TAN" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 1)
			{
				return undef;
			}	

			push (@$stackRef, tan pop (@$stackRef));
		}
	),
    "%" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 2)
			{
				return undef;
			}	
			
			my $var2 = pop (@$stackRef);
			my $var1 = pop (@$stackRef);

			push (@$stackRef, $var1 % $var2);
		}
	),
    "*" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 2)
			{
				return undef;
			}	

			my $var2 = pop (@$stackRef);
			my $var1 = pop (@$stackRef);

			push (@$stackRef, $var1 * $var2);
		}
	),
    "+" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 2)
			{
				return undef;
			}	
	
			my $var2 = pop (@$stackRef);
			my $var1 = pop (@$stackRef);

			push (@$stackRef, $var1 + $var2);
		}
	),
    "-" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 2)
			{
				return undef;
			}	
	
			my $var2 = pop (@$stackRef);
			my $var1 = pop (@$stackRef);

			push (@$stackRef, $var1 - $var2);
		}
	),
    "/" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 2)
			{
				return undef;
			}	
	
			my $var2 = pop (@$stackRef);
			my $var1 = pop (@$stackRef);

			push (@$stackRef, $var1 / $var2);
		}
	),
    "ATAN2" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 2)
			{
				return undef;
			}	
	
			my $var2 = pop (@$stackRef);
			my $var1 = pop (@$stackRef);

			push (@$stackRef, atan2 $var1, $var2);
		}
	),
    "EXCH" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 2)
			{
				return undef;
			}	
	
			push (@$stackRef, (pop (@$stackRef), pop (@$stackRef)));
		}
	),
    "MAX" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 2)
			{
				return undef;
			}	
	
			my $var2 = pop (@$stackRef);
			my $var1 = pop (@$stackRef);

			push (@$stackRef, $var1 > $var2 ? $var1 : $var2);
		}
	),
    "MIN" => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 2)
			{
				return undef;
			}	
	
			my $var2 = pop (@$stackRef);
			my $var1 = pop (@$stackRef);

			push (@$stackRef, $var1 < $var2 ? $var1 : $var2);
		}
	),
    "POW"  => (
		sub {
			my ($stackRef) = @_;

			if (scalar @{$stackRef} < 2)
			{
				return undef;
			}	
	
			my $var2 = pop (@$stackRef);
			my $var1 = pop (@$stackRef);

			push (@$stackRef, $var1 ** $var2);
		}
	)
);

sub rpn {
	my ( $RpnString ) = @_;

	# Check if RPN String is supplied.
	if(!defined $RpnString)
	{
		printf STDERR "RpnString needs to be supplied.\n";
		return undef;
	}

	# RPN value stack
	my @stack;

	for my $operand (split /\s+/, $RpnString)
	{
		if (defined $operations{$operand})
		{
			if(!defined($operations{$operand}->(\@stack)))
			{
				return undef;
			}
		}
		else
		{
			if ($operand =~ /^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$/)
			{
				push (@stack, $operand);
			}
			else
			{
				print STDERR "RpnString contains a value that is not numeric or an operand.\n";
				return undef;
			}
		}
	}

	if (scalar @stack != 1)
	{
		print STDERR "After calculation there is not one value on stack.\n";
		return undef;
	}

	return $stack[0];
}

1;
__END__
# Below is the documentation for RPN.

=head1 NAME

RPN - Perl extension that implements simple RPN functionality.

=head1 SYNOPSIS

  use RPN;

  RPN::rpn("5 5 +");

=head1 DESCRIPTION

This module makes it possible to calculate in reverse polish notation.

=over 1

=item rpn()

This is the evaluation function for an RPN string.

Input:
  $rpnString - The String with an RPN expression.

Output:
  undef if an error occured otherwise the result of the upn evaluation.

=back

=head2 EXPORT

None by default.

=head1 SEE ALSO

https://en.wikipedia.org/wiki/Reverse_Polish_notation

=head1 AUTHOR

Stefan Suhren, E<lt>suhren.stefan@fh-swf.deE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2015 by Stefan Suhren

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.22.0 or,
at your option, any later version of Perl 5 you may have available.

=cut