File Coverage

blib/lib/Math/SymbolicX/Complex.pm

Criterion	Covered	Total	%
statement	52	52	100.0
branch	8	16	50.0
condition	2	6	33.3
subroutine	8	8	100.0
pod			n/a
total	70	82	85.3

package Math::SymbolicX::Complex;

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

require Math::Complex;

package Math::Symbolic::Parser;
use Math::Complex;

package Math::SymbolicX::Complex;

our $VERSION = '1.01';

# Regular expression for floating point numbers.
# Stolen from Math::Complex version 1.34, but since this will be released
# under the same (artistic/perl) license, that should be alright.
my $floatingpoint = qr'\s*([\+\-]?(?:(?:(?:\d+(?:_\d+)*(?:\.\d*(?:_\d+)*)?|\.\d+(?:_\d+)*)(?:[eE][\+\-]?\d+(?:_\d+)*)?)))';

my $opregex = qr/[^0-9e\-\+\*\/\.]/;


use Math::SymbolicX::ParserExtensionFactory (
    complex => sub {
        my $argstring = shift;
	$argstring = _parse_args($argstring);
	my ($re, $im) = split(/,/, $argstring, 2);

	# get numeric representations
	confess "Could not generate Math::Complex object from '$argstring' "
		."in Math::Symbolic parse."
		if $re =~ $opregex or $im =~ $opregex;
	$re = eval $re;
	confess "Could not generate Math::Complex object from '$argstring' "
		."in Math::Symbolic parse. (Error Msg.: $@)" if $@;
	$im = eval $im;
	confess "Could not generate Math::Complex object from '$argstring' "
		."in Math::Symbolic parse. (Error Msg.: $@)" if $@;

	my $object;
	eval {
		$object = Math::Complex->make($re, $im);
	};
	confess "Could not generate Math::Complex object from '$argstring' "
		."in Math::Symbolic parse. (Error msg.: '$@')" if $@;
        return Math::Symbolic::Constant->new($object);
    },
    polar => sub {
        my $argstring = shift;
	$argstring = _parse_args($argstring);
	my ($r, $arg) = split(/,/, $argstring, 2);

	# get numeric representations
	confess "Could not generate Math::Complex object from '$argstring' "
		."in Math::Symbolic parse."
		if $r =~ $opregex or $arg =~ $opregex;
	$r = eval $r;
	confess "Could not generate Math::Complex object from '$argstring' "
		."in Math::Symbolic parse. (Error Msg.: $@)" if $@;
	$arg = eval $arg;
	confess "Could not generate Math::Complex object from '$argstring' "
		."in Math::Symbolic parse. (Error Msg.: $@)" if $@;

	my $object;
	eval {
		$object = Math::Complex->emake($r, $arg);
	};
	confess "Could not generate Math::Complex object from '$argstring' "
		."in Math::Symbolic parse. (Error msg.: '$@')" if $@;

        return Math::Symbolic::Constant->new($object);
    },
);


sub _parse_args {
	my $str = shift;
	$str =~ s/\s+//g;
	$str =~ s{pi}{Math::Symbolic::ExportConstants::PI}e;
	return $str;
# We tried to be very smart at first, but it turned out to be buggy:
#	$str =~ s{
#		((?:$floatingpoint)?)pi
#	}
#	{
#		warn "$1";
#		defined($1) && $1 ne ''
#		? $1 * Math::Symbolic::ExportConstants::PI
#		: Math::Symbolic::ExportConstants::PI
#	}e;
#	return $str;
}

1;
__END__