File Coverage

blib/lib/Hash/AutoHash/AVPairsSingle.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch	7	8	87.5
condition			n/a
subroutine	15	15	100.0
pod			n/a
total	71	72	98.6

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

#################################################################################
#
# Author:  Nat Goodman
# Created: 09-03-05
# $Id:
#
# AutoHash with single-valued, string or number elements. no references
#
#################################################################################
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::AVPairsSingle::helper;
our $VERSION=$Hash::AutoHash::AVPairsSingle::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::AVPairsSingle::tie,@args;
  bless $self,$class;
}

#################################################################################
# Tied hash which implements Hash::AutoHash::MultiValued
#################################################################################
package Hash::AutoHash::AVPairsSingle::tie;
our $VERSION=$Hash::AutoHash::AVPairsSingle::VERSION;
use strict;
use Carp;
use Tie::Hash;
our @ISA=qw(Tie::ExtraHash);
use constant STORAGE=>0;

sub TIEHASH {
  my($class,@hash)=@_;
  my $self=bless [{}],$class;
  if (@hash==1) {		# flatten if ARRAY or HASH
    my $hash=shift @hash;
    @hash=('ARRAY' eq ref $hash)? @$hash: ('HASH' eq ref $hash)? %$hash: ();
  }
  while (@hash>1) {		      # store initial values
    my($key,$value)=splice @hash,0,2; # shift 1st two elements
      $self->STORE($key,$value);
  }
  $self;
}
sub STORE {
  my($self,$key,$new)=@_;
  confess "Trying to store reference as value of attribute $key" if ref $new;
  $self->[STORAGE]->{$key}=$new;
}
1;

__END__