File Coverage

blib/lib/Mock/Quick/Object.pm

Criterion	Covered	Total	%
statement	40	42	95.2
branch	3	4	75.0
condition			n/a
subroutine	13	15	86.6
pod	0	3	0.0
total	56	64	87.5

package Mock::Quick::Object;
use strict;
use warnings;

use Mock::Quick::Util;
use Mock::Quick::Object::Control;
use Carp ();
use Scalar::Util ();

our $AUTOLOAD;

class_meth new => sub {
    my $class = shift;
    my %proto = @_;
    return bless \%proto, $class;
};

sub AUTOLOAD {
    # Do not shift this, we need it when we use goto &$sub
    my ($self) = @_;
    my ( $package, $sub ) = ( $AUTOLOAD =~ m/^(.+)::([^:]+)$/ );
    $AUTOLOAD = undef;

    Carp::croak "Can't locate object method \"$sub\" via package \"$package\""
        unless Scalar::Util::blessed( $self );

    my $code = $self->can( $sub );
    Carp::croak "Can't locate object method \"$sub\" in this instance"
        unless $code;

    goto &$code;
};

alt_meth can => (
    class => sub { no warnings 'misc'; goto &UNIVERSAL::can },
    obj => sub {
        my ( $self, $name ) = @_;

        my $control = Mock::Quick::Object::Control->new( $self );
        return if $control->strict && !exists $self->{$name};

        my $sub;
        {
            no warnings 'misc';
            $sub = UNIVERSAL::can( $self, $name );
        }
        $sub ||= sub {
            unshift @_ => ( shift( @_ ), $name );
            goto &call;
        };
        inject( Scalar::Util::blessed( $self ), $name, $sub );
        return $sub;
    },
);

# http://perldoc.perl.org/perlobj.html#Default-UNIVERSAL-methods
# DOES is equivalent to isa by default
sub isa     { no warnings 'misc'; goto &UNIVERSAL::isa     }
sub DOES    { goto &isa                                    }
sub VERSION { no warnings 'misc'; goto &UNIVERSAL::VERSION }

obj_meth DESTROY => sub {
    my $self = shift;
    Mock::Quick::Object::Control->new( $self )->_clean;
    unshift @_ => ( $self, 'DESTROY' );
    goto &call;
};

purge_util();

1;

__END__