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.67';
4 13     13   116 use strict;
  13         38  
  13         515  
5 13     13   90 use warnings;
  13         33  
  13         441  
6              
7 13     13   78 use Carp 'croak';
  13         28  
  13         949  
8 13     13   85 use Exporter 'import';
  13         47  
  13         490  
9 13     13   91 use Test::Mocha::Types 'Slurpy';
  13         40  
  13         82  
10 13     13   3842 use Types::Standard qw( ArrayRef HashRef );
  13         56  
  13         88  
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 1292 my @args = @_;
26              
27 736         1152 my $i = 0;
28 736         1326 foreach (@args) {
29 609 100       1411 if ( Slurpy->check($_) ) {
30 76 100       3588 croak 'No arguments allowed after a slurpy type constraint'
31             if $i < $#args;
32              
33 68         137 my $slurpy = $_->{slurpy};
34 68 100 100     184 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         45373 $i++;
39             }
40 722         1405 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 827 my ($method_name) = @_;
47 406         2475 $method_name =~ s/.*:://sm;
48 406         1095 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 647 my ( $package, $file, $line );
55              
56 390         608 my $i = 1;
57 390         538 while () {
58 390         3020 ( $package, $file, $line ) = caller $i++;
59 390 50       1275 last if $package ne 'UNIVERSAL::ref';
60             }
61 390         1684 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;