File Coverage

blib/lib/Mojo/Collection.pm
Criterion Covered Total %
statement 96 96 100.0
branch 26 26 100.0
condition 13 15 86.6
subroutine 34 34 100.0
pod 22 22 100.0
total 191 193 98.9


line stmt bran cond sub pod time code
1             package Mojo::Collection;
2 84     84   608 use Mojo::Base -strict;
  84         209  
  84         785  
3              
4 84     84   685 use re qw(is_regexp);
  84         196  
  84         12088  
5 84     84   735 use Carp qw(croak);
  84         239  
  84         3881  
6 84     84   551 use Exporter qw(import);
  84         205  
  84         2467  
7 84     84   481 use List::Util;
  84         556  
  84         4869  
8 84     84   33630 use Mojo::ByteStream;
  84         256  
  84         3987  
9 84     84   637 use Scalar::Util qw(blessed);
  84         238  
  84         98203  
10              
11             our @EXPORT_OK = ('c');
12              
13 1     1 1 2 sub TO_JSON { [@{shift()}] }
  1         6  
14              
15 61     61 1 57372 sub c { __PACKAGE__->new(@_) }
16              
17             sub compact {
18 3     3 1 5 my $self = shift;
19 3 100 66     7 return $self->new(grep { defined && (ref || length) } @$self);
  9         38  
20             }
21              
22             sub each {
23 359     359 1 1609 my ($self, $cb) = @_;
24 359 100       3411 return @$self unless $cb;
25 107         162 my $i = 1;
26 107         443 $_->$cb($i++) for @$self;
27 107         241 return $self;
28             }
29              
30             sub first {
31 79     79 1 1333 my ($self, $cb) = (shift, shift);
32 79 100       445 return $self->[0] unless $cb;
33 11 100   2   37 return List::Util::first { $_ =~ $cb } @$self if is_regexp $cb;
  2         16  
34 10     22   42 return List::Util::first { $_->$cb(@_) } @$self;
  22         81  
35             }
36              
37 5     5 1 12 sub flatten { $_[0]->new(_flatten(@{$_[0]})) }
  5         20  
