Array-AsHash
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/Array/AsHash.pm view on Meta::CPAN
local $Data::Dumper::Terse = 1;
my $self = CORE::shift;
my $string = '';
return $string unless $self;
while ( my ( $k, $v ) = $self->each ) {
foreach ( $k, $v ) {
$_ = ref $_ ? Data::Dumper::Dumper($_) : $_;
}
$string .= "$k\n $v\n";
}
return $string;
};
}
use overload bool => $_bool, '""' => $_to_string, fallback => 1;
my $_actual_key = sub {
my ( $self, $key ) = @_;
if ( ref $key ) {
my $new_key = $self->{curr_key_of}{ refaddr $key};
return refaddr $key unless defined $new_key;
$key = $new_key;
}
return $key;
};
# private because it doesn't match expectations. The "index" of a
# non-existent key is one greater than the current list
my $_index = sub {
my ( $self, $key ) = @_;
my $index =
$self->exists($key)
? $self->{index_of}{$key}
: scalar @{ $self->{array_for} }; # automatically one greater
return $index;
};
my $_croak = sub {
my ( $proto, $message ) = @_;
require Carp;
Carp::croak($message);
};
my $_validate_kv_pairs = sub {
my ( $self, $arg_for ) = @_;
my $sub = $arg_for->{sub} || ( caller(1) )[3];
if ( @{ $arg_for->{pairs} } % 2 ) {
$self->$_croak("Arguments to $sub must be an even-sized list");
}
};
sub new {
my $class = shift;
return $class->_initialize(@_);
}
sub _initialize {
my ( $class, $arg_ref ) = @_;
my $self = bless {} => $class;
$self->{array_for} = [];
return $self unless $arg_ref;
my $array = $arg_ref->{array} || [];
$self->{is_strict} = $arg_ref->{strict};
$array = Clone::clone($array) if $arg_ref->{clone};
unless ( 'ARRAY' eq ref $array ) {
$class->$_croak('Argument to new() must be an array reference');
}
if ( @$array % 2 ) {
$class->$_croak('Uneven number of keys in array');
}
$self->{array_for} = $array;
foreach ( my $i = 0; $i < @$array; $i += 2 ) {
my $key = $array->[$i];
$self->{index_of}{$key} = $i;
if ( ref $key ) {
my $old_address = refaddr $arg_ref->{array}[$i];
my $curr_key = "$key";
$self->{curr_key_of}{$old_address} = $curr_key;
}
}
return $self;
}
sub get {
my ( $self, @keys ) = @_;
my @get;
foreach my $key (@keys) {
$key = $self->$_actual_key($key);
next unless defined $key;
my $exists = $self->exists($key);
if ( $self->{is_strict} && !$exists ) {
$self->$_croak("Cannot get non-existent key ($key)");
}
if ($exists) {
CORE::push @get, $self->{array_for}[ $self->$_index($key) + 1 ];
}
elsif ( @keys > 1 ) {
CORE::push @get, undef;
}
else {
return;
}
}
return wantarray ? @get
: @keys > 1 ? \@get
: $get[0];
}
my $_insert = sub {
my ( $self, $key, $label, $index ) = splice @_, 0, 4;
$self->$_validate_kv_pairs(
{ pairs => \@_, sub => "Array::AsHash::insert_$label" } );
$key = $self->$_actual_key($key);
unless ( $self->exists($key) ) {
$self->$_croak("Cannot insert $label non-existent key ($key)");
view all matches for this distributionview release on metacpan - search on metacpan
( run in 2.261 seconds using v1.00-cache-2.02-grep-82fe00e-cpan-f5108d614456 )