File Coverage

blib/lib/Util/Underscore.pm
Criterion Covered Total %
statement 98 99 98.9
branch 10 12 83.3
condition 1 3 33.3
subroutine 32 32 100.0
pod n/a
total 141 146 96.5


line stmt bran cond sub pod time code
1             package Util::Underscore;
2              
3             #ABSTRACT: Common helper functions without having to import them
4              
5 13     13   147916 use strict;
  13         20  
  13         375  
6 13     13   48 use warnings;
  13         17  
  13         395  
7              
8 13     13   5792 use version 0.77; our $VERSION = qv('v1.4.1');
  13         19222  
  13         68  
9 13     13   9892 use overload ();
  13         6961  
  13         223  
10              
11 13     13   58 use Carp ();
  13         16  
  13         218  
12 13     13   6643 use Const::Fast 0.011 ();
  13         27049  
  13         339  
13 13     13   6173 use Data::Dump 1.10 ();
  13         54106  
  13         417  
14 13     13   7501 use List::MoreUtils 0.07 ();
  13         108584  
  13         387  
15 13     13   88 use List::Util 1.35 ();
  13         213  
  13         194  
16 13     13   6467 use POSIX ();
  13         72640  
  13         388  
17 13     13   95 use Scalar::Util 1.36 ();
  13         310  
  13         283  
18 13     13   6296 use Try::Tiny 0.03 ();
  13         15053  
  13         330  
19 13     13   11594 use IPC::Run 0.92 ();
  13         396261  
  13         703  
20              
21              
22             BEGIN {
23             # check if a competing "_" exists
24 13 100   13   446 if (keys %{_::}) {
25 1         22 Carp::confess qq(The package "_" has already been defined);
26             }
27             }
28              
29             BEGIN {
30             # Load the dummy "_.pm" module.
31             # This will set up various booby traps so that "_" isn't used directly.
32             # In order to prevent the traps from triggering when *we* go there, we have
33             # to declare our peaceful intentions:
34 12     12   47 local our $_WE_COME_IN_PEACE = 'pinky swear';
35 12         4519 require _;
36             }
37              
38             our $_ASSIGN_ALIASES;
39              
40             BEGIN {
41             $_ASSIGN_ALIASES = sub {
42 108         422 my ($pkg, %aliases) = @_;
43 12     12   48 no strict 'refs'; ## no critic (ProhibitNoStrict)
  12         12  
  12         1121  
44 108         288 while (my ($this, $that) = each %aliases) {
45 432         401 my $target = "_::${this}";
46 432         390 my $source = "${pkg}::${that}";
47 432         6426 *{$target} = *{$source}{CODE}
  432         1222  
48 432   33     282 // Carp::croak "Unknown subroutine $source in _ASSIGN_ALIASES";
49             }
50 12     12   537 };
51             }
52              
53              
54             # From now, every function is in the "_" package
55             ## no critic (ProhibitMultiplePackages)
56             package # Hide from PAUSE
57             _;
58              
59             ## no critic (RequireArgUnpacking, RequireFinalReturn, ProhibitSubroutinePrototypes)
60             # Why this "no critic"? In an util module, efficiency is crucial because we
61             # have no idea about the context where these function are being used. Therefore,
62             # no arg unpacking, and no explicit return. Most functions are so trivial anyway
63             # that this isn't much of a legibility concern.
64             # Subroutine prototypes are used to offer a convenient and natural interface.
65             # I fully understand why they shouldn't be used in ordinary code, but this
66             # module puts them to mostly good use.
67              
68             # Predeclare a few things so that we can use them in the sub definitions below.
69             sub blessed(_);
70             sub ref_type(_);
71              
72             # load the actual function collections
73 12     12   4745 use Util::Underscore::Scalars ();
  12         20  
  12         216  
74 12     12   4183 use Util::Underscore::Numbers ();
  12         22  
  12         186  
75 12     12   4266 use Util::Underscore::References ();
  12         20  
  12         207  
76 12     12   4290 use Util::Underscore::Objects ();
  12         21  
  12         202  
77 12     12   4387 use Util::Underscore::ListUtils ();
  12         28  
  12         415  
78              
79              
80             BEGIN {
81 12     12   28 $_ASSIGN_ALIASES->(
82             'Carp',
83             carp => 'carp',
84             cluck => 'cluck',
85             croak => 'croak',
86             confess => 'confess',
87             );
88             }
89              
90             $_ASSIGN_ALIASES->(
91             'Try::Tiny',
92             try => 'try',
93             catch => 'catch',
94             finally => 'finally',
95             );
96              
97             sub carpf($@) {
98 1     1   2121 my $pattern = shift;
99 1         8 @_ = sprintf $pattern, @_;
100 1         28 goto &carp;
101             }
102              
103             sub cluckf($@) {
104 1     1   667 my $pattern = shift;
105 1         5 @_ = sprintf $pattern, @_;
106 1         13 goto &cluck;
107             }
108              
109             sub croakf($@) {
110 1     1   1010 my $pattern = shift;
111 1         5 @_ = sprintf $pattern, @_;
112 1         12 goto &croak;
113             }
114              
115             sub confessf($@) {
116 1     1   568 my $pattern = shift;
117 1         6 @_ = sprintf $pattern, @_;
118 1         10 goto &confess;
119             }
120              
121              
122             $_ASSIGN_ALIASES->('Scalar::Util', is_open => 'openhandle');
123              
124             sub _::prototype ($;$) {
125 10 100   10   3521 if (@_ == 2) {
126 4 50       19 goto &Scalar::Util::set_prototype if @_ == 2;
127             }
128 6 50       11 if (@_ == 1) {
129 6         7 my ($coderef) = @_;
130 6         21 return prototype $coderef; # Calls CORE::prototype
131             }
132             else {
133             ## no critic (RequireInterpolationOfMetachars)
134 0         0 Carp::confess '_::prototype($;$) takes exactly one or two arguments';
135             }
136             }
137              
138             # This sub uses CamelCase because it's a factory function
139             sub Dir(@) { ## no critic (NamingConventions::Capitalization)
140 1     1   1601 require Path::Class;
141 1         23294 Path::Class::Dir->new(@_);
142             }
143              
144             # This sub uses CamelCase because it's a factory function
145             sub File(@) { ## no critic (NamingConventions::Capitalization)
146 1     1   2347 require Path::Class;
147 1         7 Path::Class::File->new(@_);
148             }
149              
150              
151             $_ASSIGN_ALIASES->(
152             'Data::Dump',
153             pp => 'pp',
154             dd => 'dd',
155             );
156              
157              
158             ## no critic (ProhibitBuiltinHomonyms)
159             sub caller(;$) {
160 3     3   2458 require Util::Underscore::CallStackFrame;
161 3 100       22 Util::Underscore::CallStackFrame->of(@_ ? shift() + 1 : 1);
162             }
163              
164             sub callstack(;$) {
165 2 100   2   4096 my $level = @_ ? shift() + 1 : 1;
166 2         4 my @callers;
167 2         13 while (my $caller = Util::Underscore::CallStackFrame->of($level + @callers))
168             {
169 23         71 push @callers, $caller;
170             }
171 2         16 return @callers;
172             }
173              
174              
175             $_ASSIGN_ALIASES->(
176             'IPC::Run',
177             process_run => 'run',
178             process_start => 'start',
179             );
180              
181              
182              
183             1;
184              
185             __END__