File Coverage

blib/lib/Object/FromData/Hash.pm

Criterion	Covered	Total	%
statement	53	62	85.4
branch	14	24	58.3
condition	1	2	50.0
subroutine	10	14	71.4
pod	7	7	100.0
total	85	109	77.9

package Object::FromData::Hash;

use strict;
use warnings;
use Digest::MD5 'md5_hex';    # convenience, not security

sub _new {
    my ( $class, $arg_for ) = @_;

    my $hashref       = $arg_for->{ref};
    my $allow_private = $arg_for->{allow_private} || 0;
    my @all_keys      = sort CORE::keys %$hashref;
    my @keys          = $allow_private ? @all_keys : grep { !/^_/ } @all_keys;

    my $new_class = "${class}::" . md5_hex( join '-' => @keys );
    {
        no strict 'refs';
        @{"${new_class}::ISA"} = $class;
    }

    my %hash;
    my $self = {
        hash          => \%hash,
        keys          => \@keys,
        allow_private => $allow_private,
        current_index => 0,
    };

    KEY: foreach my $key (@all_keys) {
        my $value = $hashref->{$key};
        if ( !ref $value ) {
            $hash{$key} = $value;
        }
        elsif ( 'ARRAY' eq ref $value ) {
            $hash{$key}
              = Object::FromData::Array->_new( { ref => $value } );
        }
        elsif ( 'HASH' eq ref $value ) {
            $hash{$key} = $class->_new( { ref => $value } );
        }
        else {
            die "Don't yet handle $value";
        }
        if ( $key =~ /^_/ ) {
            next KEY unless $allow_private;
        }
        no strict 'refs';
        *{"$new_class::$key"} = sub { $hash{$key} };
    }
    return bless $self => $new_class;
}

sub keys {
    my $self = shift;
    $self = shift if @_;
    return keys %{ $self->{hash} };
}

sub values {
    my $self = shift;
    $self = shift if @_;
    return values %{ $self->{hash} };
}

sub reset {
    my $self = shift;
    $self = shift if @_;
    $self->{current_index} = 0;
}

sub has_more {
    my $self = shift;
    $self = shift if @_;
    my $keys = $self->{keys};
    return $self->{current_index} <= $#$keys;
}

sub each {
    my $self = shift;
    $self = shift if @_;
    my $keys = $self->{keys};
    return unless $self->{current_index} <= $#$keys;
    my $key = $self->{keys}[ $self->{current_index}++ ];
    return $key, $self->$key;
}

sub is_hashref  {1}
sub is_arrayref { }

1;

__END__