File Coverage

blib/lib/Config/Objective/Table.pm

Criterion	Covered	Total	%
statement	38	65	58.4
branch	12	42	28.5
condition	0	3	0.0
subroutine	6	11	54.5
pod	8	8	100.0
total	64	129	49.6

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


package Config::Objective::Table;

use strict;

use Config::Objective::List;

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


###############################################################################
###  utility function
###############################################################################

sub _find_row
{
	my ($self, $query) = @_;
	my ($ct, $lref, $key);

	ROWS: for ($ct = 0; $ct < @{$self->{value}}; $ct++)
	{
		$lref = $self->{value}->[$ct];
		foreach $key (keys %$query)
		{
			next ROWS
				if ($lref->[$key] !~ m/$query->{$key}/);
		}

		return $ct;
	}

	return undef;
}


###############################################################################
###  insert_row method
###############################################################################

sub insert_row
{
	my ($self, $query, $newrow) = @_;
	my ($row);

	die "insert_row: row specifier must be a hash\n"
		if (ref($query) ne 'HASH');

	die "insert_row: new row must be list type\n"
		if (ref($newrow) ne 'ARRAY');

	$row = $self->_find_row($query);
	splice(@{$self->{value}}, $row, 0, $newrow)
		if (defined($row));
}


###############################################################################
###  find_row method
###############################################################################

sub find_row
{
	my ($self, $query) = @_;
	my ($row);

	die "find_row: row specifier must be a hash\n"
		if (ref($query) ne 'HASH');

	$row = $self->_find_row($query);
	return $self->{value}->[$row]
		if (defined($row));

	return undef;
}


###############################################################################
###  replace_row_cells method
###############################################################################

sub replace_row_cells
{
	my ($self, $query, $replspec) = @_;
	my ($row, $col);

	die "replace_row_cells: row specifier must be a hash\n"
		if (ref($query) ne 'HASH');

	die "replace_row_cells: replacement specifier must be a hash\n"
		if (ref($replspec) ne 'HASH');

	$row = $self->_find_row($query);
	return
		if (!defined($row));

	foreach $col (keys %$replspec)
	{
		$self->{value}->[$row]->[$col] = $replspec->{$col};
	}
}


###############################################################################
###  append_to_row_cells method
###############################################################################

sub append_to_row_cells
{
	my ($self, $query, $addspec) = @_;
	my ($row, $col);

	die "append_to_row_cells: row specifier must be a hash\n"
		if (ref($query) ne 'HASH');

	die "append_to_row_cells: addition specifier must be a hash\n"
		if (ref($addspec) ne 'HASH');

	$row = $self->_find_row($query);
	return
		if (!defined($row));

	foreach $col (keys %$addspec)
	{
		$self->{value}->[$row]->[$col] .= ' '
			if ($self->{value}->[$row]->[$col] ne '');
		$self->{value}->[$row]->[$col] .= $addspec->{$col};
	}
}


###############################################################################
###  old methods - to be used for backward compatibility only!
###############################################################################

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

	die "add_before: method requires list argument\n"
		if (ref($value) ne 'ARRAY');

	die "add_before: invalid argument(s)\n"
		if (@{$value} != 3
		    || ref($value->[2]) ne 'ARRAY');

	return $self->insert_row({ $value->[0] => $value->[1] }, $value->[2]);
}


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

	die "find: method requires list argument\n"
		if (ref($value) ne 'ARRAY');

	die "find: invalid argument(s)\n"
		if (@{$value} != 2);

	return $self->find_row({ $value->[0] => "\b$value->[1]\b" });
}


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

	die "replace: method requires list argument\n"
		if (ref($value) ne 'ARRAY');

	die "replace: invalid argument(s)\n"
		if (@{$value} != 4);

	$self->replace_row_cells({ $value->[0] => $value->[1] },
				 { $value->[2] => $value->[3] });
}


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

	die "modify: method requires list argument\n"
		if (ref($value) ne 'ARRAY');

	die "modify: invalid argument(s)\n"
		if (@{$value} != 4);

	$self->append_to_row_cells({ $value->[0] => $value->[1] },
				   { $value->[2] => $value->[3] });
}


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

1;

__END__