File Coverage

blib/lib/Data/CHEF.pm

Criterion	Covered	Total	%
statement	6	215	2.7
branch	0	64	0.0
condition	0	3	0.0
subroutine	2	24	8.3
pod	14	15	93.3
total	22	321	6.8

#
# Package Definition
#

package Data::CHEF;

#
# Perl Options
#

use strict;

#
# Includes
#

#
# Global Variables
#

use vars qw/$VERSION /;

$VERSION=1.01;

#
# Constructor Method
#

sub new
{
my ($proto)=shift;
my ($class)=ref($proto) || $proto;
my ($object)={};
bless ($object,$class);
$object->_init(@_);
return($object);
}

sub read
{
my ($self)=shift;
my ($line,$key,$value,$subline,$prefix,$eoi,@input,$preline);
my (@preinput)=@_;
while (@preinput)
{
	$preline=shift(@preinput);
	push(@input,split(/\n/,$preline));
}
my (@stack);
while (@input)
{
	$line=shift(@input);
	$line=~s/^\s+//;
	next if ($line=~/^#/);
	if ($line =~/==/)
	{
		($key,$value)=split(/==/,$line);
		$key=_checkKey($key);
		if ($key)
		{
			if (@stack)
			{
				$key=$stack[$#stack].".".$key;
			}
			if ($self->{data}->{$key})
			{
				$self->{data}->{$key}.=$value
			} else {
				$self->{data}->{$key}=$value;
			}
		}
	} elsif ($line=~/=>/)
	{
		($key,$eoi)=split(/=>/,$line);
		$key=_checkKey($key);
		my ($bar);
		if ($eoi =~/^\|/)
		{
			$eoi=~s/^\|//;
			$bar=1;
		}
		if ($key)
		{
			if (@stack)
			{
				$key=$stack[$#stack].".".$key;
			}
			$value="";
			while($subline=shift(@input))
			{
				$subline=~s/^\s+//;
				if ($bar)
				{
					$subline=~s/^\|//;
				}
				if ($subline eq $eoi)
				{
					$bar=0;
					last;
				}
				$value.=$subline."\n";
			}
			if ($self->{data}->{$key})
			{
				$self->{data}->{$key}.=$value
			} else {
				$self->{data}->{$key}=$value;
			}
		}
	} elsif ($line=~/=\{/)
	{
		($prefix)=split(/=\{/,$line);
		if (@stack)
		{
			$prefix=$stack[$#stack].".".$prefix;
		}
		push(@stack,$prefix);
	} elsif ($line eq "}")
	{
		pop(@stack);
	}
}
$self->_index();
return;
}

sub readHash
{
my ($self)=shift;
my (%hash)=@_;
my ($k);
foreach $k (CORE::keys(%hash))
{
	$self->{data}->{$k}=$hash{$k};
}
$self->_index();
return;
}

sub writeStream
{
my ($self)=shift;
my ($output)="";
my ($field,$eoi,@keys);
(@keys)=$self->keys();
foreach $field (@keys)
{
	if ($self->{data}->{$field}=~/\n/)
	{
		$eoi=$self->_randEOI($self->{data}->{$field});
		$output.=$field."=>".$eoi."\n".
			$self->{data}->{$field}."<".$eoi;
	} else {
		$output.=$field."==".$self->{data}->{$field}."\n";
	}
}
return($output);
}

sub keys
{
my ($self)=shift;
return(sort(CORE::keys(%{$self->{data}})));
}

sub get
{
my ($self)=shift;
if (scalar(@_) > 1)
{
	my ($key,%hash);
	foreach $key (@_)
	{
		$hash{$key}=$self->{data}->{$key};
	}
	return(%hash);
} else {
	my ($key)=shift;
	return $self->{data}->{$key};
}
}

sub set
{
my ($self)=shift;
my ($key,$value,$reindex);
while (@_)
{
	($key,$value)=splice(@_,0,2);
	$key=_checkKey($key);
	if ($key)
	{
		$reindex=1 unless ($self->{data}->{$key});
		$self->{data}->{$key}=$value;
	}
}
if ($reindex)
{
	$self->_index();
}
return;
}

sub dump
{
my ($self)=shift;
return(%{$self->{data}});
}

sub copy
{
my ($self)=shift;
my ($subkey)=shift;
my (@list,$chef);
(@list)=$self->_childKeys($subkey);
$chef=$self->new();
$chef->readHash($self->get(@list));
return($chef);
}

sub spawn
{
my ($self)=shift;
my ($subkey)=shift;
my ($skf,$key,$new,@list);
(@list)=$self->_childKeys($subkey);
$skf=ref($self)->new();
foreach $key (@list)
{
	$new=_chopKey($key,$subkey);
	$skf->set($new,$self->get($key));
}
return($skf);
}

sub spawnArray
{
my ($self)=shift;
my ($subkey)=shift;
my ($skf,$key,$rest,$test,$index,$new,$element,@list,@array,@processed);
(@list)=$self->_childKeys($subkey);
foreach $key (@list)
{
	$new=_chopKey($key,$subkey);
	($test,$rest)=split(/\./,$new,2);
	if ($test =~ /\((\d+)\)/)
	{
		$index=$1;
		unless ($array[$index])
		{
			print("Creating index $index\n");
			$array[$index]=$self->new();
			$array[$index]->set("_array.index",$index);
		}
		$array[$index]->set($rest,$self->get($key));
	}
}
foreach $element (@array)
{
	push(@processed,$element) if (ref($element));
}
return(@processed);
}

sub spawnHash
{
my ($self)=shift;
my ($subkey)=shift;
my ($key,$new,$test,$rest,$hkey,@list,%hash);
(@list)=$self->_childKeys($subkey);
foreach $key (@list)
{
	$new=_chopKey($key,$subkey);
	($test,$rest)=split(/\./,$new,2);
	if ($test =~ /\[(\w+)\]/)
	{
		$hkey=$1;
		unless ($hash{$hkey})
		{
			$hash{$hkey}=$self->new();
			$hash{$hkey}->set("_array.hash",$hkey);
		}
		$hash{$hkey}->set($rest,$self->get($key));
	}
}
return (%hash);
}

sub current
{
my ($self)=shift;
my ($pos);
$pos=$self->{index}->[$self->{ptr}];
return($pos,$self->{data}->{$pos});
}

sub next
{
my ($self)=shift;
unless ($self->{ptr}==$#{$self->{index}})
{
	$self->{ptr}++;
}
return;
}

sub prev
{
my ($self)=shift;
unless ($self->{ptr}==0)
{
	$self->{ptr}--;
}
return;
}

#
# Hidden Methods
#

sub _init
{
my ($self)=shift;
return;
}

#
# Initialize the data pointer to zero
# Recalculate the maximum size of the ptr
sub _index
{
my ($self)=shift;
my (@keys);
(@keys)=sort(CORE::keys(%{$self->{data}}));
$self->{index}=[ @keys ];
$self->{ptr}=0;
return;
}

#
# Create a random end of input string
# for writing multiline values
# double check to make sure marker isn't identical to value
sub _randEOI
{
my ($self)=shift;
my ($value)=shift;
my ($eoi,$count);
do {
	$count=2;
	$eoi="";
	while ($count)
	{
		$eoi.=chr(int(rand(26))+97);
		$count--;
	}
	$count=3;
	while ($count)
	{
		$eoi.=int(rand(10));
		$count--;
	}
} until ($eoi ne $value);
return($eoi);
}

#
# Check the key to make sure it's valid
sub _checkKey
{
my ($key)=shift;
$key=lc($key);
if ($key=~/^([\w\-]+|\(\d+\)|\[[\w\-]+\])(\.([\w\-]+|\(\d+\)|\[[\w\-]+\]))*$/)
{
	return $key;
} else {
	print("Invalid key ($key)\n");
	return undef;
}
}

sub _childKeys
{
my ($self)=shift;
my ($substr)=shift;
$substr="^".quotemeta($substr);
my ($k,@list);
foreach $k ($self->keys())
{
	if ($k =~ /$substr/)
	{
		push(@list,$k);
	}
}
return(@list);
}

sub _chopKey
{
my ($key,$parent)=@_;
my ($child);
$parent="^".quotemeta($parent.".");
$child=$key;
$child=~s/$parent//;
return($child);
}

#
# Special version of set
# Allows uppercase characters in keys
sub _set
{
my ($self)=shift;
my ($key,$value,$reindex);
while (@_)
{
        ($key,$value)=splice(@_,0,2);
        if ($key)
        {
                $reindex=1 unless ($self->{data}->{$key});
                $self->{data}->{$key}=$value;
        }
}
if ($reindex)
{
        $self->_index();
}
return;
}

#
# Exit Block
#
1;

__END__