File Coverage

File:lib/Util/Underscore.pm
Coverage:77.3%

linestmtbrancondsubpodtimecode
1package 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
21use 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
58BEGIN {
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
65BEGIN {
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
76my $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
159sub _::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
193sub _::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
201sub _::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
209sub _::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
217sub _::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
225sub _::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
233sub _::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
241sub _::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
300sub _::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
308sub _::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
316sub _::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
323sub _::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
330sub _::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
337sub _::class_isa($$) {
338
0
0
0
    return true
339        if _::is_package $_[0]
340        && $_[0]->isa($_[1]);
341
0
0
    return false;
342}
343
344sub _::class_does($$) {
345
0
0
0
    return true
346        if _::is_package $_[0]
347        && $_[0]->DOES($_[1]);
348
0
0
    return false;
349}
350
351sub _::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
466sub _::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
520sub _::isa($$) {
521
13
0
56
    goto &$Safe::Isa::_isa;
522}
523
524sub _::does($$) {
525
13
0
63
    goto &$Safe::Isa::_DOES;
526}
527
528sub _::can($$) {
529
13
0
53
    goto &$Safe::Isa::_can;
530}
531
532sub _::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
562sub _::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
6001;