view release on metacpan or  search on metacpan

lib/Language/FormulaEngine/Namespace.pm  view on Meta::CPAN

package Language::FormulaEngine::Namespace;
use Moo;
use Carp;
use Try::Tiny;
require MRO::Compat if $] lt '5.009005';
use Language::FormulaEngine::Error ':all';
use namespace::clean;

# ABSTRACT: Object holding function and variable names
our $VERSION = '0.08'; # VERSION


has variables            => ( is => 'rw', default => sub { +{} } );
has constants            => ( is => 'rw', default => sub { +{} } );
has die_on_unknown_value => ( is => 'rw' );


sub clone {
	my $self= shift;
	my %attrs= @_==1 && ref $_[0] eq 'HASH'? %{$_[0]} : @_;
	$attrs{variables} ||= { %{ $self->variables } };
	$attrs{constants} ||= { %{ $self->constants } };
	$self->new( %$self, %attrs );
}

# potentially hot method
sub clone_and_merge {
	my $self= shift;
	my %attrs= @_==1 && ref $_[0] eq 'HASH'? %{$_[0]} : @_;
	$attrs{variables}= { %{ $self->variables }, ($attrs{variables}? %{ $attrs{variables} } : () ) };
	$attrs{constants}= { %{ $self->constants }, ($attrs{constants}? %{ $attrs{constants} } : () ) };
	$self->new( %$self, %attrs );
}


sub get_constant {
	my ($self, $name)= @_;
	$name= lc $name;
	$self->constants->{$name};
}

sub get_value {
	my ($self, $name)= @_;
	$name= lc $name;
	my $set= $self->variables;
	return $set->{$name} if exists $set->{$name};
	$set= $self->constants;
	return $set->{$name} if exists $set->{$name};
	die ErrREF("Unknown variable or constant '$_[1]'")
		if $self->die_on_unknown_value;
	return undef;
}

our %is_pure_function;
sub FETCH_CODE_ATTRIBUTES {
	my ($class, $ref)= @_;
	return $class->maybe::mext::method($ref), ($is_pure_function{0+$ref}? ('Pure') : ());
}
sub MODIFY_CODE_ATTRIBUTES {
	my ($class, $ref, @attr)= @_;
	my $n= @attr;
	@attr= grep $_ ne 'Pure', @attr;
	$is_pure_function{0+$ref}= 1 if $n > @attr;
	$class->maybe::next::method($ref, @attr);
}