File Coverage

blib/lib/Mock/Quick.pm

Criterion	Covered	Total	%
statement	61	62	98.3
branch	6	6	100.0
condition			n/a
subroutine	20	21	95.2
pod	0	1	0.0
total	87	90	96.6

package Mock::Quick;
use strict;
use warnings;
use Exporter::Declare;
use Mock::Quick::Class;
use Mock::Quick::Object;
use Mock::Quick::Object::Control;
use Mock::Quick::Method;
use Mock::Quick::Util;
use Carp qw/carp/;

our $VERSION = '1.111';

import_arguments qw/intercept/;

sub after_import {
    my $class = shift;
    my ( $importer, $specs ) = @_;

    return unless $specs->config->{intercept};

    my $intercept = $specs->config->{intercept};
    no strict 'refs';
    *{"$importer\::QINTERCEPT"} = sub { $intercept };
}

my %CLASS_RELATED = (
    qclass     => 'new',
    qtakeover  => 'takeover',
    qimplement => 'implement',
);

for my $operation ( keys %CLASS_RELATED ) {
    my $meth = $CLASS_RELATED{$operation};

    default_export $operation => sub {
        my @args = @_;

        return Mock::Quick::Class->$meth(@args)
            if defined wantarray;

        my $caller = caller;
        return $caller->QINTERCEPT->(sub { Mock::Quick::Class->$meth(@args) })
            if $caller->can( 'QINTERCEPT' );

        carp "Return value is ignored, your mock is destroyed as soon as it is created.";
    };
}

default_export qcontrol => sub { Mock::Quick::Object::Control->new(@_) };

default_export qobj => sub {
    my $obj     = Mock::Quick::Object->new(@_);
    my $control = Mock::Quick::Object::Control->new($obj);
    $control->strict(0);
    return $obj;
};

default_export qobjc => sub {
    my $obj     = Mock::Quick::Object->new(@_);
    my $control = Mock::Quick::Object::Control->new($obj);
    $control->strict(0);
    return ( $obj, $control );
};

default_export qstrict => sub {
    my $obj     = Mock::Quick::Object->new(@_);
    my $control = Mock::Quick::Object::Control->new($obj);
    $control->strict(1);
    return $obj;
};

default_export qstrictc => sub {
    my $obj     = Mock::Quick::Object->new(@_);
    my $control = Mock::Quick::Object::Control->new($obj);
    $control->strict(1);
    return ( $obj, $control );
};

default_export qclear => sub    { \$Mock::Quick::Util::CLEAR };
default_export qmeth  => sub(&) { Mock::Quick::Method->new(@_) };

purge_util();

1;

__END__