File Coverage

blib/lib/Test/Mocha/MethodStub.pm
Criterion Covered Total %
statement 51 51 100.0
branch 12 12 100.0
condition 5 7 71.4
subroutine 16 16 100.0
pod 0 6 100.0
total 84 92 97.8


line stmt bran cond sub pod time code
1             package Test::Mocha::MethodStub;
2             # ABSTRACT: Objects to represent stubbed methods with arguments and responses
3             $Test::Mocha::MethodStub::VERSION = '0.61';
4 21     21   75 use strict;
  21         24  
  21         609  
5 21     21   80 use warnings;
  21         23  
  21         496  
6 21     21   73 use parent qw( Test::Mocha::Method );
  21         603  
  21         93  
7              
8 21     21   964 use Carp qw( croak );
  21         27  
  21         776  
9 21     21   75 use Scalar::Util qw( blessed );
  21         21  
  21         6052  
10              
11             sub new {
12             # uncoverable pod
13 84     84 0 650 my $class = shift;
14 84         311 my $self = $class->SUPER::new(@_);
15              
16 84   50     1123 $self->{executions} ||= []; # ArrayRef[ CodeRef ]
17              
18 84         121 return $self;
19             }
20              
21             sub cast {
22             # """Convert the type of the given object to this class"""
23             # uncoverable pod
24 64     64 0 68 my ( $class, $obj ) = @_;
25 64   50     217 $obj->{executions} ||= [];
26 64         180 return bless $obj, $class;
27             }
28              
29             sub returns {
30             # """Adds a return response to the end of the executions queue."""
31             # uncoverable pod
32 24     24 0 27 my ( $self, @return_values ) = @_;
33              
34 24         1224 warnings::warnif( 'deprecated',
35             'returns() method is deprecated; use the returns() function instead' );
36              
37 24         89 push @{ $self->{executions} },
38 38     38   153 @return_values == 1 ? sub { $return_values[0] }
39 2     2   9 : @return_values > 1 ? sub { @return_values }
40 24 100   2   22 : sub { }; # @return_values == 0
  2 100       9  
41              
42 24         58 return $self;
43             }
44              
45             sub throws {
46             # """Adds an exception response to the end of the executions queue."""
47             # uncoverable pod
48 8     8 0 20 my ( $self, @exception ) = @_;
49              
50 8         365 warnings::warnif( 'deprecated',
51             'throws() method is deprecated; use the throws() function instead' );
52              
53 8         60 push @{ $self->{executions} },
54             # check if first arg is a throwable exception
55             ( blessed( $exception[0] ) && $exception[0]->can('throw') )
56 1     1   3 ? sub { $exception[0]->throw }
57 8 100 100 8   9 : sub { croak @exception };
  8         461  
58              
59 8         14 return $self;
60             }
61              
62             sub executes {
63             # """Adds a callback response to the end of the executions queue."""
64             # uncoverable pod
65 2     2 0 4 my ( $self, $callback ) = @_;
66              
67 2         99 warnings::warnif( 'deprecated',
68             'executes() method is deprecated; use the executes() function instead'
69             );
70              
71 2 100       78 croak 'executes() must be given a coderef'
72             unless ref($callback) eq 'CODE';
73              
74 1         1 push @{ $self->{executions} }, $callback;
  1         3  
75              
76 1         1 return $self;
77             }
78              
79             sub do_next_execution {
80             # """Executes the next response."""
81             # uncoverable pod
82 135     135 0 173 my ( $self, @args ) = @_;
83 135         143 my $executions = $self->{executions};
84              
85             # return undef by default
86 135 100       99 return if @{$executions} == 0;
  135         250  
87              
88             # shift the next execution off the front of the queue
89             # ... except for the last one
90 129         216 my $execution =
91 129 100       99 @{$executions} > 1 ? shift( @{$executions} ) : $executions->[0];
  14         19  
92              
93 129         242 return $execution->(@args);
94             }
95              
96             1;