File Coverage

lib/Data/AsObject/Hash.pm

Criterion	Covered	Total	%
statement	64	70	91.4
branch	23	36	63.8
condition	9	24	37.5
subroutine	17	17	100.0
pod	0	1	0.0
total	113	148	76.3

package Data::AsObject::Hash;
BEGIN {
  $Data::AsObject::Hash::VERSION = '0.07';
}

# ABSTRACT: Base class for Data::AsObject hashrefs

use strict;
use warnings;
use Carp;
use Data::AsObject ();
use namespace::clean -except => [qw/AUTOLOAD/];

our $AUTOLOAD;

sub can {
    if(@_ != 2) {
        local $AUTOLOAD = ref($_[0]) .'::can';
        return $_[0]->AUTOLOAD(@_);
    }

    my($self, $key) = @_;
    return unless( exists $self->{$key} );
    return sub { __get_data($self, $key) };
}

sub AUTOLOAD {
    my $self = shift;
    my $index = shift;
        my $data;

    my $key = $AUTOLOAD;
    $key =~ s/.*:://;
    undef $AUTOLOAD;

    if ($key eq "can" && defined $index && $index != /\d+/) {
        return undef;
    }

    if ($key eq "isa" && defined $index && $index != /\d+/) {
        $index eq ref($self) or
        $index eq "Data::AsObject::Hash" or
        $index eq "UNIVERSAL"
            ? return 1
            : return 0;
    }

    return __get_data($self, $key, $index);
}

sub __get_data {
    my ($self, $key, $index) = @_;
    my $data = exists $self->{$key} ? $self->{$key} : __guess_data($self, $key);
    my $mode = ref($self) =~ /^.*::(\w+)$/ ? $1 : '';

    if ( !$data ) {
        return     if $key eq "DESTROY";

        my $msg = "Attempting to access non-existing hash key $key!";

        carp $msg  if $mode eq 'Loose';
        croak $msg if $mode eq 'Strict';
        return;
    }

    if (
            defined $index
        && $index =~ /\d+/
        && $Data::AsObject::__check_type->($data) eq "ARRAY"
        && exists $data->[$index]
    )
    {
        $data = $data->[$index];
    }

    if ( $Data::AsObject::__check_type->($data) eq "ARRAY" ) {
        bless $data, "Data::AsObject::Array::$mode";
    } elsif ( $Data::AsObject::__check_type->($data) eq "HASH" ) {
        bless $data, "Data::AsObject::Hash::$mode";
    }

    return $data;
}

sub __guess_data {
    my $self = shift;
    my $key_regex = shift;
    my $has_colon_or_dash = $key_regex =~ s/_/[-:]/g;
    my @matches = grep(/$key_regex/, keys %$self) if $has_colon_or_dash;

    if ( @matches == 1 ) {
        return $self->{$matches[0]};
    } elsif ( @matches > 1 ) {
        carp "Attempt to disambiguate hash key $key_regex returns multiple matches!";
        return $self->{$matches[0]};
    }

    return;
}


package Data::AsObject::Hash::Strict;
BEGIN {
  $Data::AsObject::Hash::Strict::VERSION = '0.07';
}
use base 'Data::AsObject::Hash';

package Data::AsObject::Hash::Loose;
BEGIN {
  $Data::AsObject::Hash::Loose::VERSION = '0.07';
}
use base 'Data::AsObject::Hash';

package Data::AsObject::Hash::Silent;
BEGIN {
  $Data::AsObject::Hash::Silent::VERSION = '0.07';
}
use base 'Data::AsObject::Hash';

1;


__END__