File Coverage

blib/lib/List/Objects/WithUtils.pm
Criterion Covered Total %
statement 64 64 100.0
branch 23 24 95.8
condition 13 18 72.2
subroutine 11 11 100.0
pod n/a
total 111 117 94.8


line stmt bran cond sub pod time code
1             package List::Objects::WithUtils;
2             $List::Objects::WithUtils::VERSION = '2.028002';
3 209     209   1960079 use Carp;
  209         294  
  209         14437  
4 208     208   45520 use strictures 2;
  208         132464  
  208         7311  
5              
6             our %ImportMap = (
7             array => 'Array',
8             immarray => 'Array::Immutable',
9             array_of => 'Array::Typed',
10             immarray_of => 'Array::Immutable::Typed',
11             hash => 'Hash',
12             immhash => 'Hash::Immutable',
13             hash_of => 'Hash::Typed',
14             immhash_of => 'Hash::Immutable::Typed',
15             );
16              
17             our @DefaultImport = keys %ImportMap;
18              
19             sub import {
20 213     213   2819 my ($class, @funcs) = @_;
21              
22 213         235 my $pkg;
23 213 100       2535 if (ref $funcs[0]) {
24 96 100       3220 croak 'Expected a list of imports or a HASH but got '.$funcs[0]
25             unless ref $funcs[0] eq 'HASH';
26 95         589 my %opts = %{ $funcs[0] };
  95         967  
27 95 50       1429 @funcs = @{ $opts{import} || [ 'all' ] };
  95         1069  
28 95   66     1548 $pkg = $opts{to} || caller;
29             }
30              
31 212 100       2570 @funcs = @DefaultImport unless @funcs;
32 212         946 my %fmap = map {;
33 269 100       2702 lc( substr($_, 0, 1) eq ':' ? substr($_, 1) : $_ ) => 1
34             } @funcs;
35              
36 212 100 100     3485 if (defined $fmap{all} || defined $fmap{-all}) {
    100 66        
37 90         854 @funcs = (
38             @DefaultImport,
39             'autobox'
40             )
41             } elsif (defined $fmap{functions} || defined $fmap{funcs}) {
42             # Legacy import tag, tested but not documented
43 1         4 @funcs = @DefaultImport
44             }
45              
46 212         880 my @mods;
47 212         1076 for my $function (@funcs) {
48 996 100 100     5207 if ($function eq 'autobox' || $function eq '-autobox') {
49 93         35022 require List::Objects::WithUtils::Autobox;
50 93         936 List::Objects::WithUtils::Autobox::import($class);
51             next
52 93         23444 }
53 903 100       2153 if (my $thismod = $ImportMap{$function}) {
54 902         2832 push @mods, 'List::Objects::WithUtils::'.$thismod;
55             next
56 902         1701 }
57 1         130 croak "Unknown import parameter '$function'"
58             }
59              
60 211 100       603 $pkg = caller unless defined $pkg;
61 211         247 my @failed;
62 211         320 for my $mod (@mods) {
63 901         2561 my $c = "package $pkg; use $mod; 1;";
64 901         915 local $@;
65 206 100 33 206   70061 eval $c and not $@ or carp $@ and push @failed, $mod;
  205   66 104   362  
  205     100   662  
  104     98   29519  
  104     98   177  
  104     98   404  
  100     98   28425  
  100     98   167  
  100         396  
  98         30600  
  98         169  
  98         366  
  98         30835  
  98         165  
  98         372  
  98         28791  
  98         155  
  98         666  
  98         27706  
  98         161  
  98         397  
  98         29431  
  98         170  
  98         358  
  901         51790  
66             }
67              
68 211 100       624 if (@failed) {
69 1         69 croak 'Failed to import ' . join ', ', @failed
70             }
71              
72             1
73 210         131832 }
74              
75             print <<'_EOB'
76             (CLASS)
77             + (ROLES)
78             -> (SUBCLASS)
79             + (ROLES)
80             List::Objects::WithUtils::
81             Array (array)
82             + Role::Array
83             + Role::Array::WithJunctions
84             -> Array::Immutable (immarray)
85             + Role::Array::Immutable
86             -> Array::Immutable::Typed (immarray_of)
87             + Role::Array::Immutable
88             + Role::Array::Typed
89             -> Array::Junction (array->{any,all}_items)
90             -> Array::Typed (array_of)
91             + Role::Array::Typed
92             Hash (hash)
93             + Role::Hash
94             -> Hash::Immutable (immhash)
95             + Role::Hash::Immutable
96             -> Hash::Immutable::Typed (immhash_of)
97             + Role::Hash::Immutable
98             + Role::Hash::Typed
99             -> Hash::Typed (hash_of)
100             + Role::Array::Typed
101            
102             Hash::Inflated (hash->inflate)
103             -> Hash::Inflated::RW (hash->inflate(rw => 1))
104             _EOB
105             unless caller;
106              
107             1;
108              
109             =pod
110              
111             =for Pod::Coverage import
112              
113             =head1 NAME
114              
115             List::Objects::WithUtils - List objects, kitchen sink included
116              
117             =head1 SYNOPSIS
118              
119             ## A small sample; consult the description, below, for links to
120             ## extended documentation
121              
122             # Import all object constructor functions:
123             # array immarray array_of immarray_of
124             # hash immhash hash_of immhash_of
125             use List::Objects::WithUtils;
126              
127             # Import all of the above plus autoboxing:
128             use List::Objects::WithUtils ':all';
129             # Same as above, but shorter:
130             use Lowu;
131              
132             # Most methods returning lists return new objects; chaining is easy:
133             array(qw/ aa Ab bb Bc bc /)
134             ->grep(sub { /^b/i })
135             ->map(sub { uc })
136             ->uniq
137             ->all; # ( 'BB', 'BC' )
138              
139             # Useful utilities from other list modules are available:
140             my $want_idx = array(
141             +{ id => '400', user => 'bob' },
142             +{ id => '600', user => 'suzy' },
143             +{ id => '700', user => 'fred' },
144             )->first_index(sub { $_->{id} > 500 });
145              
146             my $itr = array( 1 .. 7 )->natatime(3);
147             while ( my @nextset = $itr->() ) {
148             ...
149             }
150              
151             my $meshed = array(qw/ a b c d /)
152             ->mesh( array(1 .. 4) )
153             ->all; # ( 'a', 1, 'b', 2, 'c', 3, 'd', 4 )
154            
155             my ($evens, $odds) = array( 1 .. 20 )
156             ->part(sub { $_[0] & 1 })
157             ->all;
158              
159             my $sorted = array(
160             +{ name => 'bob', acct => 1 },
161             +{ name => 'fred', acct => 2 },
162             +{ name => 'suzy', acct => 3 },
163             )->sort_by(sub { $_->{name} });
164              
165             # array() objects are mutable:
166             my $mutable = array(qw/ foo bar baz /);
167             $mutable->insert(1, 'quux');
168             $mutable->delete(2);
169              
170             # ... or use immarray() immutable arrays:
171             my $static = immarray( qw/ foo bar baz / );
172             $static->set(0, 'quux'); # dies
173             $static->[0] = 'quux'; # dies
174             push @$static, 'quux'; # dies
175              
176             # Construct a hash:
177             my $hash = hash( foo => 'bar', snacks => 'cake' );
178            
179             # You can set multiple keys in one call:
180             $hash->set( foobar => 'baz', pie => 'cherry' );
181              
182             # ... which is useful for merging in another (plain) hash:
183             my %foo = ( pie => 'pumpkin', snacks => 'cheese' );
184             $hash->set( %foo );
185              
186             # ... or another hash object:
187             my $second = hash( pie => 'key lime' );
188             $hash->set( $second->export );
189              
190             # Retrieve one value as a simple scalar:
191             my $snacks = $hash->get('snacks');
192              
193             # ... or retrieve multiple values as an array-type object:
194             my $vals = $hash->get('foo', 'foobar');
195              
196             # Take a hash slice of keys, return a new hash object
197             # consisting of the retrieved key/value pairs:
198             my $slice = $hash->sliced('foo', 'pie');
199              
200             # Arrays inflate to hash objects:
201             my $items = array( qw/ foo bar baz/ )->map(sub { $_ => 1 })->inflate;
202             if ($items->exists('foo')) {
203             # ...
204             }
205              
206             # Hashes inflate to simple objects with accessors:
207             my $obj = $hash->inflate;
208             $snacks = $obj->snacks;
209              
210             # Methods returning multiple values typically return new array-type objects:
211             my @match_keys = $hash->keys->grep(sub { m/foo/ })->all;
212             my @match_vals = $hash->values->grep(sub { m/bar/ })->all;
213            
214             my @sorted_pairs = hash( foo => 2, bar => 3, baz => 1)
215             ->kv
216             ->sort_by(sub { $_->[1] })
217             ->all; # ( [ baz => 1 ], [ foo => 2 ], [ bar => 3 ] )
218              
219             # Perl6-inspired Junctions:
220             if ( $hash->keys->any_items == qr/snacks/ ) {
221             # ... hash has key(s) matching /snacks/ ...
222             }
223             if ( $hash->values->all_items > 10 ) {
224             # ... all hash values greater than 10 ...
225             }
226              
227             # Type-checking arrays via Type::Tiny:
228             use Types::Standard -all;
229             my $int_arr = array_of Int() => 1 .. 10;
230              
231             # Type-checking hashes:
232             use Types::Standard -all;
233             my $int_hash = hash_of Int() => (foo => 1, bar => 2);
234              
235             # Native list types can be autoboxed:
236             use List::Objects::WithUtils 'autobox';
237             my $foo = [ qw/foo baz bar foo quux/ ]->uniq->sort;
238             my $bar = +{ a => 1, b => 2, c => 3 }->values->sort;
239              
240             # Autoboxing is lexically scoped like normal:
241             { no List::Objects::WithUtils::Autobox;
242             [ 1 .. 10 ]->shuffle; # dies
243             }
244              
245              
246             =head1 DESCRIPTION
247              
248             A set of roles and classes defining an object-oriented interface to Perl
249             hashes and arrays with useful utility methods, junctions, type-checking
250             ability, and optional autoboxing. Originally derived from L.
251              
252             =head2 Uses
253              
254             The included objects are useful as-is but are largely intended for use as data
255             container types for attributes. This lends a more natural object-oriented
256             syntax; these are particularly convenient in combination with delegated
257             methods, as in this example:
258              
259             package Some::Thing;
260             use List::Objects::WithUtils;
261             use Moo;
262              
263             has items => (
264             is => 'ro',
265             builder => sub { array },
266             handles => +{
267             add_items => 'push',
268             get_items => 'all',
269             items_where => 'grep',
270             },
271             );
272              
273             # ... later ...
274             my $thing = Some::Thing->new;
275             $thing->add_items(@more_items);
276             # Operate on all positive items:
277             for my $item ($thing->items_where(sub { $_ > 0 })->all) {
278             ...
279             }
280              
281             L provides L-based types & coercions
282             matching the list objects provided by this distribution. These integrate
283             nicely with typed or untyped list objects:
284              
285             package Accounts;
286             use List::Objects::Types -types;
287             use Moo 2;
288              
289             has usergroups => (
290             is => 'ro',
291             # +{ $group => [ [ $usr => $id ], ... ] }
292             # Coerced to objects all the way down:
293             isa => TypedHash[ TypedArray[ArrayObj] ],
294             coerce => 1,
295             builder => sub { +{} },
296             );
297              
298             # ... later ...
299             my $users_in_grp = $accts->usergroups
300             ->get($some_group)
301             ->grep(sub { $_[0]->get(0) });
302            
303              
304             =head2 Objects
305              
306             =head3 Arrays
307              
308             B (L) provides basic mutable
309             ARRAY-type objects. Behavior is defined by
310             L; look there for documentation on
311             available methods.
312              
313             B is imported from L and
314             operates much like an B, except methods that mutate the list are not
315             available; using immutable arrays promotes safer programming patterns.
316              
317             B provides L-compatible type-checking array objects
318             that can coerce and check their values as they are added; see
319             L.
320              
321             B provides immutable type-checking arrays; see
322             L.
323              
324             =head3 Hashes
325              
326             B is the basic mutable HASH-type object imported from
327             L; see
328             L for documentation.
329              
330             B provides immutable (restricted) hashes; see
331             L.
332              
333             B provides L-compatible type-checking hash
334             objects; see L.
335              
336             B provides immutable type-checking hashes; see
337             L.
338              
339             =head2 Importing
340              
341             A bare import list (C) will import all of the
342             object constructor functions described above; they can also be selectively
343             imported, e.g.:
344              
345             use List::Objects::WithUtils 'array_of', 'hash_of';
346              
347             Importing B lexically enables L,
348             which provides L or
349             L methods for native ARRAY and HASH types.
350              
351             Importing B or B<:all> will import all of the object constructors and
352             additionally turn B on; C is a shortcut for importing
353             B.
354              
355             =head2 Debugging
356              
357             Most methods belonging to these objects are heavily micro-optimized -- at the
358             cost of useful error handling.
359              
360             Since there are few built-in argument checks, a mistake in your code can
361             frequently lead to slightly cryptic errors from the perl side:
362              
363             > my $pos; # whoops, I'm still undefined later:
364             > if ($arr->exists($pos)) { ... }
365             Use of uninitialized value in numeric le (<=) at $useless_lib_lineno
366              
367             ... in which case L is likely to improve your quality of life
368             by providing a real backtrace:
369              
370             $ perl -d:Confess my_app.pl
371             Use of uninitialized value in numeric le (<=) at ...
372             [...]::Array::exists(ARRAY(0x8441068), undef) called at ...
373              
374             =head2 Subclassing
375              
376             The importer for this package is somewhat flexible; a subclass can override
377             import to pass import tags and a target package by feeding this package's
378             C a HASH:
379              
380             # Subclass and import to target packages (see Lowu.pm f.ex):
381             package My::Defaults;
382             use parent 'List::Objects::WithUtils';
383             sub import {
384             my ($class, @params) = @_;
385             $class->SUPER::import(
386             +{
387             import => [ 'autobox', 'array', 'hash' ],
388             to => scalar(caller)
389             }
390             )
391             }
392              
393             Functionality is mostly defined by Roles.
394             For example, it's easy to create your own array class with new methods:
395              
396             package My::Array::Object;
397             use Role::Tiny::With;
398             # Act like List::Objects::WithUtils::Array:
399             with 'List::Objects::WithUtils::Role::Array',
400             'List::Objects::WithUtils::Role::Array::WithJunctions';
401              
402             # One way to add your own functional interface:
403             use Exporter 'import'; our @EXPORT = 'my_array';
404             sub my_array { __PACKAGE__->new(@_) }
405              
406             # ... add/override methods ...
407              
408             ... in which case you may want to also define your own hash subclass that
409             overrides C to produce your preferred arrays:
410              
411             package My::Hash::Object;
412             use Role::Tiny::With;
413             with 'List::Objects::WithUtils::Role::Hash';
414              
415             use Exporter 'import'; our @EXPORT = 'my_hash';
416             sub my_hash { __PACKAGE__->new(@_) }
417            
418             sub array_type { 'My::Array::Object' }
419              
420             # ... add/override methods ...
421            
422             =head1 SEE ALSO
423              
424             L for documentation on the basic set of
425             C methods.
426              
427             L for documentation on C
428             junction-returning methods.
429              
430             L for more on C
431             immutable arrays.
432              
433             L for more on C
434             type-checking arrays.
435              
436             L for more on
437             C immutable type-checking arrays.
438              
439             L for documentation regarding C
440             methods.
441              
442             L for more on C
443             immutable hashes.
444              
445             L for more on C
446             type-checking hashes.
447              
448             L for more on
449             C immutable type-checking hashes.
450              
451             L for details on autoboxing.
452              
453             The L module for a convenient importer shortcut.
454              
455             L for relevant L types.
456              
457             L for integration with L class-building sugar.
458              
459             =head1 AUTHOR
460              
461             Jon Portnoy
462              
463             Licensed under the same terms as Perl.
464              
465             The original Array and Hash roles were derived from L by Matthew
466             Phillips (CPAN: MATTP), haarg, and others.
467              
468             Immutable array objects were originally inspired by L by Leon
469             Timmermans (CPAN: LEONT), but now use C.
470              
471             Junctions are adapted from L by Carl Franks (CPAN: CFRANKS)
472              
473             Most of the type-checking code and other useful additions were contributed by
474             Toby Inkster (CPAN: TOBYINK)
475              
476             A significant portion of this code simply wraps other widely-used modules, especially:
477              
478             L
479              
480             L
481              
482             L
483              
484             Inspiration for a few pieces comes from the "classic" (version 0.33)
485             L.
486              
487             =cut