File: | lib/Util/Underscore.pm |
Coverage: | 77.3% |
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 | 12 12 12 | 56 28 469 | use strict; | ||||
6 | 12 12 12 | 79 20 601 | use warnings; | ||||
7 | 12 12 12 | 56 18 562 | no warnings 'once'; | ||||
8 | |||||||
9 | 12 12 12 | 4536 41015 728 | use version 0.77 (); our $VERSION = version->declare('v1.0.1'); | ||||
10 | |||||||
11 | 12 12 12 | 85 299 341 | use Scalar::Util 1.36 (); | ||||
12 | 12 12 12 | 74 304 295 | use List::Util 1.35 (); | ||||
13 | 12 12 12 | 5496 13870 338 | use List::MoreUtils 0.07 (); | ||||
14 | 12 12 12 | 114 21 276 | use Carp (); | ||||
15 | 12 12 12 | 18616 7501 318 | use Safe::Isa 1.000000 (); | ||||
16 | 12 12 12 | 5217 64433 303 | use Try::Tiny (); | ||||
17 | 12 12 12 | 18066 171263 328 | use Package::Stash (); | ||||
18 | 12 12 12 | 35156 142624 378 | use Data::Dump (); | ||||
19 | 12 12 12 | 97 22 398 | use overload (); | ||||
20 | |||||||
21 | use constant { | ||||||
22 | 12 | 1581 | true => !!1, | ||||
23 | false => !!0, | ||||||
24 | 12 12 | 57 20 | }; | ||||
25 | |||||||
26 | ## no critic ProhibitSubroutinePrototypes | ||||||
27 | |||||||
28 - 56 | =pod =encoding utf8 =head1 SYNOPSIS use Util::Underscore; _::croak "$foo must do Some::Role" if not _::does($foo, 'Some::Role'); =head1 DESCRIPTION This module contains various utility functions, and makes them accessible through the C<_> package. This allows the use of these utilities (a) without much per-usage overhead and (b) without namespace pollution. It contains functions from the following modules: =for :list * L<Scalar::Util> * L<List::Util> * L<List::MoreUtils> * L<Carp> * L<Safe::Isa>, which contains convenience functions for L<UNIVERSAL> * L<Try::Tiny> Not all functions from those are available, and some have been renamed. =cut | ||||||
57 | |||||||
58 | BEGIN { | ||||||
59 | # check if a competing "_" exists | ||||||
60 | 12 | 910 | if (keys %{_::}) { | ||||
61 | 1 | 15 | Carp::confess qq(The package "_" has already been defined); | ||||
62 | } | ||||||
63 | } | ||||||
64 | |||||||
65 | BEGIN { | ||||||
66 | # prevent other "_" packages from being loaded: | ||||||
67 | # Just setting the ${INC} entry would fail too silently, | ||||||
68 | # so we also rigged the "import" method. | ||||||
69 | |||||||
70 | $INC{'_.pm'} = *_::import = sub { | ||||||
71 | 0 | 0 | Carp::confess qq(The "_" package is internal to Util::Underscore) | ||||
72 | . qq(and must not be imported directly.\n); | ||||||
73 | 11 | 587 | }; | ||||
74 | } | ||||||
75 | |||||||
76 | my $assign_aliases = sub { | ||||||
77 | my ($pkg, %aliases) = @_; | ||||||
78 | 11 11 11 | 60 16 30354 | no strict 'refs'; ## no critic ProhibitNoStrict | ||||
79 | while (my ($this, $that) = each %aliases) { | ||||||
80 | *{ '_::' . $this } = *{ $pkg . '::' . $that }{CODE} | ||||||
81 | // die "Unknown subroutine ${pkg}::${that}"; | ||||||
82 | } | ||||||
83 | }; | ||||||
84 | |||||||
85 - 87 | =head1 FUNCTION REFERENCE =cut | ||||||
88 | |||||||
89 - 139 | =head2 Scalar::Util =begin :list = C<$str = _::blessed $object> = C<$str = _::class $object> wrapper for C<Scalar::Util::blessed> = C<$int = _::ref_addr $ref> wrapper for C<Scalar::Util::refaddr> = C<$str = _::ref_type $ref> wrapper for C<Scalar::Util::reftype> = C<_::ref_weaken $ref> wrapper for C<Scalar::Util::weaken> = C<_::ref_unweaken $ref> wrapper for C<Scalar::Util::unweaken> = C<$bool = _::ref_is_weak $ref> wrapper for C<Scalar::Util::isweak> = C<$scalar = _::new_dual $num, $str> wrapper for C<Scalar::Util::dualvar> = C<$bool = _::is_dual $scalar> wrapper for C<Scalar::Util::isdual> = C<$bool = _::is_vstring $scalar> wrapper for C<Scalar::Util::isvstring> = C<$bool = _::is_numeric $scalar> wrapper for C<Scalar::Util::looks_like_number> = C<$fh = _::is_open $fh> wrapper for C<Scalar::Util::openhandle> = C<$bool = _::is_readonly $scalar> wrapper for C<Scalar::Util::readonly> = C<$str = _::prototype \&code> = C<_::prototype \&code, $new_proto> gets or sets the prototype, wrapping either C<CORE::prototype> or C<Scalar::Util::set_prototype> = C<$bool = _::is_tainted $scalar> wrapper for C<Scalar::Util::tainted> =end :list =cut | ||||||
140 | |||||||
141 | $assign_aliases->( | ||||||
142 | 'Scalar::Util', | ||||||
143 | class => 'blessed', | ||||||
144 | blessed => 'blessed', | ||||||
145 | ref_addr => 'refaddr', | ||||||
146 | ref_type => 'reftype', | ||||||
147 | ref_weaken => 'weaken', | ||||||
148 | ref_unweaken => 'unweaken', | ||||||
149 | ref_is_weak => 'isweak', | ||||||
150 | new_dual => 'dualvar', | ||||||
151 | is_dual => 'isdual', | ||||||
152 | is_vstring => 'isvstring', | ||||||
153 | is_numeric => 'looks_like_number', | ||||||
154 | is_open => 'openhandle', | ||||||
155 | is_readonly => 'readonly', | ||||||
156 | is_tainted => 'tainted', | ||||||
157 | ); | ||||||
158 | |||||||
159 | sub _::prototype ($;$) { | ||||||
160 | 10 | 0 | 29 | if (@_ == 2) { | |||
161 | 4 | 34 | goto &Scalar::Util::set_prototype if @_ == 2; | ||||
162 | } | ||||||
163 | 6 | 16 | if (@_ == 1) { | ||||
164 | 6 | 10 | my ($coderef) = @_; | ||||
165 | 6 | 38 | return prototype $coderef; | ||||
166 | } | ||||||
167 | else { | ||||||
168 | 0 | 0 | Carp::confess '_::prototype(&;$) takes exactly one or two arguments'; | ||||
169 | } | ||||||
170 | } | ||||||
171 | |||||||
172 - 191 | =head2 Type Validation Utils These are inspired from C<Params::Util> and C<Data::Util>. The I<reference validation> routines take one argument (or C<$_>) and return a boolean value. They return true when the value is intended to be used as a reference of that kind: either C<ref $arg> is of the requested type, or it is an overloaded object that can be used as a reference of that kind. It will not be checked that an object claims to perform an appropriate role (e.g. C<< $arg->DOES('ARRAY') >>). =for :list * C<_::is_ref> (any nonblessed reference) * C<_::is_scalar_ref> * C<_::is_array_ref> * C<_::is_hash_ref> * C<_::is_code_ref> * C<_::is_glob_ref> * C<_::is_regex> (note that regexes are blessed objects, not plain references) =cut | ||||||
192 | |||||||
193 | sub _::is_ref(_) { | ||||||
194 | 16 | 0 | 53 | return false if not defined $_[0]; | |||
195 | 13 | 195 | return true | ||||
196 | if defined Scalar::Util::reftype $_[0] | ||||||
197 | && !defined Scalar::Util::blessed $_[0]; | ||||||
198 | 8 | 25 | return false; | ||||
199 | } | ||||||
200 | |||||||
201 | sub _::is_scalar_ref(_) { | ||||||
202 | 16 | 0 | 63 | return false if not defined $_[0]; | |||
203 | 13 | 398 | return true | ||||
204 | if 'SCALAR' eq ref $_[0] | ||||||
205 | || overload::Method($_[0], '${}'); | ||||||
206 | 12 | 44 | return false; | ||||
207 | } | ||||||
208 | |||||||
209 | sub _::is_array_ref(_) { | ||||||
210 | 16 | 0 | 60 | return false if not defined $_[0]; | |||
211 | 13 | 368 | return true | ||||
212 | if 'ARRAY' eq ref $_[0] | ||||||
213 | || overload::Method($_[0], '@{}'); | ||||||
214 | 12 | 50 | return false; | ||||
215 | } | ||||||
216 | |||||||
217 | sub _::is_hash_ref(_) { | ||||||
218 | 16 | 0 | 52 | return false if not defined $_[0]; | |||
219 | 13 | 388 | return true | ||||
220 | if 'HASH' eq ref $_[0] | ||||||
221 | || overload::Method($_[0], '%{}'); | ||||||
222 | 12 | 48 | return false; | ||||
223 | } | ||||||
224 | |||||||
225 | sub _::is_code_ref(_) { | ||||||
226 | 16 | 0 | 60 | return false if not defined $_[0]; | |||
227 | 13 | 364 | return true | ||||
228 | if 'CODE' eq ref $_[0] | ||||||
229 | || overload::Method($_[0], '&{}'); | ||||||
230 | 12 | 44 | return false; | ||||
231 | } | ||||||
232 | |||||||
233 | sub _::is_glob_ref(_) { | ||||||
234 | 16 | 0 | 58 | return false if not defined $_[0]; | |||
235 | 13 | 914 | return true | ||||
236 | if 'GLOB' eq ref $_[0] | ||||||
237 | || overload::Method($_[0], '*{}'); | ||||||
238 | 12 | 733 | return false; | ||||
239 | } | ||||||
240 | |||||||
241 | sub _::is_regex(_) { | ||||||
242 | 16 | 0 | 91 | return false if not defined Scalar::Util::blessed $_[0]; | |||
243 | 1 | 8 | return true | ||||
244 | if 'Regexp' eq ref $_[0] | ||||||
245 | || overload::Method($_[0], 'qr'); | ||||||
246 | 0 | 0 | return false; | ||||
247 | } | ||||||
248 | |||||||
249 - 298 | =pod An assortment of other validation routines remains. A I<simple scalar> is a scalar value which is neither C<undef> nor a reference. =begin :list = C<$bool = _::is_int $_> The argument is a simple scalar that's neither C<undef> nor a reference, and its stringification matches a signed integer. = C<$bool = _::is_uint $_> Like C<_::is_int>, but the stringification must match an unsigned integer (i.e. the number is zero or positive). = C<$bool = _::is_plain $_> Checks that the value is C<defined> and not a reference of any kind. This is as close as Perl gets to checking for a string. = C<$bool = _::is_identifier $_> Checks that the given string would be a legal identifier: a letter followed by zero or more word characters. = C<$bool = _::is_package $_> Checks that the given string is a valid package name. It only accepts C<Foo::Bar> notation, not the C<Foo'Bar> form. This does not assert that the package actually exists. = C<$bool = _::class_isa $class, $supertype> Checks that the C<$class> inherits from the given C<$supertype>, both given as strings. In most cases, one should use `_::class_does` instead. = C<$bool = _::class_does $class, $role> Checks that the C<$class> performs the given C<$role>, both given as strings. = C<$bool = _::is_instance $object, $role> Checks that the given C<$object> can perform the C<$role>. This is essentially equivalent to `_::does`. =end :list =cut | ||||||
299 | |||||||
300 | sub _::is_int(_) { | ||||||
301 | 16 | 0 | 216 | return true | |||
302 | if defined $_[0] | ||||||
303 | && !defined Scalar::Util::reftype $_[0] | ||||||
304 | && $_[0] =~ /\A [-]? [0-9]+ \z/x; | ||||||
305 | 14 | 49 | return false; | ||||
306 | } | ||||||
307 | |||||||
308 | sub _::is_uint(_) { | ||||||
309 | 16 | 0 | 209 | return true | |||
310 | if defined $_[0] | ||||||
311 | && !defined Scalar::Util::reftype $_[0] | ||||||
312 | && $_[0] =~ /\A [0-9]+ \z/x; | ||||||
313 | 15 | 50 | return false; | ||||
314 | } | ||||||
315 | |||||||
316 | sub _::is_plain(_) { | ||||||
317 | 16 | 0 | 182 | return true | |||
318 | if defined $_[0] | ||||||
319 | && !defined Scalar::Util::reftype $_[0]; | ||||||
320 | 9 | 34 | return false; | ||||
321 | } | ||||||
322 | |||||||
323 | sub _::is_identifier(_) { | ||||||
324 | 16 | 0 | 174 | return true | |||
325 | if defined $_[0] | ||||||
326 | && $_[0] =~ /\A [^\W\d]\w* \z/x; | ||||||
327 | 15 | 50 | return false; | ||||
328 | } | ||||||
329 | |||||||
330 | sub _::is_package(_) { | ||||||
331 | 16 | 0 | 172 | return true | |||
332 | if defined $_[0] | ||||||
333 | && $_[0] =~ /\A [^\W\d]\w* (?: [:][:]\w+ )* \z/x; | ||||||
334 | 14 | 68 | return false; | ||||
335 | } | ||||||
336 | |||||||
337 | sub _::class_isa($$) { | ||||||
338 | 0 | 0 | 0 | return true | |||
339 | if _::is_package $_[0] | ||||||
340 | && $_[0]->isa($_[1]); | ||||||
341 | 0 | 0 | return false; | ||||
342 | } | ||||||
343 | |||||||
344 | sub _::class_does($$) { | ||||||
345 | 0 | 0 | 0 | return true | |||
346 | if _::is_package $_[0] | ||||||
347 | && $_[0]->DOES($_[1]); | ||||||
348 | 0 | 0 | return false; | ||||
349 | } | ||||||
350 | |||||||
351 | sub _::is_instance($$) { | ||||||
352 | 0 | 0 | 0 | return true | |||
353 | if Scalar::Util::blessed $_[0] | ||||||
354 | && $_[0]->DOES($_[1]); | ||||||
355 | 0 | 0 | return false; | ||||
356 | } | ||||||
357 | |||||||
358 - 434 | =head2 List::Util and List::MoreUtils =begin :list = C<$scalar = _::reduce { BLOCK } @list> wrapper for C<List::Util::reduce> = C<$bool = _::any { PREDICATE } @list> wrapper for C<List::Util::any> = C<$bool = _::all { PREDICATE } @list> wrapper for C<List::Util::all> = C<$bool = _::none { PREDICATE } @list> wrapper for C<List::Util::none> = C<$scalar = _::first { PREDICATE } @list> wrapper for C<List::MoreUtils::first_value> = C<$int = _::first_index { PREDICATE } @list> wrapper for C<List::MoreUtils::first_index> = C<$scalar = _::last { PREDICATE } @list> wrapper for C<List::MoreUtils::last_value> = C<$int = _::last_index { PREDICATE } @list> wrapper for C<List::MoreUtils::last_index> = C<$num = _::max @list> = C<$str = _::max_str @list> wrappers for C<List::Util::max> and C<List::Util::maxstr>, respectively. = C<$num = _::min @list> = C<$str = _::min_str @list> wrappers for C<List::Util::min> and C<List::Util::minstr>, respectively. = C<$num = _::sum 0, @list> wrapper for C<List::Util::sum> = C<$num = _::product @list> wrapper for C<List::Util::product> = C<%kvlist = _::pairgrep { PREDICATE } %kvlist> wrapper for C<List::Util::pairgrep> = C<($k, $v) = _::pairfirst { PREDICATE } %kvlist> wrapper for C<List::Util::pairfirst> = C<%kvlist = _::pairmap { BLOCK } %kvlist> wrapper for C<List::Util::pairmap> = C<@list = _::shuffle @list> wrapper for C<List::Util::shuffle> = C<$iter = _::natatime $size, @list> wrapper for C<List::MoreUtils::natatime> = C<@list = _::zip \@array1, \@array2, ...> wrapper for C<List::MoreUtils::zip> Unlike C<List::MoreUtils::zip>, this function directly takes I<array references>, and not array variables. It still uses the same implementation. This change makes it easier to work with anonymous arrayrefs, or other data that isn't already inside a named array variable. = C<@list = _::uniq @list> wrapper for C<List::MoreUtils::uniq> = C<@list = _::part { INDEX_FUNCTION } @list> wrapper for C<List::MoreUtils::part> = C<$iter = _::each_array \@array1, \@array2, ...> wrapper for C<List::MoreUtils::each_arrayref> =end :list =cut | ||||||
435 | |||||||
436 | $assign_aliases->( | ||||||
437 | 'List::Util', | ||||||
438 | reduce => 'reduce', | ||||||
439 | any => 'any', | ||||||
440 | all => 'all', | ||||||
441 | none => 'none', | ||||||
442 | max => 'max', | ||||||
443 | max_str => 'maxstr', | ||||||
444 | min => 'min', | ||||||
445 | min_str => 'minstr', | ||||||
446 | sum => 'sum', | ||||||
447 | product => 'product', | ||||||
448 | pairgrep => 'pairgrep', | ||||||
449 | pairfirst => 'pairfirst', | ||||||
450 | pairmap => 'pairmap', | ||||||
451 | shuffle => 'shuffle', | ||||||
452 | ); | ||||||
453 | |||||||
454 | $assign_aliases->( | ||||||
455 | 'List::MoreUtils', | ||||||
456 | first => 'first_value', | ||||||
457 | first_index => 'first_index', | ||||||
458 | last => 'last_value', | ||||||
459 | last_index => 'last_index', | ||||||
460 | natatime => 'natatime', | ||||||
461 | uniq => 'uniq', | ||||||
462 | part => 'part', | ||||||
463 | each_array => 'each_arrayref', | ||||||
464 | ); | ||||||
465 | |||||||
466 | sub _::zip { | ||||||
467 | 1 | 0 | 45 | goto &List::MoreUtils::zip; # adios, prototypes! | |||
468 | } | ||||||
469 | |||||||
470 - 488 | =head2 Carp =begin :list = C<_::carp "Message"> wrapper for C<Carp::carp> = C<_::cluck "Message"> wrapper for C<Carp::cluck> = C<_::croak "Message"> wrapper for C<Carp::croak> = C<_::confess "Message"> wrapper for C<Carp::confess> =end :list =cut | ||||||
489 | |||||||
490 | $assign_aliases->( | ||||||
491 | 'Carp', | ||||||
492 | carp => 'carp', | ||||||
493 | cluck => 'cluck', | ||||||
494 | croak => 'croak', | ||||||
495 | confess => 'confess', | ||||||
496 | ); | ||||||
497 | |||||||
498 - 518 | =head2 UNIVERSAL ...and other goodies from C<Safe::Isa> =begin :list = C<$bool = _::isa $object, 'Class'> wrapper for C<$Safe::Isa::_isa> = C<$code = _::can $object, 'method'> wrapper for C<$Safe::Isa::_can> = C<$bool = _::does $object, 'Role'> wrapper for C<$Safe::Isa::_DOES> = C<< any = $maybe_object->_::safecall(method => @args) >> wrapper for C<$Safe::Isa::_call_if_object> =end :list =cut | ||||||
519 | |||||||
520 | sub _::isa($$) { | ||||||
521 | 13 | 0 | 56 | goto &$Safe::Isa::_isa; | |||
522 | } | ||||||
523 | |||||||
524 | sub _::does($$) { | ||||||
525 | 13 | 0 | 63 | goto &$Safe::Isa::_DOES; | |||
526 | } | ||||||
527 | |||||||
528 | sub _::can($$) { | ||||||
529 | 13 | 0 | 53 | goto &$Safe::Isa::_can; | |||
530 | } | ||||||
531 | |||||||
532 | sub _::safecall($$@) { | ||||||
533 | 13 | 0 | 53 | goto &$Safe::Isa::_call_if_object; | |||
534 | } | ||||||
535 | |||||||
536 - 547 | =head2 Try::Tiny The following keywords are available: =for :list * C<_::try> * C<_::catch> * C<_::finally> They are all direct aliases for their namesakes in C<Try::Tiny>. =cut | ||||||
548 | |||||||
549 | $assign_aliases->( | ||||||
550 | 'Try::Tiny', | ||||||
551 | try => 'try', | ||||||
552 | catch => 'catch', | ||||||
553 | finally => 'finally', | ||||||
554 | ); | ||||||
555 | |||||||
556 - 560 | =head2 Package::Stash The C<_::package $str> function will return a new C<Package::Stash> instance. =cut | ||||||
561 | |||||||
562 | sub _::package($) { | ||||||
563 | 2 | 0 | 5 | my ($pkg) = @_; | |||
564 | 2 | 51 | return Package::Stash->new($pkg); | ||||
565 | } | ||||||
566 | |||||||
567 - 582 | =head2 Data::Dump C<Data::Dump> is an alternative to C<Data::Dumper>. The main difference is the output format: C<Data::Dump> output tends to be easier to read. =begin :list = C<$str = _::pp @values> wrapper for C<Data::Dump::pp> = C<_::dd @values> wrapper for C<Data::Dump::dd>. =end :list =cut | ||||||
583 | |||||||
584 | $assign_aliases->( | ||||||
585 | 'Data::Dump', | ||||||
586 | pp => 'pp', | ||||||
587 | dd => 'dd', | ||||||
588 | ); | ||||||
589 | |||||||
590 - 598 | =head1 RELATED MODULES The following modules were once considered for inclusion or were otherwise influental in the design of this collection: =for :list * L<Data::Util> * L<Params::Util> =cut | ||||||
599 | |||||||
600 | 1; |