File Coverage

blib/lib/Test/Mock/Signature.pm

Criterion	Covered	Total	%
statement	80	80	100.0
branch	7	8	87.5
condition			n/a
subroutine	18	18	100.0
pod	6	6	100.0
total	111	112	99.1

package Test::Mock::Signature;

use strict;
use warnings;

use Class::Load qw(load_class);

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

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

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

sub init { }

sub new {
    my $class  = shift;
    my $singleton = do {
        no strict 'refs';
        ${$class .'::singleton'}
    };
    return $singleton if $singleton;

    my $params = {
        _real_class => do {
            no strict 'refs';
            ${$class .'::CLASS'}
        },
        _method_dispatcher => {},
        @_
    };

    $singleton = bless($params, $class);
    {
        no strict 'refs';
        ${$class .'::singleton'} = $singleton;
    }
    $singleton->init;

    return $singleton;
}

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 $mock  = do {
        no strict 'refs';
        ${$class . '::CLASS'};
    };

    load_class($mock);

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

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

    *{$mock .'::_tms_mock_instance'} = sub {
        return $class->new;
    };

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

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

        *$dst_glob = *$src_glob;
    }
}

42;

__END__