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)");