38              
39             sub grep {
40 35     35 1 102 my ($self, $cb) = (shift, shift);
41 35 100       127 return $self->new(grep { $_ =~ $cb } @$self) if is_regexp $cb;
  9         61  
42 34         82 return $self->new(grep { $_->$cb(@_) } @$self);
  106         365  
43             }
44              
45             sub head {
46 9     9 1 26 my ($self, $size) = @_;
47 9 100       26 return $self->new(@$self) if $size > @$self;
48 8 100       27 return $self->new(@$self[0 .. ($size - 1)]) if $size >= 0;
49 4         14 return $self->new(@$self[0 .. ($#$self + $size)]);
50             }
51              
52             sub join {
53 57   100 57 1 202 Mojo::ByteStream->new(join $_[1] // '', map {"$_"} @{$_[0]});
  154         454  
  57         141  
54             }
55              
56 24     24 1 111 sub last { shift->[-1] }
57              
58             sub map {
59 236     236 1 842 my ($self, $cb) = (shift, shift);
60 236         962 return $self->new(map { $_->$cb(@_) } @$self);
  1829         8376  
61             }
62              
63             sub new {
64 1233     1233 1 3608 my $class = shift;
65 1233   66     15115 return bless [@_], ref $class || $class;
66             }
67              
68             sub reduce {
69 3     3 1 688 my $self = shift;
70 3         9 @_ = (@_, @$self);
71 3         21 goto &List::Util::reduce;
72             }
73              
74 12     12 1 32 sub reverse { $_[0]->new(reverse @{$_[0]}) }
  12         30  
75              
76 2     2 1 180 sub shuffle { $_[0]->new(List::Util::shuffle @{$_[0]}) }
  2         279  
77              
78 58     58 1 148 sub size { scalar @{$_[0]} }
  58         308  
79              
80             sub sort {
81 6     6 1 25 my ($self, $cb) = @_;
82              
83 6 100       22 return $self->new(sort @$self) unless $cb;
84              
85 4         10 my $caller = caller;
86 84     84   725 no strict 'refs';
  84         242  
  84         53439  
87             my @sorted = sort {
88 4         18 local (*{"${caller}::a"}, *{"${caller}::b"}) = (\$a, \$b);
  12         42  
  12         23  
  12         26  
89 12         21 $a->$cb($b);
90             } @$self;
91 4         21 return $self->new(@sorted);
92             }
93              
94             sub tail {
95 9     9 1 24 my ($self, $size) = @_;
96 9 100       31 return $self->new(@$self) if $size > @$self;
97 8 100       26 return $self->new(@$self[($#$self - ($size - 1)) .. $#$self]) if $size >= 0;
98 4         15 return $self->new(@$self[(0 - $size) .. $#$self]);
99             }
100              
101 1     1 1 10 sub tap { shift->Mojo::Base::tap(@_) }
102              
103 75     75 1 135 sub to_array { [@{shift()}] }
  75         500  
104              
105             sub uniq {
106 7     7 1 39 my ($self, $cb) = (shift, shift);
107 7         11 my %seen;
108 7 100 100     20 return $self->new(grep { !$seen{$_->$cb(@_) // ''}++ } @$self) if $cb;
  12         48  
109 4   100     8 return $self->new(grep { !$seen{$_ // ''}++ } @$self);
  27         82  
110             }
111              
112 1     1 1 693 sub with_roles { shift->Mojo::Base::with_roles(@_) }
113              
114             sub _flatten {
115 16 100   16   31 map { _ref($_) ? _flatten(@$_) : $_ } @_;
  41         66  
116             }
117              
118 41 100 100 41   256 sub _ref { ref $_[0] eq 'ARRAY' || blessed $_[0] && $_[0]->isa(__PACKAGE__) }
119              
120             1;
121              
122             =encoding utf8
123              
124             =head1 NAME
125              
126             Mojo::Collection - Collection
127              
128             =head1 SYNOPSIS
129              
130             use Mojo::Collection;
131              
132             # Manipulate collection
133             my $collection = Mojo::Collection->new(qw(just works));
134             unshift @$collection, 'it';
135             say $collection->join("\n");
136              
137             # Chain methods
138             $collection->map(sub { ucfirst })->shuffle->each(sub ($word, $num) {
139             say "$num: $word";
140             });
141              
142             # Use the alternative constructor
143             use Mojo::Collection qw(c);
144             c(qw(a b c))->join('/')->url_escape->say;
145              
146             =head1 DESCRIPTION
147              
148             L is an array-based container for collections.
149              
150             # Access array directly to manipulate collection
151             my $collection = Mojo::Collection->new(1 .. 25);
152             $collection->[23] += 100;
153             say for @$collection;
154              
155             =head1 FUNCTIONS
156              
157             L implements the following functions, which can be imported individually.
158              
159             =head2 c
160              
161             my $collection = c(1, 2, 3);
162              
163             Construct a new array-based L object.
164              
165             =head1 METHODS
166              
167             L implements the following methods.
168              
169             =head2 TO_JSON
170              
171             my $array = $collection->TO_JSON;
172              
173             Alias for L.
174              
175             =head2 compact
176              
177             my $new = $collection->compact;
178              
179             Create a new collection with all elements that are defined and not an empty string.
180              
181             # "0, 1, 2, 3"
182             c(0, 1, undef, 2, '', 3)->compact->join(', ');
183              
184             =head2 each
185              
186             my @elements = $collection->each;
187             $collection = $collection->each(sub {...});
188              
189             Evaluate callback for each element in collection, or return all elements as a list if none has been provided. The
190             element will be the first argument passed to the callback, and is also available as C<$_>.
191              
192             # Make a numbered list
193             $collection->each(sub ($e, $num) {
194             say "$num: $e";
195             });
196              
197             =head2 first
198              
199             my $first = $collection->first;
200             my $first = $collection->first(qr/foo/);
201             my $first = $collection->first(sub {...});
202             my $first = $collection->first('some_method');
203             my $first = $collection->first('some_method', @args);
204              
205             Evaluate regular expression/callback for, or call method on, each element in collection and return the first one that
206             matched the regular expression, or for which the callback/method returned true. The element will be the first argument
207             passed to the callback, and is also available as C<$_>.
208              
209             # Longer version
210             my $first = $collection->first(sub { $_->some_method(@args) });
211              
212             # Find first value that contains the word "mojo"
213             my $interesting = $collection->first(qr/mojo/i);
214              
215             # Find first value that is greater than 5
216             my $greater = $collection->first(sub { $_ > 5 });
217              
218             =head2 flatten
219              
220             my $new = $collection->flatten;
221              
222             Flatten nested collections/arrays recursively and create a new collection with all elements.
223              
224             # "1, 2, 3, 4, 5, 6, 7"
225             c(1, [2, [3, 4], 5, [6]], 7)->flatten->join(', ');
226              
227             =head2 grep
228              
229             my $new = $collection->grep(qr/foo/);
230             my $new = $collection->grep(sub {...});
231             my $new = $collection->grep('some_method');
232             my $new = $collection->grep('some_method', @args);
233              
234             Evaluate regular expression/callback for, or call method on, each element in collection and create a new collection
235             with all elements that matched the regular expression, or for which the callback/method returned true. The element will
236             be the first argument passed to the callback, and is also available as C<$_>.
237              
238             # Longer version
239             my $new = $collection->grep(sub { $_->some_method(@args) });
240              
241             # Find all values that contain the word "mojo"
242             my $interesting = $collection->grep(qr/mojo/i);
243              
244             # Find all values that are greater than 5
245             my $greater = $collection->grep(sub { $_ > 5 });
246              
247             =head2 head
248              
249             my $new = $collection->head(4);
250             my $new = $collection->head(-2);
251              
252             Create a new collection with up to the specified number of elements from the beginning of the collection. A negative
253             number will count from the end.
254              
255             # "A B C"
256             c('A', 'B', 'C', 'D', 'E')->head(3)->join(' ');
257              
258             # "A B"
259             c('A', 'B', 'C', 'D', 'E')->head(-3)->join(' ');
260              
261             =head2 join
262              
263             my $stream = $collection->join;
264             my $stream = $collection->join("\n");
265              
266             Turn collection into L.
267              
268             # Join all values with commas
269             $collection->join(', ')->say;
270              
271             =head2 last
272              
273             my $last = $collection->last;
274              
275             Return the last element in collection.
276              
277             =head2 map
278              
279             my $new = $collection->map(sub {...});
280             my $new = $collection->map('some_method');
281             my $new = $collection->map('some_method', @args);
282              
283             Evaluate callback for, or call method on, each element in collection and create a new collection from the results. The
284             element will be the first argument passed to the callback, and is also available as C<$_>.
285              
286             # Longer version
287             my $new = $collection->map(sub { $_->some_method(@args) });
288              
289             # Append the word "mojo" to all values
290             my $mojoified = $collection->map(sub { $_ . 'mojo' });
291              
292             =head2 new
293              
294             my $collection = Mojo::Collection->new(1, 2, 3);
295              
296             Construct a new array-based L object.
297              
298             =head2 reduce
299              
300             my $result = $collection->reduce(sub {...});
301             my $result = $collection->reduce(sub {...}, $initial);
302              
303             Reduce elements in collection with a callback and return its final result, setting C<$a> and C<$b> each time the
304             callback is executed. The first time C<$a> will be set to an optional initial value or the first element in the
305             collection. And from then on C<$a> will be set to the return value of the callback, while C<$b> will always be set to
306             the next element in the collection.
307              
308             # Calculate the sum of all values
309             my $sum = $collection->reduce(sub { $a + $b });
310              
311             # Count how often each value occurs in collection
312             my $hash = $collection->reduce(sub { $a->{$b}++; $a }, {});
313              
314             =head2 reverse
315              
316             my $new = $collection->reverse;
317              
318             Create a new collection with all elements in reverse order.
319              
320             =head2 shuffle
321              
322             my $new = $collection->shuffle;
323              
324             Create a new collection with all elements in random order.
325              
326             =head2 size
327              
328             my $size = $collection->size;
329              
330             Number of elements in collection.
331              
332             =head2 sort
333              
334             my $new = $collection->sort;
335             my $new = $collection->sort(sub {...});
336              
337             Sort elements based on return value of a callback and create a new collection from the results, setting C<$a> and C<$b>
338             to the elements being compared, each time the callback is executed.
339              
340             # Sort values case-insensitive
341             my $case_insensitive = $collection->sort(sub { uc($a) cmp uc($b) });
342              
343             =head2 tail
344              
345             my $new = $collection->tail(4);
346             my $new = $collection->tail(-2);
347              
348             Create a new collection with up to the specified number of elements from the end of the collection. A negative number
349             will count from the beginning.
350              
351             # "C D E"
352             c('A', 'B', 'C', 'D', 'E')->tail(3)->join(' ');
353              
354             # "D E"
355             c('A', 'B', 'C', 'D', 'E')->tail(-3)->join(' ');
356              
357             =head2 tap
358              
359             $collection = $collection->tap(sub {...});
360              
361             Alias for L.
362              
363             =head2 to_array
364              
365             my $array = $collection->to_array;
366              
367             Turn collection into array reference.
368              
369             =head2 uniq
370              
371             my $new = $collection->uniq;
372             my $new = $collection->uniq(sub {...});
373             my $new = $collection->uniq('some_method');
374             my $new = $collection->uniq('some_method', @args);
375              
376             Create a new collection without duplicate elements, using the string representation of either the elements or the
377             return value of the callback/method to decide uniqueness. Note that C and empty string are treated the same.
378              
379             # Longer version
380             my $new = $collection->uniq(sub { $_->some_method(@args) });
381              
382             # "foo bar baz"
383             c('foo', 'bar', 'bar', 'baz')->uniq->join(' ');
384              
385             # "[[1, 2], [2, 1]]"
386             c([1, 2], [2, 1], [3, 2])->uniq(sub{ $_->[1] })->to_array;
387              
388             =head2 with_roles
389              
390             my $new_class = Mojo::Collection->with_roles('Mojo::Collection::Role::One');
391             my $new_class = Mojo::Collection->with_roles('+One', '+Two');
392             $collection = $collection->with_roles('+One', '+Two');
393              
394             Alias for L.
395              
396             =head1 SEE ALSO
397              
398             L, L, L.
399              
400             =cut