← Index
NYTProf Performance Profile   « line view »
For ../prof.pl
  Run on Wed Dec 14 15:57:08 2022
Reported on Wed Dec 14 16:00:34 2022

Filename/Users/ether/.perlbrew/libs/36.0@std/lib/perl5/Data/Perl/Role/Collection/Array.pm
StatementsExecuted 35 statements in 1.64ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
171134µs34µsData::Perl::Role::Collection::Array::::countData::Perl::Role::Collection::Array::count
11131µs105µsData::Perl::Role::Collection::Array::::BEGIN@5Data::Perl::Role::Collection::Array::BEGIN@5
1118µs31µsData::Perl::Role::Collection::Array::::BEGIN@8Data::Perl::Role::Collection::Array::BEGIN@8
1117µs263µsData::Perl::Role::Collection::Array::::BEGIN@9Data::Perl::Role::Collection::Array::BEGIN@9
1116µs23µsData::Perl::Role::Collection::Array::::BEGIN@10Data::Perl::Role::Collection::Array::BEGIN@10
1116µs16µsData::Perl::Role::Collection::Array::::BEGIN@24Data::Perl::Role::Collection::Array::BEGIN@24
1115µs171µsData::Perl::Role::Collection::Array::::BEGIN@7Data::Perl::Role::Collection::Array::BEGIN@7
0000s0sData::Perl::Role::Collection::Array::::__ANON__[:47]Data::Perl::Role::Collection::Array::__ANON__[:47]
0000s0sData::Perl::Role::Collection::Array::::_flatten_deepData::Perl::Role::Collection::Array::_flatten_deep
0000s0sData::Perl::Role::Collection::Array::::accessorData::Perl::Role::Collection::Array::accessor
0000s0sData::Perl::Role::Collection::Array::::allData::Perl::Role::Collection::Array::all
0000s0sData::Perl::Role::Collection::Array::::clearData::Perl::Role::Collection::Array::clear
0000s0sData::Perl::Role::Collection::Array::::deleteData::Perl::Role::Collection::Array::delete
0000s0sData::Perl::Role::Collection::Array::::firstData::Perl::Role::Collection::Array::first
0000s0sData::Perl::Role::Collection::Array::::first_indexData::Perl::Role::Collection::Array::first_index
0000s0sData::Perl::Role::Collection::Array::::flatten_deepData::Perl::Role::Collection::Array::flatten_deep
0000s0sData::Perl::Role::Collection::Array::::getData::Perl::Role::Collection::Array::get
0000s0sData::Perl::Role::Collection::Array::::grepData::Perl::Role::Collection::Array::grep
0000s0sData::Perl::Role::Collection::Array::::headData::Perl::Role::Collection::Array::head
0000s0sData::Perl::Role::Collection::Array::::insertData::Perl::Role::Collection::Array::insert
0000s0sData::Perl::Role::Collection::Array::::is_emptyData::Perl::Role::Collection::Array::is_empty
0000s0sData::Perl::Role::Collection::Array::::joinData::Perl::Role::Collection::Array::join
0000s0sData::Perl::Role::Collection::Array::::mapData::Perl::Role::Collection::Array::map
0000s0sData::Perl::Role::Collection::Array::::natatimeData::Perl::Role::Collection::Array::natatime
0000s0sData::Perl::Role::Collection::Array::::newData::Perl::Role::Collection::Array::new
0000s0sData::Perl::Role::Collection::Array::::popData::Perl::Role::Collection::Array::pop
0000s0sData::Perl::Role::Collection::Array::::printData::Perl::Role::Collection::Array::print
0000s0sData::Perl::Role::Collection::Array::::pushData::Perl::Role::Collection::Array::push
0000s0sData::Perl::Role::Collection::Array::::reduceData::Perl::Role::Collection::Array::reduce
0000s0sData::Perl::Role::Collection::Array::::reverseData::Perl::Role::Collection::Array::reverse
0000s0sData::Perl::Role::Collection::Array::::setData::Perl::Role::Collection::Array::set
0000s0sData::Perl::Role::Collection::Array::::shallow_cloneData::Perl::Role::Collection::Array::shallow_clone
0000s0sData::Perl::Role::Collection::Array::::shiftData::Perl::Role::Collection::Array::shift
0000s0sData::Perl::Role::Collection::Array::::shuffleData::Perl::Role::Collection::Array::shuffle
0000s0sData::Perl::Role::Collection::Array::::sortData::Perl::Role::Collection::Array::sort
0000s0sData::Perl::Role::Collection::Array::::sort_in_placeData::Perl::Role::Collection::Array::sort_in_place
0000s0sData::Perl::Role::Collection::Array::::spliceData::Perl::Role::Collection::Array::splice
0000s0sData::Perl::Role::Collection::Array::::tailData::Perl::Role::Collection::Array::tail
0000s0sData::Perl::Role::Collection::Array::::uniqData::Perl::Role::Collection::Array::uniq
0000s0sData::Perl::Role::Collection::Array::::unshiftData::Perl::Role::Collection::Array::unshift
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Data::Perl::Role::Collection::Array;
212µs$Data::Perl::Role::Collection::Array::VERSION = '0.002011';
3# ABSTRACT: Wrapping class for Perl's built in array structure.
4
5327µs3179µs
# spent 105µs (31+74) within Data::Perl::Role::Collection::Array::BEGIN@5 which was called: # once (31µs+74µs) by Role::Tiny::_load_module at line 5
use strictures 1;
# spent 105µs making 1 call to Data::Perl::Role::Collection::Array::BEGIN@5 # spent 53µs making 1 call to strictures::import # spent 21µs making 1 call to strictures::VERSION
6
7221µs2337µs
# spent 171µs (5+166) within Data::Perl::Role::Collection::Array::BEGIN@7 which was called: # once (5µs+166µs) by Role::Tiny::_load_module at line 7
use Role::Tiny;
# spent 171µs making 1 call to Data::Perl::Role::Collection::Array::BEGIN@7 # spent 166µs making 1 call to Role::Tiny::import
8216µs241µs
# spent 31µs (8+23) within Data::Perl::Role::Collection::Array::BEGIN@8 which was called: # once (8µs+23µs) by Role::Tiny::_load_module at line 8
use List::Util;
# spent 31µs making 1 call to Data::Perl::Role::Collection::Array::BEGIN@8 # spent 10µs making 1 call to List::Util::import
9225µs2519µs
# spent 263µs (7+256) within Data::Perl::Role::Collection::Array::BEGIN@9 which was called: # once (7µs+256µs) by Role::Tiny::_load_module at line 9
use List::MoreUtils;
# spent 263µs making 1 call to Data::Perl::Role::Collection::Array::BEGIN@9 # spent 256µs making 1 call to Exporter::Tiny::import
10273µs240µs
# spent 23µs (6+17) within Data::Perl::Role::Collection::Array::BEGIN@10 which was called: # once (6µs+17µs) by Role::Tiny::_load_module at line 10
use Scalar::Util qw/blessed/;
# spent 23µs making 1 call to Data::Perl::Role::Collection::Array::BEGIN@10 # spent 17µs making 1 call to Exporter::import
11
12sub new {
13 my $cl = CORE::shift; bless([ @_ ], $cl)
14}
15
16# find the package name if possible else default to __PACKAGE__
17#sub _blessed { blessed($_[0]) || __PACKAGE__ }
18
191734µs
# spent 34µs within Data::Perl::Role::Collection::Array::count which was called 17 times, avg 2µs/call: # 17 times (34µs+0s) by JSON::Schema::Modern::Document::has_errors at line 17 of (eval 303)[Sub/Quote.pm:3], avg 2µs/call
sub count { CORE::scalar @{$_[0]} }
20
21sub is_empty { CORE::scalar @{$_[0]} ? 0 : 1 }
22
23{
2431.42ms226µs
# spent 16µs (6+10) within Data::Perl::Role::Collection::Array::BEGIN@24 which was called: # once (6µs+10µs) by Role::Tiny::_load_module at line 24
no warnings 'once';
# spent 16µs making 1 call to Data::Perl::Role::Collection::Array::BEGIN@24 # spent 10µs making 1 call to warnings::unimport
25 sub all { @{$_[0]} }
26
2713µs *elements = *all;
2811µs *flatten = *all;
29}
30
31sub get { $_[0]->[ $_[1] ] }
32
33sub pop { CORE::pop @{$_[0]} }
34
35sub push { CORE::push @{$_[0]}, @_[1..$#_] }
36
37sub shift { CORE::shift @{$_[0]} }
38
39sub unshift { CORE::unshift @{$_[0]}, @_[1..$#_] }
40
41sub clear { @{$_[0]} = () }
42
43sub first { &List::Util::first($_[1], @{$_[0]}) }
44
45sub first_index { &List::MoreUtils::first_index($_[1], @{$_[0]}) }
46
47sub reduce { List::Util::reduce { $_[1]->($a, $b) } @{$_[0]} }
48
49sub set { $_[0]->[ $_[1] ] = $_[2] }
50
51sub accessor {
52 if (@_ == 2) {
53 $_[0]->[$_[1]];
54 }
55 elsif (@_ > 2) {
56 $_[0]->[$_[1]] = $_[2];
57 }
58}
59
60sub natatime {
61 my $iter = List::MoreUtils::natatime($_[1], @{$_[0]});
62
63 if ($_[2]) {
64 while (my @vals = $iter->()) {
65 $_[2]->(@vals);
66 }
67 }
68 else {
69 $iter;
70 }
71}
72
73sub shallow_clone { blessed($_[0]) ? bless([@{$_[0]}], ref $_[0]) : [@{$_[0]}] }
74
75# Data::Collection methods that return a Data::Perl::Collection::Array object
76#sub members {
77# my ($self) = @_;
78# qw/map grep member_count sort reverse print any all one none join/;
79#}
80
81
82sub map {
83 my ($self, $cb) = @_;
84
85 my @res = CORE::map { $cb->($_) } @$self;
86
87 blessed($self) ? blessed($self)->new(@res) : @res;
88}
89
90sub grep {
91 my ($self, $cb) = @_;
92
93 my @res = CORE::grep { $cb->($_) } @$self;
94
95 blessed($self) ? blessed($self)->new(@res) : @res;
96}
97
98sub sort {
99 my ($self, $cb) = @_;
100
101 my @res = $cb ? CORE::sort { $cb->($a, $b) } @$self : CORE::sort @$self;
102
103 blessed($self) ? blessed($self)->new(@res) : @res;
104}
105
106sub reverse {
107 my ($self) = @_;
108
109 my @res = CORE::reverse @$self;
110
111 blessed($self) ? blessed($self)->new(@res) : @res;
112}
113
114sub sort_in_place {
115 @{$_[0]} = ($_[1] ? sort { $_[1]->($a, $b) } @{$_[0]} : sort @{$_[0]});
116 $_[0];
117}
118
119sub splice {
120 my ($self) = @_;
121
122 my @res = CORE::splice @{$_[0]}, $_[1], $_[2], @_[3..$#_];
123
124 blessed($self) ? blessed($self)->new(@res) : @res;
125}
126
127sub shuffle {
128 my ($self) = @_;
129
130 my @res = List::Util::shuffle(@$self);
131
132 blessed($self) ? blessed($self)->new(@res) : @res;
133}
134
135sub uniq {
136 my ($self) = @_;
137
138 my @res = List::MoreUtils::uniq(@$self);
139
140 blessed($self) ? blessed($self)->new(@res) : @res;
141}
142
143sub delete {
144 my ($self, $idx) = @_;
145
146 my ($res) = CORE::splice(@$self, $idx, 1);
147
148 $res;
149}
150
151sub insert {
152 my ($self, $idx, $el) = @_;
153
154 my ($res) = CORE::splice(@$self, $idx, 0, $el);
155
156 $res;
157}
158
159sub flatten_deep {
160 my ($self, $depth) = @_;
161
162 _flatten_deep(@$self, $depth);
163}
164
165sub _flatten_deep {
166 my @array = @_;
167 my $depth = CORE::pop @array;
168 --$depth if (defined($depth));
169
170 my @elements = CORE::map {
171 (ref eq 'ARRAY')
172 ? (defined($depth) && $depth == -1) ? $_ : _flatten_deep( @$_, $depth )
173 : $_
174 } @array;
175}
176
177sub join {
178 my ($self, $with) = @_;
179
180 CORE::join((defined $with ? $with : ','), @$self);
181}
182
183sub print {
184 my ($self, $fh, $arg) = @_;
185
186 print { $fh || *STDOUT } CORE::join((defined $arg ? $arg : ','), @$self);
187}
188
189sub head {
190 my ($self, $count) = @_;
191
192 $count = $self->count if $count > $self->count;
193 $count = $self->count - -$count if $count < 0;
194
195 my @res = ($self->elements)[0 .. $count - 1];
196
197 blessed($self) ? blessed($self)->new(@res) : @res;
198}
199
200sub tail {
201 my ($self, $count) = @_;
202
203 $count = $self->count if $count > $self->count;
204 $count = $self->count - -$count if $count < 0;
205 my $start = $self->count - $count;
206
207 my @res = ($self->elements)[$start .. $self->count - 1];
208
209 blessed($self) ? blessed($self)->new(@res) : @res;
210}
211
212113µs1;
213
214=pod
215
216=encoding UTF-8
217
218=head1 NAME
219
220Data::Perl::Role::Collection::Array - Wrapping class for Perl's built in array structure.
221
222=head1 VERSION
223
224version 0.002011
225
226=head1 SYNOPSIS
227
228 use Data::Perl qw/array/;
229
230 my $array = array(1, 2, 3);
231
232 $array->push(5);
233
234 $array->grep(sub { $_ > 2 })->map(sub { $_ ** 2 })->elements; # (3, 5);
235
236=head1 DESCRIPTION
237
238This class provides a wrapper and methods for interacting with an array.
239All methods that return a list do so via a Data::Perl::Collection::Array object.
240
241=head1 PROVIDED METHODS
242
243=over 4
244
245=item B<new($value, $value, ....)>
246
247Constructs a new Data::Perl::Collection::Array object initialized with passed
248in values, and returns it.
249
250=item B<count>
251
252Returns the number of elements in the array.
253
254 $stuff = Data::Perl::Collection::Array->new(qw/foo bar baz boo/);
255
256 print $stuff->count; # prints 4
257
258This method does not accept any arguments.
259
260=item B<is_empty>
261
262Returns a boolean value that is true when the array has no elements.
263
264 $stuff->is_empty ? die "No options!\n" : print "Good boy.\n";
265
266This method does not accept any arguments.
267
268=item B<elements/all>
269
270Returns all of the elements of the array as an array (not an array reference).
271
272 my @options = $stuff->elements;
273 print "@options\n"; # prints "foo bar baz boo"
274
275This method does not accept any arguments.
276
277=item B<get($index)>
278
279Returns an element of the array by its index. You can also use negative index
280numbers, just as with Perl's core array handling.
281
282 my $option = $stuff->get(1);
283 print "$option\n"; # prints "bar"
284
285If the specified element does not exist, this will return C<undef>.
286
287This method accepts just one argument.
288
289=item B<pop>
290
291Just like Perl's builtin C<pop>.
292
293This method does not accept any arguments.
294
295=item B<push($value1, $value2, value3 ...)>
296
297Just like Perl's builtin C<push>. Returns the number of elements in the new
298array.
299
300This method accepts any number of arguments.
301
302=item B<shift>
303
304Just like Perl's builtin C<shift>.
305
306This method does not accept any arguments.
307
308=item B<unshift($value1, $value2, value3 ...)>
309
310Just like Perl's builtin C<unshift>. Returns the number of elements in the new
311array.
312
313This method accepts any number of arguments.
314
315=item B<splice($offset, $length, @values)>
316
317Just like Perl's builtin C<splice>. In scalar context, this returns the last
318element removed, or C<undef> if no elements were removed. In list context, this
319returns all the elements removed from the array, wrapped in a Collection::Array
320object.
321
322This method requires at least one argument.
323
324=item B<first( sub { ... } )>
325
326This method returns the first matching item in the array, just like
327L<List::Util>'s C<first> function. The matching is done with a subroutine
328reference you pass to this method. The subroutine will be called against each
329element in the array until one matches or all elements have been checked.
330
331 my $found = $stuff->find_option( sub {/^b/} );
332 print "$found\n"; # prints "bar"
333
334This method requires a single argument.
335
336=item B<first_index( sub { ... } )>
337
338This method returns the index of the first matching item in the array, just
339like L<List::MoreUtils>'s C<first_index> function. The matching is done with a
340subroutine reference you pass to this method. The subroutine will be called
341against each element in the array until one matches or all elements have been
342checked.
343
344This method requires a single argument.
345
346=item B<grep( sub { ... } )>
347
348This method returns every element matching a given criteria, just like Perl's
349core C<grep> function. This method requires a subroutine which implements the
350matching logic. The returned list is provided as a Collection::Array object.
351
352 my @found = $stuff->grep( sub {/^b/} );
353 print "@found\n"; # prints "bar baz boo"
354
355This method requires a single argument.
356
357=item B<map( sub { ... } )>
358
359This method transforms every element in the array and returns a new array, just
360like Perl's core C<map> function. This method requires a subroutine which
361implements the transformation. The returned list is provided as
362a Collection::Array object.
363
364 my @mod_options = $stuff->map( sub { $_ . "-tag" } );
365 print "@mod_options\n"; # prints "foo-tag bar-tag baz-tag boo-tag"
366
367This method requires a single argument.
368
369=item B<reduce( sub { ... } )>
370
371This method turns an array into a single value, by passing a function the
372value so far and the next value in the array, just like L<List::Util>'s
373C<reduce> function. The reducing is done with a subroutine reference you pass
374to this method.
375
376 my $found = $stuff->reduce( sub { $_[0] . $_[1] } );
377 print "$found\n"; # prints "foobarbazboo"
378
379This method requires a single argument.
380
381=item B<sort>
382
383=item B<sort( sub { ... } )>
384
385Returns the elements of the array in sorted order.
386
387You can provide an optional subroutine reference to sort with (as you can with
388Perl's core C<sort> function). However, instead of using C<$a> and C<$b> in
389this subroutine, you will need to use C<$_[0]> and C<$_[1]>. The returned list
390is provided as a Collection::Array object.
391
392 # ascending ASCIIbetical
393 my @sorted = $stuff->sort();
394
395 # Descending alphabetical order
396 my @sorted_options = $stuff->sort( sub { lc $_[1] cmp lc $_[0] } );
397 print "@sorted_options\n"; # prints "foo boo baz bar"
398
399This method accepts a single argument.
400
401=item B<sort_in_place>
402
403=item B<sort_in_place( sub { ... } )>
404
405Sorts the array I<in place>, modifying the value of the attribute.
406
407You can provide an optional subroutine reference to sort with (as you can with
408Perl's core C<sort> function). However, instead of using C<$a> and C<$b>, you
409will need to use C<$_[0]> and C<$_[1]> instead. The returned list is provided
410as a Collection::Array object.
411
412This method accepts a single argument.
413
414=item B<reverse>
415
416Returns the elements of the array in reversed order. The returned list is
417provided as a Collection::Array object.
418
419This method does not accept any arguments.
420
421=item B<shuffle>
422
423Returns the elements of the array in random order, like C<shuffle> from
424L<List::Util>. The returned list is provided as a Collection::Array object.
425
426This method does not accept any arguments.
427
428=item B<uniq>
429
430Returns the array with all duplicate elements removed, like C<uniq> from
431L<List::MoreUtils>. The returned list is provided as a Collection::Array object.
432
433This method does not accept any arguments.
434
435=item B<head($count)>
436
437Returns the first C<$count> elements of the array. If C<$count> is greater
438than the number of elements in the array, the array (without spurious C<undef>s)
439is returned. Negative C<$count> means "all but the last C<$count> elements". The
440returned list is provided as a Collection::Array object.
441
442=item B<tail($count)>
443
444Returns the last C<$count> elements of the array. If C<$count> is greater
445than the number of elements in the array, the array (without spurious C<undef>s)
446is returned. Negative C<$count> means "all but the first C<$count> elements". The
447returned list is provided as a Collection::Array object.
448
449=item B<join($str)>
450
451Joins every element of the array using the separator given as argument, just
452like Perl's core C<join> function.
453
454 my $joined = $stuff->join(':');
455 print "$joined\n"; # prints "foo:bar:baz:boo"
456
457This method requires a single argument.
458
459=item B<print($handle, $str)>
460
461Prints the output of join($str) to $handle. $handle defaults to STDOUT, and
462join $str defaults to join()'s default of ','.
463
464 $joined = $stuff->print(*STDERR, ';'); # prints foo;bar;baz to STDERR
465
466=item B<set($index, $value)>
467
468Given an index and a value, sets the specified array element's value.
469
470This method returns the value at C<$index> after the set.
471
472This method requires two arguments.
473
474=item B<delete($index)>
475
476Removes the element at the given index from the array.
477
478This method returns the deleted value, either as an array or scalar as
479dependent on splice context semantics. Note that if no value exists, it will
480
481return C<undef>.
482
483This method requires one argument.
484
485=item B<insert($index, $value)>
486
487Inserts a new element into the array at the given index.
488
489This method returns the new value at C<$index>, either as an array or scalar as
490dependent on splice context semantics.
491
492This method requires two arguments.
493
494=item B<clear>
495
496Empties the entire array, like C<@array = ()>.
497
498This method does not define a return value.
499
500This method does not accept any arguments.
501
502=item B<accessor($index)>
503
504=item B<accessor($index, $value)>
505
506This method provides a get/set accessor for the array, based on array indexes.
507If passed one argument, it returns the value at the specified index. If
508passed two arguments, it sets the value of the specified index.
509
510When called as a setter, this method returns the new value at C<$index>.
511
512This method accepts one or two arguments.
513
514=item B<natatime($n)>
515
516=item B<natatime($n, $code)>
517
518This method returns an iterator which, on each call, returns C<$n> more items
519from the array, in order, like C<natatime> from L<List::MoreUtils>. A coderef
520can optionally be provided; it will be called on each group of C<$n> elements
521in the array.
522
523This method accepts one or two arguments.
524
525=item B<shallow_clone>
526
527This method returns a shallow clone of the array reference. The return value
528is a reference to a new array with the same elements. It is I<shallow>
529because any elements that were references in the original will be the I<same>
530references in the clone.
531
532=item B<flatten>
533
534This method returns a list of elements in the array. This method is an alias
535to the I<elements> method.
536
537=item B<flatten_deep($level)>
538
539This method returns a flattened list of elements in the array. Will flatten
540arrays contained within the root array recursively - depth is controlled by the
541optional $level parameter.
542
543=back
544
545=head1 SEE ALSO
546
547=over 4
548
549=item * L<Data::Perl>
550
551=item * L<MooX::HandlesVia>
552
553=back
554
555=head1 AUTHOR
556
557Matthew Phillips <mattp@cpan.org>
558
559=head1 COPYRIGHT AND LICENSE
560
561This software is copyright (c) 2020 by Matthew Phillips <mattp@cpan.org>.
562
563This is free software; you can redistribute it and/or modify it under
564the same terms as the Perl 5 programming language system itself.
565
566=cut
567
568__END__
Report produced by the NYTProf 6.12 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.