| 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; | ||||||