File Coverage

blib/lib/Test/Stub/Generator.pm

Criterion	Covered	Total	%
statement	65	71	91.5
branch	15	16	93.7
condition	9	10	90.0
subroutine	19	21	90.4
pod	2	6	33.3
total	110	124	88.7

package Test::Stub::Generator;
use 5.008005;
use strict;
use warnings;

use Test::More;
use Test::Deep;

use Exporter qw(import);
use Carp qw(croak);
use Class::Monadic;
use Data::Util qw(is_array_ref is_code_ref);

our $VERSION   = "0.02";
our @EXPORT    = qw(make_subroutine make_method);
our @EXPORT_OK = qw(
    make_subroutine_utils
    make_method_utils
    make_repeat_subroutine
    make_repeat_method
);

sub make_subroutine {
    my (@args)  = @_;
    return _convert_build( [@args], is_object => 0 );
}

sub make_subroutine_utils {
    my (@args)  = @_;
    return _convert_build( [@args], is_object => 0, want_utils => 1 );
}

sub make_repeat_subroutine {
    my (@args)  = @_;
    return _convert_build( [@args], is_object => 0, is_repeat => 1 );
}

sub make_method {
    my (@args)  = @_;
    return _convert_build( [@args], is_object => 1 );
}

sub make_method_utils {
    my (@args)  = @_;
    return _convert_build( [@args], is_object => 1, want_utils => 1 );
}

sub make_repeat_method {
    my (@args)  = @_;
    return _convert_build( [@args], is_object => 1, is_repeat => 1 );
}

sub _convert_build {
    my ($args, %inner_opts) = @_;
    my ($exp_ret_list, $opts) = @$args;
    $exp_ret_list = [$exp_ret_list] unless is_array_ref $exp_ret_list;
    $opts ||= {};
    return _build( $exp_ret_list, { %{ $opts }, %inner_opts } );
}

sub _build {
    my ($exp_ret_list, $opts) = @_;

    my $message    = $opts->{message}    || "[stub] arguments are as You expected";
    my $is_object  = $opts->{is_object}  || 0;
    my $is_repeat  = $opts->{is_repeat}  || 0;
    my $want_utils = $opts->{want_utils} || 0;
    my $call_count = 0;

    my $method = sub {
        my $input = [@_];
        shift @$input if $is_object;
        $call_count++;

        my $element = $is_repeat ? $exp_ret_list->[0] : shift @$exp_ret_list;
        unless ( defined $element ) {
            fail 'expects and return are already empty.';
            return undef;
        }

        my $expects = $element->{expects};
        my $return  = $element->{return};

        cmp_deeply($input, $expects, $message)
            or note explain +{ input => $input, expects => $expects };

        return is_code_ref($return) ? $return->() : $return;
    };

    unless ($want_utils) {
        return $method;
    }

    my $utils = bless( {}, 'Test::Stub::Generator::Util' );
    Class::Monadic->initialize($utils)->add_methods(
        has_next => sub {
            return @$exp_ret_list ? 1 : 0;
        },
        is_repeat => sub {
            return $is_repeat;
        },
        called_count => sub {
            return $call_count;
        },
    );

    return ($method, $utils);
}

1;
__END__