view release on metacpan or  search on metacpan

lib/Data/Formula.pm  view on Meta::CPAN

package Data::Formula;

use warnings;
use strict;
use utf8;
use 5.010;

use List::MoreUtils qw(any);
use Moose;
use MooseX::StrictConstructor;
use Carp qw(croak);

our $VERSION = '0.02';
our @CARP_NOT;

my %operators = (
    '+' => {
        method => 'plus',
        calc   => 'plus',
        prio   => 10,
    },
    '-' => {
        method => 'minus',
        calc   => 'minus',
        prio   => 10,
    },
    '*' => {
        method => 'multiply',
        calc   => 'multiply',
        prio   => 50,
    },
    '/' => {
        method => 'divide',
        calc   => 'divide',
        prio   => 50,
    },
    '(' => {method => 'bracket_left',},
    ')' => {method => 'bracket_right',},
);

has 'variables'      => (is => 'rw', isa => 'ArrayRef', default    => sub {[]});
has 'formula'        => (is => 'ro', isa => 'Str',      default    => sub {[]});
has '_tokens'        => (is => 'ro', isa => 'ArrayRef', lazy_build => 1,);
has '_rpn'           => (is => 'ro', isa => 'ArrayRef', lazy_build => 1,);
has '_op_indent'     => (is => 'rw', isa => 'Int',      default    => 0,);
has 'used_variables' => (is => 'ro', isa => 'ArrayRef', lazy_build => 1,);

has 'on_error' => (
    is        => 'rw',
    predicate => 'has_on_error',
    clearer   => 'clear_on_error',
);
has 'on_missing_token' => (
    is        => 'rw',
    predicate => 'has_on_missing_token',
    clearer   => 'clear_on_missing_token',
);

sub _indented_operator {
    my ($self, $op) = @_;
    return {
        name => $op,
        %{$operators{$op}},
        prio => ($operators{$op}->{prio} + ($self->_op_indent * 100)),
    };
}

sub _build__rpn {
    my ($self) = @_;

    my $rpn = [];
    my $ops = [];
    foreach my $token (@{$self->_tokens}) {
        if ($operators{$token}) {
            my $rpn_method = '_rpn_method_' . $operators{$token}->{method};
            ($rpn, $ops) = $self->$rpn_method($rpn, $ops);
        }
        else {
            push(@$rpn, $token);
        }
    }

    return [@$rpn, reverse(@$ops)];
}

sub _rpn_method_plus {
    my ($self, $rpn, $ops) = @_;
    return $self->rpn_standard_operator('+', $rpn, $ops);
}

sub _rpn_method_minus {
    my ($self, $rpn, $ops) = @_;
    return $self->rpn_standard_operator('-', $rpn, $ops);
}

sub _rpn_method_multiply {
    my ($self, $rpn, $ops) = @_;
    return $self->rpn_standard_operator('*', $rpn, $ops);
}

sub _rpn_method_divide {
    my ($self, $rpn, $ops) = @_;
    return $self->rpn_standard_operator('/', $rpn, $ops);
}

sub rpn_standard_operator {