File Coverage

blib/lib/Object/Lazy.pm

Criterion	Covered	Total	%
statement	59	63	93.6
branch	19	24	79.1
condition	5	6	83.3
subroutine	11	12	91.6
pod	5	5	100.0
total	99	110	90.0

package Object::Lazy; ## no critic (TidyCode)

use strict;
use warnings;

our $VERSION = '0.15';

use Carp qw(confess);
use Try::Tiny;
use Object::Lazy::Validate;

sub new { ## no critic (ArgUnpacking)
    my ($class, $params) = Object::Lazy::Validate::validate_new(@_);

    $params = Object::Lazy::Validate::init($params);
    my $self = bless $params, $class;
    if ( exists $params->{ref} ) {
        Object::Lazy::Ref::register($self);
    }

    return $self;
}

my $build_object = sub {
    my ($self, $self_ref) = @_;

    local *__ANON__ = 'BUILD_OBJECT'; ## no critic (LocalVars)
    my $built_object = $self->{build}->();
    # don't build a second time
    $self->{build} = sub { return $built_object };
    if ( ! $self->{is_built} ) {
        $self->{is_built} = 1;
        if ( exists $self->{logger} ) {
            try {
                confess('object built');
            }
            catch {
                $self->{logger}->($_);
            };
        }
    }
    ${$self_ref} = $built_object;

    return $built_object;
};

sub DESTROY {} # is not AUTOLOAD

sub AUTOLOAD { ## no critic (Autoloading ArgUnpacking)
    my ($self, @params) =  @_;

    my $method = substr our $AUTOLOAD, 2 + length __PACKAGE__;
    my $built_object = $build_object->($self, \$_[0]);

    return $built_object->$method(@params);
}

sub isa { ## no critic (ArgUnpacking)
    my ($self, $class2check) = @_;

    my @isa
        = ref $self->{isa} eq 'ARRAY'
        ? @{ $self->{isa} }
        : ( $self->{isa} );
    if ( $self->{is_built} || ! @isa ) {
        my $built_object = $build_object->($self, \$_[0]);
        return $built_object->isa($class2check);
    }
    CLASS: for my $class (@isa) {
        $class->isa($class2check) and return 1;
    }
    my %isa = map { ($_ => undef) } @isa;

    return exists $isa{$class2check};
}

sub DOES { ## no critic (ArgUnpacking)
    my ($self, $class2check) = @_;

    UNIVERSAL->can('DOES')
        or confess 'UNIVERSAL 1.04 (Perl 5.10) required for method DOES';

    my @does
        = ref $self->{DOES} eq 'ARRAY'
        ? @{ $self->{DOES} }
        : ( $self->{DOES} );
    my @isa_and_does = (
        (
            ref $self->{isa} eq 'ARRAY'
            ? @{ $self->{isa} }
            : ( $self->{isa} )
        ),
        @does,
    );
    if ( $self->{is_built} || ! @isa_and_does ) {
        my $built_object = $build_object->($self, \$_[0]);
        return $built_object->DOES($class2check);
    }
    CLASS: for my $class (@does) {
        $class->DOES($class2check) and return 1;
    }
    my %isa_and_does = map { ($_ => undef) } @isa_and_does;

    return exists $isa_and_does{$class2check};
}

sub can { ## no critic (ArgUnpacking)
    my ($self, $method) = @_;

    my $built_object = $build_object->($self, \$_[0]);

    return $built_object->can($method);
}

sub VERSION { ## no critic (ArgUnpacking)
    my ($self, @version) = @_;

    if ( ! $self->{is_built} ) {
        if ( defined $self->{VERSION} ) {
            $Object::Lazy::Version::VERSION = $self->{VERSION};
            return +( bless {}, 'Object::Lazy::Version' )->VERSION(@version);
        }
        if ( $self->{version_from} ) {
            return +( bless {}, $self->{version_from} )->VERSION(@version);
        }
    }
    my $built_object = $build_object->($self, \$_[0]);

    return $built_object->VERSION(@version);
}

# $Id$

1;

__END__