File Coverage

blib/lib/Template/Direct/Maths.pm

Criterion	Covered	Total	%
statement	75	80	93.7
branch	33	40	82.5
condition	5	9	55.5
subroutine	10	11	90.9
pod	6	6	100.0
total	129	146	88.3

package Template::Direct::Maths;

use base Template::Direct::Base;
use Template::Direct;

use strict;
use warnings;

=head1 NAME

Template::Direct::Maths - Handle a mathimatical query

=head1 DESCRIPTION

  Provide support for doing simple calculations (SIMPLE ONLY!)

=head1 METHODS

=cut

use Carp;

my %rules = (
	'+' => 3,
	'-' => 3,
	'*' => 2,
	'/' => 2,
	'%' => 1,
	'^' => 0,
);

=head2 I<$class>->new( $index, $line )

  Create a new instance object.

=cut
sub new {
	my ($class, $index, $line, %p) = @_;
	my $self = $class->SUPER::new(%p);
	$self->{'startTag'} = $index;
	my ($s, $p) = split(/=/, $line);
	$self->{'Statement'} = $s;
	$self->{'Print'}     = $p;
	return $self;
}

=head2 I<$maths>->tagName( )

  Returns 'maths'

=cut
sub tagName { 'maths' }

=head2 I<$maths>->singleTag( )

  Returns true

=cut
sub singleTag { 1 }

=head2 I<$maths>->compile( )

  Modifies a template with the data calculated.

=cut
sub compile {
	my ($self, $data, $template, %p) = @_;

	my $statement = $self->parseStatement( $self->{'Statement'}, $data );
	my $result    = $self->calculate( $statement );

	if($self->{'Print'}) {
		$result = sprintf($self->{'Print'}, $result);
	}

	$self->setTagSection($template, $self->{'startTag'}, $result);
}

=head2 I<$maths>->parseStatement( $s, $data )

  Return an array structure of values to calculate.

=cut
sub parseStatement {
	my ($self, $s, $data) = @_;
	my $statement = [];

	#Split into raw tokens
	my @raws = split(/\s+/, $s);
	my @depths;
	my $current = $statement;

	foreach my $raw (@raws) {

		if($raw =~ s/^\(//) {
			# New level
			my $new = [];
			push @{$current}, $new;
			push @depths, $current if $current;
			$current = $new;
		}

		my $end = $raw =~ s/\)$// ? 1 : 0;

		if($raw ne '') {
			# Add sane tokens only, remove all unexpected charicters.
			my $sane = $raw;
			#$sane =~ s/[^\w\$_\{\}\<\>\|\&\=\!\@]//g;

			# Get datum if required, replace this token with real value
			if($sane =~ /^\$(.+)$/) {
				$sane = $data->getDatum($1, forceString => 1);
			}

			# Set 0 when required
			$sane = 0 if not $sane;

			# Push this token onto the current stack.
			push @{$current}, $sane if defined($sane) and scalar($sane.'') ne '';
		}

		$current = pop @depths if $end and @depths;
	}

	return $statement;
}

=head2 I<$maths>->calculate( $statement )

  Return a result based on calulating the statement.

=cut
sub calculate {
	my ($self, $s) = @_;
	my $len = @{$s};

	# Return Directly
	return $s->[0] if $len == 1;

	if($len > 3 and not (($len-1) % 2)) {
		# Sort out the preceidence order and combine.
		my @p;
		# Take each operator index from the stack
		for(my $i=1;$i<$len;$i+=2) {
			push @p, $i;
		}
		foreach my $i (sort { $rules{$s->[$a]} <=> $rules{$s->[$b]} } @p) {
			# Remove 3 tokens, calculate them and
			# Put the result back on the stack
			splice(@{$s}, $i-1, 0, [ splice(@{$s}, $i-1, 3) ] );
			return $self->calculate( $s );
		}
	} elsif($len == 3) {
		# Calculate trinary
		my ($a, $o, $b) = @{$s};
		$a = $self->calculate( $a ) if ref($a) eq 'ARRAY';
		$b = $self->calculate( $b ) if ref($b) eq 'ARRAY';
		return $a + $b if $o eq '+';
		return $a - $b if $o eq '-';
		return $a * $b if $o eq '*';
		return $a / $b if $o eq '/';
		return $a % $b if $o eq '%';
		return $a ** $b if $o eq '^';
		warn "\nUnknown operator '$o' in statement: ".$self->{'statement'}."\n";
		return 0;
	}

	warn "Calculation broken for ".$self->{'Statement'}." : $len (".(($len-1) % 2).")\n";
	return 0;
}

=head1 AUTHOR

  Martin Owens - Copyright 2008, AGPL

=cut
1;