File Coverage

blib/lib/Hash/Objectify.pm

Criterion	Covered	Total	%
statement	58	58	100.0
branch	16	16	100.0
condition	3	9	33.3
subroutine	13	14	92.8
pod			n/a
total	90	97	92.7

use 5.008001;
use strict;
use warnings;

package Hash::Objectify;

# ABSTRACT: Create objects from hashes on the fly

our $VERSION = '0.006';

use Carp;
use Sub::Install;
use Scalar::Util qw/blessed/;

my %CACHE;
my $COUNTER = 0;

sub import {
    my ($class) = @_;
    my $caller = caller;

    Sub::Install::install_sub(
        {
            code => sub {
                my ( $ref, $package ) = @_;
                my $type = ref $ref;
                unless ( $type eq 'HASH' ) {
                    $type =
                        $type eq ''   ? "a scalar value"
                      : blessed($ref) ? "an object of class $type"
                      :                 "a reference of type $type";
                    croak "Error: Can't objectify $type";
                }
                if ( defined $package ) {
                    no strict 'refs';
                    @{ $package . '::ISA' } = 'Hash::Objectified'
                      unless $package->isa('Hash::Objectified');
                }
                else {
                    my ( $caller, undef, $line ) = caller;
                    my $cachekey = join "", sort keys %$ref;
                    if ( !defined $CACHE{$caller}{$line}{$cachekey} ) {
                        no strict 'refs';
                        $package = $CACHE{$caller}{$line}{$cachekey} = "Hash::Objectified$COUNTER";
                        $COUNTER++;
                        @{ $package . '::ISA' } = 'Hash::Objectified';
                    }
                    else {
                        $package = $CACHE{$caller}{$line}{$cachekey};
                    }
                }
                bless {%$ref}, $package;
            },
            into => $caller,
            as   => 'objectify',
        }
    );
}

package Hash::Objectified;

use Class::XSAccessor;

our $AUTOLOAD;

sub can {
    my ( $self, $key ) = @_;
    return undef unless ref $self && exists $self->{$key}; ## no critic
    $self->$key; # install accessor if not installed
    return $self->SUPER::can($key);
}

sub AUTOLOAD {
    my $self   = shift;
    my $method = $AUTOLOAD;
    $method =~ s/.*:://;
    if ( ref $self && exists $self->{$method} ) {
        Class::XSAccessor->import(
            accessors => { $method => $method },
            class     => ref $self
        );
    }
    else {
        my $class = ref $self || $self;
        die qq{Can't locate object method "$method" via package "$class"};
    }
    return $self->$method(@_);
}

sub DESTROY { } # because we AUTOLOAD, we need this too

1;


# vim: ts=4 sts=4 sw=4 et:

__END__