File Coverage

blib/lib/Hash/Objectify.pm

Criterion	Covered	Total	%
statement	68	68	100.0
branch	16	16	100.0
condition	4	12	33.3
subroutine	16	17	94.1
pod	2	2	100.0
total	106	115	92.1

use 5.008001;
use strict;
use warnings;

package Hash::Objectify;

# ABSTRACT: Create objects from hashes on the fly

our $VERSION = '0.007'; # TRIAL

use Carp;
use Exporter 5.57 'import';
use Scalar::Util qw/blessed/;

our @EXPORT    = qw/objectify/;
our @EXPORT_OK = qw/objectify_lax/;

my %CACHE;
my $COUNTER = 0;

sub objectify {
    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';
        push @{ $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};
        }
    }
    return bless {%$ref}, $package;
}

sub objectify_lax {
    my ( $ref, $package ) = @_;
    my $obj = objectify( $ref, $package );
    $package ||= ref($obj);
    {
        no strict 'refs';
        unshift @{ $package . '::ISA' }, 'Hash::Objectified::Lax';
    }
    return $obj;
}

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
        );
        return $self->$method(@_);
    }
    else {
        return $self->_handle_missing($method);
    }
}

sub _handle_missing {
    my ( $self, $method ) = @_;
    my $class = ref $self || $self;
    die qq{Can't locate object method "$method" via package "$class"};
}

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

package Hash::Objectified::Lax;

sub _handle_missing {
    return undef; ## no critic
}

1;


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

__END__