File Coverage

blib/lib/Config/Objective/Hash.pm

Criterion	Covered	Total	%
statement	41	48	85.4
branch	15	28	53.5
condition	4	9	44.4
subroutine	6	9	66.6
pod	7	7	100.0
total	73	101	72.2

###
###  Copyright 2002-2003 University of Illinois Board of Trustees
###  Copyright 2002-2003 Mark D. Roth
###  All rights reserved.
###
###  Config::Objective::Hash - hash data type for Config::Objective
###
###  Mark D. Roth
###  Campus Information Technologies and Educational Services
###  University of Illinois at Urbana-Champaign
###


package Config::Objective::Hash;

use strict;

use Config::Objective::DataType;

our @ISA = qw(Config::Objective::DataType);


###############################################################################
###  default method is insert()
###############################################################################

sub default
{
	my ($self, $value) = @_;

	$self->insert($value);
}


###############################################################################
###  unset method
###############################################################################

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

	$self->{'value'} = {};
	return 1;
}


###############################################################################
###  set method
###############################################################################

sub set
{
	my ($self, $value) = @_;

#	print "==> Hash::set($value)\n";

	$self->unset();
	return $self->insert($value);
}


###############################################################################
###  insert method
###############################################################################

sub insert
{
	my ($self, $value) = @_;
	my ($key1, $key2);

#	print "==> Hash::insert($value)\n";

	die "insert: method requires hash argument\n"
		if (ref($value) ne 'HASH');

	$self->{'value'} = {}
		if (!defined($self->{'value'}));

	foreach $key1 (keys %$value)
	{
		print "\t'$key1' => '$value->{$key1}'\n"
			if ($self->{'debug'});

		die "key must be an absolute path\n"
			if ($self->{'key_abspath'}
			    && $key1 !~ m|^/|);

		if (!defined($value->{$key1}))
		{
			die "hash value missing\n"
				if (!$self->{'value_optional'});
		}
		else
		{
			die "hash value is not a $self->{'value_type'}\n"
				if (defined($self->{'value_type'})
				    && $self->{'value_type'} ne ref($value->{$key1}));

			die "value must be an absolute path\n"
				if ($self->{'value_abspath'}
				    && $value->{$key1} !~ m|^/|);
		}

		if (exists($self->{'value'}->{$key1}))
		{
#			print "key1='$key1'\n";
			if (ref($self->{'value'}->{$key1}) eq 'HASH')
			{
#				print "key1={" . join(',', sort keys %{$self->{'value'}->{$key1}}) . "}\n";
				foreach $key2 (keys %{$value->{$key1}})
				{
#					print "\tkey2='$key2'\n";
					$self->{'value'}->{$key1}->{$key2} = $value->{$key1}->{$key2};
				}

#				print "'$key1' => { " . join(', ', sort keys %{$self->{'value'}->{$key1}}) . " }\n";
				next;
			}
			elsif (ref($self->{'value'}->{$key1}) eq 'ARRAY')
			{
				push(@{$self->{'value'}->{$key1}}, @{$value->{$key1}});
				next;
			}
		}

		### overwrite the existing entry
		### or create a new one
		print "OVERRIDE: $value->{$key1}\n"
			if ($self->{'debug'});
		$self->{'value'}->{$key1} = $value->{$key1};
	}

	return 1;
}


###############################################################################
###  exists method
###############################################################################

sub exists
{
	my ($self, $value) = @_;

	return (exists($self->{'value'}->{$value}) ? 1 : 0);
}


###############################################################################
###  find method
###############################################################################

sub find
{
	my ($self, $value) = @_;

	return (exists($self->{value}->{$value})
		? $self->{value}->{$value}
		: undef);
}


###############################################################################
###  delete method
###############################################################################

sub delete
{
	my ($self, $value) = @_;
	my ($val);

	$value = $self->_scalar_or_list($value);
	foreach $val (@$value)
	{
		delete $self->{'value'}->{$val};
	}

	return 1;
}


###############################################################################
###  cleanup and documentation
###############################################################################

1;

__END__