File Coverage

blib/lib/Math/Symbolic/Custom/Simplification.pm

Criterion	Covered	Total	%
statement	48	52	92.3
branch	6	12	50.0
condition	4	9	44.4
subroutine	12	12	100.0
pod	2	2	100.0
total	72	87	82.7

package Math::Symbolic::Custom::Simplification;

use 5.006001;
use strict;
use warnings;
use Carp qw/cluck confess/;
use Math::Symbolic;

our $VERSION = '1.01';

our @Simplification_Stack;
our %Registered;

_reset();

sub _reset {
	@Simplification_Stack = (
		['Math::Symbolic::Operator', \&Math::Symbolic::Operator::simplify]
	);
	%Registered = (
		'Math::Symbolic::Operator' => 1
	);
}

sub register {
	my $class = shift;
	confess("Cannot register simplification routine when not called as class method.") if not defined $class;

	my $simp = eval "\\&${class}::simplify";
	if ($@ or not defined $simp or not ref $simp eq 'CODE') {
		my $msg = $@? "Error: $@" : '';
		confess("Could not find simplification routine as '${class}::simplify'.");
	}

	$Registered{$class}++;
	push @Simplification_Stack, [$class, $simp];

	no strict; no warnings qw/redefine/;
	*Math::Symbolic::Operator::simplify = $simp;

	return 1;
}


sub unregister {
	my $class = shift;
	confess("Cannot unregister simplification routine when not called as class method.") if not defined $class;

	return 0 if not $Registered{$class};

	while (@Simplification_Stack and $class ne $Simplification_Stack[-1][0]) {
		my $this = pop @Simplification_Stack;
		$Registered{$this->[0]}--;
	};

	my $this = pop @Simplification_Stack;
	$Registered{$this->[0]}--;

	if (not @Simplification_Stack) {
		_reset();
		return 0;
	}

	no strict; no warnings qw/redefine/;
	*Math::Symbolic::Operator::simplify = $Simplification_Stack[-1][1];

	return 1;
}


1;
__END__