File Coverage

File:blib/lib/Test/Mocha/MethodStub.pm
Coverage:95.5%

linestmtbrancondsubpodtimecode
1package Test::Mocha::MethodStub;
2# ABSTRACT: Objects to represent stubbed methods with arguments and responses
3$Test::Mocha::MethodStub::VERSION = '0.61';
4
24
24
24
67
18
80
use parent 'Test::Mocha::Method';
5
24
24
24
819
22
316
use strict;
6
24
24
24
49
22
2443
use warnings;
7
8sub new {
9    # uncoverable pod
10
144
0
669
    my $class = shift;
11
144
335
    my $self  = $class->SUPER::new(@_);
12
13
144
1534
    $self->{responses} ||= [];  # ArrayRef[ CodeRef ]
14
15
144
311
    return $self;
16}
17
18sub __responses {
19
186
106
    my ($self) = @_;
20
186
456
    return $self->{responses};
21}
22
23sub cast {
24    # """Convert the type of the given object to this class"""
25    # uncoverable pod
26
68
0
52
    my ( $class, $obj ) = @_;
27
68
178
    $obj->{responses} ||= [];
28
68
97
    return bless $obj, $class;
29}
30
31sub execute_next_response {
32    # uncoverable pod
33
118
0
108
    my ( $self, @args ) = @_;
34
118
96
    my $responses = $self->__responses;
35
36    # return undef by default
37
118
118
59
159
    return if @{$responses} == 0;
38
39    # shift the next response off the front of the queue
40    # ... except for the last one
41
114
140
    my $response =
42
114
10
64
6
      @{$responses} > 1 ? shift( @{$responses} ) : $responses->[0];
43
44
114
157
    return $response->(@args);
45}
46
471;