package Data::Babel::HAH_MultiValued;
#################################################################################
#
# Author: Nat Goodman
# Created: 12-09-21
# $Id:
#
# Specialized Hash::AutoHash::MultiValued that allows undef values
#
#################################################################################
use strict;
use Carp;
use base qw(Hash::AutoHash::MultiValued);
our @NORMAL_EXPORT_OK=@Hash::AutoHash::MultiValued::EXPORT_OK;
my $helper_class=__PACKAGE__.'::helper';
our @EXPORT_OK=$helper_class->EXPORT_OK;
our @SUBCLASS_EXPORT_OK=$helper_class->SUBCLASS_EXPORT_OK;
#################################################################################
# helper package exists to avoid polluting main package namespace with
# subs that would mask accessor/mutator AUTOLOADs
# functions herein (except _new) are exportable by Hash::AutoHash::Args
#################################################################################
package Data::Babel::HAH_MultiValued::helper;
use strict;
use Carp;
BEGIN {
our @ISA=qw(Hash::AutoHash::MultiValued::helper);
}
use Hash::AutoHash::MultiValued qw(autohash_tie);
sub _new {
my($helper_class,$class,@args)=@_;
my $self=autohash_tie Data::Babel::HAH_MultiValued::tie,@args;
bless $self,$class;
}
#################################################################################
# Tied hash which implements Data::Babel::HAH_MultiValued
#################################################################################
package Data::Babel::HAH_MultiValued::tie;
use strict;
our @ISA=qw(Hash::AutoHash::MultiValued::tie);
use constant STORAGE=>0;
use constant UNIQUE=>1;
use constant FILTER=>2;
sub FETCH {
my($self,$key)=@_;
my $storage=$self->[STORAGE];
if (defined $storage->{$key}) {
my $values=$storage->{$key};
return wantarray? @$values: $values;
}
return wantarray? (): undef;
}
sub STORE {
my($self,$key,@new_values)=@_;
my $storage=$self->[STORAGE];
if (@new_values==1 && !defined $new_values[0] && !exists $storage->{$key}) {
# special case - store undef
$storage->{$key}=undef;
return wantarray? (): undef;
}
if (exists $storage->{$key} && !defined $storage->{$key}) {
# special case - existing value is undef
unshift(@new_values,undef);
}
# regular MultiValued STORE
$self->SUPER::STORE($key,@new_values);
}
1;