File Coverage

lib/Class/STL/Element.pm

Criterion	Covered	Total	%
statement	54	89	60.6
branch	16	50	32.0
condition	14	90	15.5
subroutine	17	28	60.7
pod	0	19	0.0
total	101	276	36.5

# vim:ts=4 sw=4
# ----------------------------------------------------------------------------------------------------
#  Name		: Class::STL::Element.pm
#  Created	: 22 February 2006
#  Author	: Mario Gaffiero (gaffie)
#
# Copyright 2006-2007 Mario Gaffiero.
#
# This file is part of Class::STL::Containers(TM).
#
# Class::STL::Containers is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# Class::STL::Containers is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Class::STL::Containers; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
# ----------------------------------------------------------------------------------------------------
# Modification History
# When          Version     Who     What
# 14/03/2006	0.02		mg		Fixed Class::STL::Element->new() function.
# ----------------------------------------------------------------------------------------------------
# TO DO:
# ----------------------------------------------------------------------------------------------------
require 5.005_62;
use strict;
use warnings;
use vars qw($VERSION $BUILD);
use Class::STL::ClassMembers::DataMember;
use Class::STL::ClassMembers::FunctionMember;
$VERSION = '0.19';
$BUILD = 'Saturday May 6 17:08:34 GMT 2006';
# ----------------------------------------------------------------------------------------------------
{
	package Class::STL::Element;
	use UNIVERSAL qw(isa can);
	use Carp qw(confess);
	use Class::STL::ClassMembers qw( data ),
		Class::STL::ClassMembers::DataMember->new(name => 'data_type', default => 'string',
			validate => '^(string|array|numeric|ref)$');
	use Class::STL::ClassMembers::Constructor;
	sub new_extra # static function
	{
		my $self = shift;
		while (@_)
		{
			my $p = shift;
			if (!ref($p) && exists(${$self->members()}{$p}))
			{
				shift;
			}
			elsif (!ref($p) && scalar @_ != 0) {
				shift;
			}
			else {
				$self->data($p); # new() called.
			}
		}
		return $self;
	}
	sub eq # (element)
	{
		my $self = shift;
		my $other = shift;
		return defined($self->data()) && ref($self->data()) && $self->data()->can('eq')
			? $self->data()->eq($other)
			: $self->data_type() eq 'string'
				? defined($self->data()) && defined($other->data()) && $self->data() eq $other->data()
				: defined($self->data()) && defined($other->data()) && $self->data() == $other->data();
	}
	sub ne # (element)
	{
		my $self = shift;
		return !$self->eq(shift);
	}
	sub gt # (element)
	{
		my $self = shift;
		my $other = shift;
		return defined($self->data()) && ref($self->data()) && $self->data()->can('gt')
			? $self->data()->gt($other)
			: $self->data_type() eq 'string'
				? defined($self->data()) && defined($other->data()) && $self->data() gt $other->data()
				: defined($self->data()) && defined($other->data()) && $self->data() > $other->data();
	}
	sub lt # (element)
	{
		my $self = shift;
		my $other = shift;
		return defined($self->data()) && ref($self->data()) && $self->data()->can('lt')
			? $self->data()->lt($other)
			: $self->data_type() eq 'string'
				? defined($self->data()) && defined($other->data()) && $self->data() lt $other->data()
				: defined($self->data()) && defined($other->data()) && $self->data() < $other->data();
	}
	sub ge # (element)
	{
		my $self = shift;
		my $other = shift;
		return defined($self->data()) && ref($self->data()) && $self->data()->can('ge')
			? $self->data()->ge($other)
			: $self->data_type() eq 'string'
				? defined($self->data()) && defined($other->data()) && $self->data() ge $other->data()
				: defined($self->data()) && defined($other->data()) && $self->data() >= $other->data();
	}
	sub le # (element)
	{
		my $self = shift;
		my $other = shift;
		return defined($self->data()) && ref($self->data()) && $self->data()->can('le')
			? $self->data()->le($other)
			: $self->data_type() eq 'string'
				? defined($self->data()) && defined($other->data()) && $self->data() le $other->data()
				: defined($self->data()) && defined($other->data()) && $self->data() <= $other->data();
	}
	sub cmp # (element)
	{
		my $self = shift;
		my $other = shift;
		return $self->eq($other) ? 0 : $self->lt($other) ? -1 : 1;
	}
	sub mod # (element)
	{
		my $self = shift;
		my $other = shift;
		return ref($self->data()) && $self->data()->can('mod')
			? $self->data()->mod($other)
			: $self->data($self->data() % $other->data());
	}
	sub add # (element)
	{
		my $self = shift;
		my $other = shift;
		return ref($self->data()) && $self->data()->can('add')
			? $self->data()->add($other)
			: $self->data($self->data() + $other->data());
	}
	sub subtract # (element)
	{
		my $self = shift;
		my $other = shift;
		return ref($self->data()) && $self->data()->can('subtract')
			? $self->data()->subtract($other)
			: $self->data($self->data() - $other->data());
	}
	sub mult # (element)
	{
		my $self = shift;
		my $other = shift;
		return ref($self->data()) && $self->data()->can('mult')
			? $self->data()->mult($other)
			: $self->data($self->data() * $other->data());
	}
	sub div # (element)
	{
		my $self = shift;
		my $other = shift;
		return ref($self->data()) && $self->data()->can('div')
			? $self->data()->div($other)
			: $self->data($self->data() / $other->data());
	}
	sub and # (element)
	{
		my $self = shift;
		my $other = shift;
		return ref($self->data()) && $self->data()->can('and')
			? $self->data()->and($other)
			: $self->data() && $other->data();
	}
	sub or # (element)
	{
		my $self = shift;
		my $other = shift;
		return ref($self->data()) && $self->data()->can('or')
			? $self->data()->or($other)
			: $self->data() || $other->data();
	}
	sub match # (element)
	{
		my $self = shift;
		my $other = shift;
		return ref($self->data()) && $self->data()->can('match')
			? $self->data()->match($other)
			: $self->data() =~ /@{[ $other->data() ]}/;
	}
	sub match_ic # (element)
	{
		my $self = shift;
		my $other = shift;
		return ref($self->data()) && $self->data()->can('match_ic')
			? $self->data()->match_ic($other)
			: $self->data() =~ /@{[ $other->data() ]}/i;
	}
	sub neg # (void)
	{
		my $self = shift;
		return ref($self->data()) && $self->data()->can('neg')
			? $self->data()->neg()
			: $self->data(-($self->data()));
	}
	sub print # (void)
	{
		my $self = shift;
		return ref($self->data()) && $self->data()->can('print')
			? $self->data()->print()
			: $self->data();
	}
}
# ----------------------------------------------------------------------------------------------------
1;