view release on metacpan or  search on metacpan

TwoLevelHash.pm  view on Meta::CPAN

sub NEXTKEY {
	my $self = shift;
        return each %{$self->{BIHASH}}
}

#-------------------------------------------------------#

sub _deleteRecord { 
	my $self = shift;
	my $record = shift;
	if (!defined($record)) {
		carp("Not enough args passed to _deleteRecord");
		return 0;
	}
	my $file = $self->{PATH};
	my ($foo,$str,$bar);
	my $fh;
	unless ($fh = new FileHandle(">$file")) {
	#unless ($fh = new FileHandle("$file")) { # DEBUG
		croak ("can't open $file: $!");
	}
	my %bihash = %{$self->{'BIHASH'}};
	$str .= $self->{'COMMENTS'} if defined($self->{'COMMENTS'});

	foreach $foo (sort keys %bihash) {
		#print "$foo $bihash{$foo} d\n";
		if ($foo eq $record) {
		#$bihash{$foo} = undef;
			next;
		}
		$str .= "\n$foo\n";
		my $zog = $bihash{$foo};
		my %zog=%$zog;
		# Get all values in %zog 
			foreach $bar (sort keys %zog) {
				$str .= "\t$bar\: $zog{$bar}\n" unless !defined($zog{$bar});
			}
	}

	$self->{'BIHASH'} = \%bihash;
print $fh $str;
close $fh;
return 1;
}

#-----------------------------------------------------------#

sub _get_HoH {
	my ($self) = shift;
	my ($slh) = shift;
	my ($key, $val);
	my ($name, @lines, $rec, $line);
	my (%HoH);
	my ($FH) = new FileHandle;

	if (!open($FH,"$slh")) {
		croak "Cannot open $FH $slh: $!";
	}

local $/ = "";

my @records = <$FH>;

# Make sure comments at top of TLH file stay
my $comment;
if ($records[0] && $records[0] =~ /^#/) {
	$comment = $records[0];
	chop $comment;
	shift @records;
}
	foreach $rec (@records) {

    ($name, @lines) = split /\n[\s]*/, $rec;

    foreach $line (@lines) {
        ($key, $val) = split /:\s*/, $line;
	$HoH{$name}->{$key} = $val;

    }
}
	if (!close($FH)) {
		croak "Cannot close $FH: $!";
	}

return ($comment, %HoH);
} # end _get_HoH

#-----------------------------------------------------------#

sub GetHash {
	my ($self) = shift;
	my ($hash, %hash);
	my $name = $self->{UNIHASHNAME} if ($self->{UNIHASHNAME} ne "");
	
	if (defined($name)) {
		$hash = $self->{BIHASH}->{$name};
	}else{
		$hash = $self->{BIHASH};
	}
	%hash = %$hash;

	return %hash;
}

#-----------------------------------------------------------#

1;

__END__

=head1 NAME

Tie::TwoLevelHash - Tied interface to multi-dimensional (Two-Level) hash files

=head1 SYNOPSIS

 # Tie to Hash-o-hashes	
 use Tie::TwoLevelHash;
 tie (%hash, 'Tie::TwoLevelHash', $file, 'rw');  # Open in read/write mode