File Coverage

blib/lib/Hash/AutoHash/AVPairsMulti.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	6	6	100.0
condition	3	3	100.0
subroutine	13	13	100.0
pod			n/a
total	66	66	100.0

package Hash::AutoHash::AVPairsMulti;
our $VERSION='1.17';
$VERSION=eval $VERSION;		# I think this is the accepted idiom..

#################################################################################
#
# Author:  Nat Goodman
# Created: 09-03-05
# $Id:
#
# AutoHash with multivalued string or number elements. no references
# Inspired by Tie::Hash::Multivalue
#
#################################################################################
use strict;
use Carp;
use Hash::AutoHash;
use base qw(Hash::AutoHash);

our @NORMAL_EXPORT_OK=@Hash::AutoHash::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 Hash::AutoHash::Args namespace with
#   subs that would mask accessor/mutator AUTOLOADs
# functions herein (except _new) are exportable by Hash::AutoHash::Args
#################################################################################
package Hash::AutoHash::AVPairsMulti::helper;
our $VERSION=$Hash::AutoHash::AVPairsMulti::VERSION;
use strict;
use Carp;
BEGIN {
  our @ISA=qw(Hash::AutoHash::helper);
}
use Hash::AutoHash qw(autohash_tie);

sub _new {
  my($helper_class,$class,@args)=@_;
  my $self=autohash_tie Hash::AutoHash::AVPairsMulti::tie,@args;
  bless $self,$class;
}

#################################################################################
# Tied hash which implements Hash::AutoHash::AVPairsMulti
#################################################################################
package Hash::AutoHash::AVPairsMulti::tie;
our $VERSION=$Hash::AutoHash::AVPairsMulti::VERSION;
use strict;
use Carp;
use Hash::AutoHash::MultiValued;
our @ISA=qw(Hash::AutoHash::MultiValued::tie);

sub STORE {
  my($self,$key,@new)=@_;
  # all values must be simple (non-reference)
  my $bad;
  if (@new==1 && 'ARRAY' eq ref $new[0]) { # if passed ARRAY, look inside
    $bad=1 if grep {ref($_)} @{$new[0]};
  } else {
    $bad=grep {ref($_)} @new;
  }
  confess "Trying to store reference as value of attribute $key" if $bad;
  $self->SUPER::STORE($key,@new);
}
1;

__END__