File Coverage

blib/lib/Test/Mock/Signature.pm

Criterion	Covered	Total	%
statement	69	69	100.0
branch	9	12	75.0
condition	2	3	66.6
subroutine	16	16	100.0
pod	6	6	100.0
total	102	106	96.2

package Test::Mock::Signature;

use strict;
use warnings;

use Scalar::Util qw(weaken);
use Class::Load qw(load_class);

use Test::Mock::Signature::Meta;

our $VERSION = '0.03';
our @EXPORT_OK = qw(any);

my $singleton = {
};

sub any() {
    return $Data::PatternCompare::any;
}

sub init { }

sub new {
    my $class      = shift;
    my $mock_class = do {
        no strict 'refs';
        ${$class . '::CLASS'};
    };
    $mock_class  ||= shift;

    die "No class for mocking defined. Look documentation for constructor new()." unless $mock_class;

    my $param = {
        _method_dispatcher => {},
        _real_class => $mock_class,
        @_
    };

    return $singleton->{$mock_class} if exists $singleton->{$mock_class};

    load_class($mock_class);

    $singleton->{$mock_class} = bless($param, $class);
    weaken($singleton->{$mock_class});
    $singleton->{$mock_class}->init;

    return $singleton->{$mock_class};
}

sub method {
    my $self   = shift;
    my $method = shift;
    my $params = [ @_ ];

    return Test::Mock::Signature::Meta->new(
        class  => $self->{'_real_class'},
        method => $method,
        params => $params
    );
}

sub clear {
    my $self   = shift;
    my $method = shift;
    my $params = [ @_ ];
    my $md     = $self->{'_method_dispatcher'};

    unless (scalar @$params) {
        delete $self->{'_method_dispatcher'}->{$method};
        # do not return dispatcher object for GC
        return;
    }

    my $meta = Test::Mock::Signature::Meta->new(
        class  => $self->{'_real_class'},
        method => $method,
        params => $params
    );

    $md->{$method}->delete($meta);
}

sub dispatcher {
    my $self   = shift;
    my $method = shift;
    my $md     = $self->{'_method_dispatcher'};

    return $md->{$method} if exists $md->{$method};

    $md->{$method} = Test::Mock::Signature::Dispatcher->new($self->{'_real_class'} .'::'. $method);
}

sub import {
    my $class = shift;

    my $caller = caller;
    my %export = map { $_ => 1 } @EXPORT_OK;

    no strict 'refs';
    no warnings 'redefine';

    for my $i ( @_ ) {
        next unless exists $export{$i};

        my $src_glob = __PACKAGE__  .'::'. $i;
        my $dst_glob = $caller .'::'. $i;

        *$dst_glob = *$src_glob;
    }
}

sub DESTROY {
    my $self = shift;
    return unless ref($self);

    delete $singleton->{$self->{'_real_class'}};
}

42;

__END__