package Hash::Lookup;
# ABSTRACT: easy data lookup
{ our $VERSION = '0.002'; }
use base qw(autobox);
sub import {
    my $class = shift;
    $Hash::Lookup::Subs::sep = shift() || '.';
    $class->SUPER::import(
                          HASH => 'Hash::Lookup::Subs',
                          ARRAY => 'Hash::Lookup::Subs',
                          SCALAR => 'Hash::Lookup::Subs',
                         );
}
package Hash::Lookup::Subs;
use Mojo::Util qw/dumper/;
use List::Util qw/reduce/;
use strict;
*_lookup = *_recursive_lookup;
sub _old_working_lookup {
    my $l = reduce(sub {
                       return \undef unless ref($$a);
                       return \undef if ref($$a) eq 'ARRAY' && $b !~ /^\d+$/;
                       return ref($$a) eq 'ARRAY' && $b =~ /^\d+$/ ? \($$a->[$b]) : \($$a->{$b});
                   },
                   \shift, split /\./, shift());
    return $l;
}
sub _recursive_lookup {
    my ($data, $key) = @_;
    return \undef unless defined $data && ref($data);
    return \$data unless defined $key;
    my ($first, @rest) = split /\./, $key;
    if ($key =~ /\,/) {
        return do { my $r = [ map { ${_lookup($data, $_)} } split /\,/, $key ]; \$r }
    }
    elsif (ref($data) eq 'ARRAY' && $first =~ /^\d+$/) {
        return @rest ? _lookup($data->[$first], join('.', @rest)) : \($data->[$first]);
    }
    elsif (ref($data) eq 'ARRAY' && $first eq '[]') {
        return @rest ? do { my $t = [ map { ${_lookup($_, join('.', @rest))} } @$data ]; \$t } : \$data;
    }
    elsif (ref($data) eq 'HASH' && $first eq '[]') {
        return @rest  ?
            do { my $t = [ map { ${_lookup($data->{$_}, join('.', @rest))} } sort keys %$data ]; \$t } :
            do { my $t = [ map { $data->{$_} } sort keys %$data ]; \$t; };
    }
    elsif (ref($data) eq 'HASH' && exists $data->{$first}) {
        return @rest ? _lookup($data->{$first}, join('.', @rest)) : \($data->{$first});
    }
    return \undef;
}
sub lookup { shift()->get(@_) }
sub get {
    my $h = shift;
    my $k = shift;
    my $l = _lookup($h, $k);
    return $$l
}
sub set {
    my ($h, $k, $v) = @_;
    my $l = _lookup($h, $k);
    $$l = $v;
    return $h
}
1;