File Coverage

blib/lib/Test/Mocha/Util.pm
Criterion Covered Total %
statement 36 36 100.0
branch 7 8 87.5
condition 3 3 100.0
subroutine 9 9 100.0
pod 0 3 100.0
total 55 59 98.3


line stmt bran cond sub pod time code
1             package Test::Mocha::Util;
2             # ABSTRACT: Internal utility functions
3             $Test::Mocha::Util::VERSION = '0.66';
4 13     13   102 use strict;
  13         33  
  13         467  
5 13     13   85 use warnings;
  13         25  
  13         360  
6              
7 13     13   85 use Carp 'croak';
  13         26  
  13         703  
8 13     13   101 use Exporter 'import';
  13         34  
  13         401  
9 13     13   77 use Test::Mocha::Types 'Slurpy';
  13         31  
  13         76  
10 13     13   3818 use Types::Standard qw( ArrayRef HashRef );
  13         35  
  13         79  
11              
12             our @EXPORT_OK = qw(
13             check_slurpy_arg
14             extract_method_name
15             find_caller
16             );
17              
18             sub check_slurpy_arg {
19             # """
20             # Checks the arguments list for the presence of a slurpy argument matcher.
21             # It will throw an error if it is used incorrectly.
22             # Otherwise it will just return silently.
23             # """
24             # uncoverable pod
25 736     736 0 1231 my @args = @_;
26              
27 736         1056 my $i = 0;
28 736         1272 foreach (@args) {
29 609 100       1350 if ( Slurpy->check($_) ) {
30 76 100       3216 croak 'No arguments allowed after a slurpy type constraint'
31             if $i < $#args;
32              
33 68         138 my $slurpy = $_->{slurpy};
34 68 100 100     220 croak 'Slurpy argument must be a type of ArrayRef or HashRef'
35             unless $slurpy->is_a_type_of(ArrayRef)
36             || $slurpy->is_a_type_of(HashRef);
37             }
38 595         44954 $i++;
39             }
40 722         1362 return;
41             }
42              
43             sub extract_method_name {
44             # """Extracts the method name from its fully qualified name."""
45             # uncoverable pod
46 406     406 0 772 my ($method_name) = @_;
47 406         1994 $method_name =~ s/.*:://sm;
48 406         1090 return $method_name;
49             }
50              
51             sub find_caller {
52             # """Search the call stack to find an external caller"""
53             # uncoverable pod
54 390     390 0 621 my ( $package, $file, $line );
55              
56 390         581 my $i = 1;
57 390         558 while () {
58 390         2209 ( $package, $file, $line ) = caller $i++;
59 390 50       1176 last if $package ne 'UNIVERSAL::ref';
60             }
61 390         1659 return ( $file, $line );
62             }
63              
64             # sub print_call_stack {
65             # # """
66             # # Returns whether the given C<$package> is in the current call stack.
67             # # """
68             # # uncoverable pod
69             # my ( $message ) = @_;
70             #
71             # print $message, "\n";
72             # my $level = 1;
73             # while ( my ( $caller, $file, $line, $sub ) = caller $level++ ) {
74             # print "\t[$caller] $sub\n";
75             # }
76             # return;
77             # }
78              
79             1;