File Coverage

blib/lib/Data/LnArray.pm
Criterion Covered Total %
statement 193 205 94.1
branch 45 52 86.5
condition 9 19 47.3
subroutine 39 41 95.1
pod 34 38 89.4
total 320 355 90.1


line stmt bran cond sub pod time code
1             package Data::LnArray;
2 34     34   2356185 use strict;
  34         359  
  34         1057  
3 34     34   175 no warnings;
  34         60  
  34         1084  
4 34     34   172 use base 'Import::Export';
  34         67  
  34         17127  
5             our $VERSION = '0.03';
6              
7             our %EX = (
8             arr => [qw/all/],
9             );
10              
11             sub arr {
12 1     1 1 95 Data::LnArray->new(@_);
13             }
14              
15             sub new {
16 52     52 0 4991 my $class = shift;
17 52         278 bless [@_], __PACKAGE__;
18             }
19              
20             sub length {
21 23     23 1 3792 my ($self) = shift;
22              
23 23         37 scalar @{$self};
  23         121  
24             }
25              
26             sub retrieve {
27 6     6 0 27 my ($self) = shift;
28              
29             # probably is not going to work
30 6         8 return @{$self};
  6         28  
31             }
32              
33             sub from {
34 5     5 1 8492 my ($self) = shift;
35              
36 5         10 my ( $data, $code ) = @_;
37 5         9 my $ref = ref $data;
38             my @data
39             = !$ref ? split //, $data
40 2         6 : $ref eq 'ARRAY' ? @{$data}
41 5 100       18 : do {
    100          
42 2 100       17 die 'currently cannot handle' unless $data->{length};
43 1         4 0 .. $data->{length} - 1;
44             };
45 4 100       12 return $self->new( $code ? map { $code->($_) } @data : @data );
  8         22  
46             }
47              
48             sub isArray {
49 0     0 1 0 my ($self) = shift;
50              
51 0         0 my ($data) = @_;
52 0   0     0 my $ref = ref $data || "";
53 0 0       0 $ref eq 'ARRAY' ? \1 : \0;
54             }
55              
56             sub of {
57 1     1 1 6 my ($self) = shift;
58              
59 1         4 return $self->new(@_);
60             }
61              
62             sub copyWithin {
63 4     4 1 17 my ($self) = shift;
64              
65 4         16 my ( $target, $start, $end ) = @_;
66 4         11 my $length = $self->length;
67              
68 4 100       17 my $to
69             = $target < 0
70             ? $self->mmax( $length + $target, 0 )
71             : $self->mmin( $target, $length );
72              
73 4 100       10 my $from
74             = $start < 0
75             ? $self->mmax( $length + $start, 0 )
76             : $self->mmin( $start, $length );
77              
78 4 100       9 $end = defined $end ? $end : $length;
79 4 100       9 my $final
80             = $end < 0
81             ? $self->mmax( $length + $end, 0 )
82             : $self->mmin( $end, $length );
83              
84 4         12 my $count = $self->mmin( $final - $from, $length - $to );
85              
86 4         5 my $direction = 1;
87              
88 4 100 66     12 if ( $from < $to && $to < ( $from + $count ) ) {
89 1         1 $direction = -1;
90 1         2 $from += $count - 1;
91 1         2 $to += $count - 1;
92             }
93              
94 4         9 while ( $count > 0 ) {
95 5         9 $self->[$to] = $self->[$from];
96 5         7 $from += $direction;
97 5         6 $to += $direction;
98 5         23 $count--;
99             }
100              
101 4         17 return $self;
102             }
103              
104             sub fill {
105 3     3 1 15 my ($self) = shift;
106              
107 3         8 my ( $target, $start, $end ) = @_;
108 3         6 my $length = $self->length;
109              
110 3 100       15 my $from
111             = $start < 0
112             ? $self->mmax( $length + $start, 0 )
113             : $self->mmin( $start, $length );
114              
115 3 100       9 $end = defined $end ? $end : $length - 1;
116 3 100       8 my $final
117             = $end < 0
118             ? $self->mmax( $length + $end, 0 )
119             : $self->mmin( $end, $length );
120 3         8 while ( $from <= $final ) {
121 4         7 $self->[$from] = $target;
122 4         7 $from++;
123             }
124              
125 3         7 return $self;
126             }
127              
128             sub pop {
129 1     1 1 4 my ($self) = shift;
130              
131 1         2 pop @{$self};
  1         8  
132             }
133              
134             sub push {
135 1     1 1 5 my ($self) = shift;
136              
137 1         2 push @{$self}, @_;
  1         12  
138             }
139              
140             sub reverse {
141 2     2 1 9 my ($self) = shift;
142              
143 2         6 return $self->new( reverse @{$self} );
  2         17  
144             }
145              
146             sub shift {
147 1     1 1 7 my ($self) = shift;
148              
149 1         1 shift @{$self};
  1         9  
150             }
151              
152             sub sort {
153 1     1 1 8 my ($self) = shift;
154              
155 1         2 my $sort = shift;
156 1         2 my @array = grep { ref $_ ne 'CODE' } sort $sort, @{$self};
  5         10  
  1         10  
157 1         3 $self->new(@array);
158             }
159              
160             sub splice {
161 3     3 1 11 my ($self) = shift;
162              
163 3         5 my ( $offset, $length, $target ) = @_;
164 3 100       7 if ( defined $target ) {
165 2         3 splice @{$self}, $offset, $length, $target;
  2         8  
166             }
167             else {
168 1         2 splice @{$self}, $offset, $length;
  1         2  
169             }
170 3         12 return $self;
171             }
172              
173             sub unshift {
174 1     1 1 6 my ($self) = shift;
175              
176 1         2 my ($target) = @_;
177 1         2 unshift @{$self}, $target;
  1         7  
178 1         5 return $self;
179             }
180              
181             sub concat {
182 1     1 1 7 my ($self) = shift;
183              
184 1         2 my ($array) = @_;
185 1         3 push @{$self}, @{$array};
  1         7  
  1         4  
186 1         5 return $self;
187             }
188              
189             sub filter {
190 1     1 1 10 my ($self) = shift;
191              
192 1         1 my $grep = shift;
193 1         2 my @new;
194 1         3 for ( @{$self} ) {
  1         10  
195 4 100       14 if ( $grep->($_) ) {
196 3         11 push @new, $_;
197             }
198             }
199 1         5 return $self->new(@new);
200             }
201              
202             sub includes {
203 1     1 1 9 my ($self) = shift;
204              
205 1         3 my @match = grep { $_[0] =~ m/$_/ } @{$self};
  4         37  
  1         11  
206 1 50       7 scalar @match ? \1 : \0;
207             }
208              
209             sub indexOf {
210 1     1 1 7 my ($self) = shift;
211              
212 1         2 my $i = 0;
213 1         2 for ( @{$self} ) {
  1         10  
214 1 50       8 return $i if $_ eq $_[0];
215 0         0 $i++;
216             }
217 0         0 return -1;
218             }
219              
220             sub join {
221 2     2 1 9 my ($self) = shift;
222              
223 2         5 join $_[0], @{$self};
  2         24  
224             }
225              
226             sub lastIndexOf {
227 1     1 1 7 my ($self) = shift;
228              
229 1         4 for ( my $i = $self->length - 1; $i >= 0; $i-- ) {
230 3 100       13 return $i if $self->[$i] eq $_[0];
231             }
232             }
233              
234             sub slice {
235 1     1 1 7 my ($self) = shift;
236              
237 1         3 my ( $begin, $end ) = @_;
238 1         3 my @de = @{$self};
  1         12  
239 1         6 return $self->new( @de[ $begin, $end ] );
240             }
241              
242             sub toString {
243 1     1 1 7 my ($self) = shift;
244              
245 1         6 return $self->join(',');
246             }
247              
248             sub toLocaleString {
249 0     0 1 0 my ($self) = shift;
250              
251 0         0 die 'TODO DateTime';
252             }
253              
254             sub entries {
255 1     1 1 7 my ($self) = shift;
256              
257 1         1 my %entries;
258 1         3 for ( my $i = $self->length - 1; $i >= 0; $i-- ) {
259 4         13 $entries{$i} = $self->[$i];
260             }
261 1         7 return %entries;
262             }
263              
264             sub every {
265 2     2 1 815 my ($self) = shift;
266              
267 2         3 my $cb = shift;
268 2         4 for ( @{$self} ) {
  2         9  
269 6 100       62 return \0 unless $cb->($_);
270             }
271 1         5 return \1;
272             }
273              
274             sub find {
275 2     2 1 680 my ($self) = shift;
276              
277 2         5 my $cb = shift;
278 2         3 for ( @{$self} ) {
  2         14  
279 5 100       20 return $_ if $cb->($_);
280             }
281 1         5 return;
282             }
283              
284             sub findIndex {
285 2     2 1 670 my ($self) = shift;
286              
287 2         4 my $cb = shift;
288 2         4 my $i = 0;
289 2         4 for ( @{$self} ) {
  2         13  
290 5 100       10 return $i if $cb->($_);
291 4         17 $i++;
292             }
293 1         3 return;
294             }
295              
296             sub forEach {
297 1     1 1 14 my ($self) = shift;
298              
299 1         3 my ($code) = @_;
300 1         3 my @out;
301 1         9 for (@$self) {
302 4         24 push @out, $code->($_);
303             }
304 1         9 return @out;
305             }
306              
307             sub keys {
308 1     1 1 8 my ($self) = shift;
309              
310 1         5 return 0 .. $self->length - 1;
311             }
312              
313             sub map {
314 1     1 1 11 my ($self) = shift;
315              
316 1         4 my ( $cb, @new ) = (shift);
317 1         2 for ( @{$self} ) {
  1         11  
318 4         15 push @new, $cb->($_);
319             }
320 1         5 return $self->new(@new);
321             }
322              
323             sub reduce {
324 2     2 1 11 my ($self) = shift;
325              
326 2         6 my ( $cb, $reduced ) = ( shift, shift );
327 2         4 for ( @{$self} ) {
  2         12  
328 8         31 $reduced = $cb->( $reduced, $_ );
329             }
330 2         15 return $reduced;
331             }
332              
333             sub reduceRight {
334 1     1 1 12 my ($self) = shift;
335              
336 1         6 my $rev = $self->reverse;
337 1         5 return $rev->reduce(@_);
338             }
339              
340             sub some {
341 2     2 1 866 my ($self) = shift;
342              
343 2         4 my ($cb) = (shift);
344 2         4 for ( @{$self} ) {
  2         10  
345 5 100       17 return \1 if $cb->($_);
346             }
347 1         5 return \0;
348             }
349              
350             sub values {
351 1     1 1 6 my ($self) = shift;
352 1         1 return @{$self};
  1         9  
353             }
354              
355             sub mmax {
356 5     5 0 8 my ($self) = shift;
357 5         10 my $caller = caller();
358 5         17 my @allowed = qw//;
359 5 50 33     14 unless ( $caller eq __PACKAGE__ || grep { $_ eq $caller } @allowed ) {
  0         0  
360 0         0 die "cannot call private method mmax from $caller";
361             }
362 5 50 50     31 $_[ ( $_[0] || 0 ) < ( $_[1] || 0 ) ] || 0;
      50        
363             }
364              
365             sub mmin {
366 17     17 0 23 my ($self) = shift;
367 17         26 my $caller = caller();
368 17         23 my @allowed = qw//;
369 17 50 33     31 unless ( $caller eq __PACKAGE__ || grep { $_ eq $caller } @allowed ) {
  0         0  
370 0         0 die "cannot call private method mmin from $caller";
371             }
372 17 100 100     59 $_[ ( $_[0] || 0 ) > ( $_[1] || 0 ) ] || 0;
      50        
373             }
374              
375             1;
376              
377             =head1 NAME
378              
379             Data::LnArray - The great new Data::LnArray!
380              
381             =head1 VERSION
382              
383             Version 0.03
384              
385             =cut
386              
387             =head1 SYNOPSIS
388              
389             use Data::LnArray;
390              
391             my $foo = Data::LnArray->new(qw/last night in paradise/);
392            
393              
394             $foo->push('!');
395              
396             ...
397              
398             use Data::LnArray qw/all/;
399              
400             my $okay = arr(qw/one two three/);
401              
402             =head1 Exports
403              
404             =head2 arr
405              
406             Shorthand for generating a new Data::LnArray Object.
407              
408             my $dlna = arr(qw/.../);
409              
410             $dlna->$method;
411              
412              
413             =head1 SUBROUTINES/METHODS
414              
415             =head2 length
416              
417             Returns an Integer that represents the length of the array.
418              
419             $foo->length;
420              
421             =head2 from
422              
423             Creates a new Data::LnArray instance from a string, array reference or hash reference.
424              
425             Data::LnArray->from(qw/foo/); # ['f', 'o', 'o']
426            
427             $foo->from([qw/one two three four/]); # ['one', 'two', 'three', 'four']
428            
429             $foo->from([qw/1 2 3/], sub { $_ + $_ }); # [2, 4, 6]
430              
431             $foo->from({length => 5}, sub { $_ + $_ }); # [0, 2, 4, 6, 8]
432              
433             =head2 isArray
434              
435             Returns a boolean, true if value is an array or false otherwise.
436              
437             $foo->isArray($other);
438              
439             =head2 of
440              
441             Creates a new Array instance with a variable number of arguments, regardless of number or type of the arguments.
442              
443             my $new = $array->of(qw/one two three four/);
444              
445             =head2 copyWithin
446              
447             Copies a sequence of array elements within the array.
448              
449             my $foo = Data::LnArray->new(qw/one two three four/);
450             my $bar = $foo->copyWithin(0, 2, 3); # [qw/three four three four/];
451              
452             ...
453              
454             my $foo = Data::LnArray->new(1, 2, 3, 4, 5);
455             my $bar = $array->copyWithin(-2, -3, -1); # [1, 2, 3, 3, 4]
456              
457             =head2 fill
458              
459             Fills all the elements of an array from a start index to an end index with a static value.
460              
461             my $foo = Data::LnArray->new(1, 2, 3, 4, 5);
462             $foo->fill(0, 2) # 0, 0, 0, 4, 5
463              
464             =head2 pop
465              
466             Removes the last element from an array and returns that element.
467              
468             $foo->pop;
469              
470             =head2 push
471              
472             Adds one or more elements to the end of an array, and returns the new length of the array.
473              
474             $foo->push(@new);
475              
476             =head2 reverse
477              
478             Reverses the order of the elements of an array in place. (First becomes the last, last becomes first.)
479              
480             $foo->reverse;
481              
482             =head2 shift
483              
484             Removes the first element from an array and returns that element.
485              
486             $foo->shift;
487              
488             =head2 sort
489              
490             Sorts the elements of an array in place and returns the array.
491              
492             $foo->sort(sub {
493             $a <=> $b
494             });
495              
496             =head2 splice
497              
498             Adds and/or removes elements from an array.
499              
500             $foo->splice(0, 1, 'foo');
501              
502             =head2 unshift
503              
504             Adds one or more elements to the front of an array, and returns the new length of the array.
505              
506             $foo->unshift;
507              
508             =head2 concat
509              
510             Returns a new array that is this array joined with other array(s) and/or value(s).
511              
512             $foo->concat($bar);
513              
514             =head2 filter
515              
516             Returns a new array containing all elements of the calling array for which the provided filtering callback returns true.
517              
518             $foo->filter(sub {
519             $_ eq 'one'
520             });
521              
522             =head2 includes
523              
524             Determines whether the array contains the value to find, returning true or false as appropriate.
525              
526             $foo->includes('one');
527              
528             =head2 indexOf
529              
530             Returns the first (least) index of an element within the array equal to search string, or -1 if none is found.
531              
532             $foo->indexOf('one');
533              
534             =head2 join
535              
536             Joins all elements of an array into a string.
537              
538             $foo->join('|');
539              
540             =head2 lastIndexOf
541              
542             Returns the last (greatest) index of an element within the array equal to search string, or -1 if none is found.
543              
544             $foo->lastIndexOf('two');
545              
546             =head2 slice
547              
548             Extracts a section of the calling array and returns a new array.
549              
550             $foo->slice(0, 2);
551              
552             =head2 toString
553              
554             Returns a string representing the array and its elements.
555              
556             $foo->toString;
557              
558             =head2 toLocaleString
559              
560             Returns a localized string representing the array and its elements. Overrides the Object.prototype.toLocaleString() method.
561              
562             TODO
563              
564             =head2 entries()
565              
566             Returns a new Array Iterator object that contains the key/value pairs for each index in the array.
567              
568             $foo->entries;
569             # {
570             # 0 => 'one',
571             # 1 => 'two'
572             # }
573              
574             =head2 every
575              
576             Returns true if every item in this array satisfies the testing callback.
577              
578             $foo->every(sub { ... });
579              
580             =head2 find
581              
582             Returns the found item in the array if some item in the array satisfies the testing callbackFn, or undefined if not found.
583              
584             $foo->find(sub { ... });
585              
586             =head2 findIndex
587              
588             Returns the found index in the array, if an item in the array satisfies the testing callback, or -1 if not found.
589              
590             $foo->findIndex(sub { ... });
591              
592             =head2 forEach
593              
594             Calls a callback for each element in the array.
595              
596             $foo->forEach(sub { ... });
597              
598             =head2 keys
599              
600             Returns a new Array that contains the keys for each index in the array.
601              
602             $foo->keys();
603              
604             =head2 map
605              
606             Returns a new array containing the results of calling the callback on every element in this array.
607              
608             my %hash = $foo->map(sub { ... });
609              
610             =head2 reduce
611              
612             Apply a callback against an accumulator and each value of the array (from left-to-right) as to reduce it to a single value.
613              
614             my $str = $foo->reduce(sub { $_[0] + $_[1] });
615              
616             =head2 reduceRight
617              
618             Apply a callback against an accumulator and each value of the array (from right-to-left) as to reduce it to a single value.
619              
620             my $str = $foo->reduceRight(sub { ... });
621              
622             =head2 some
623              
624             Returns true if at least one element in this array satisfies the provided testing callback.
625              
626             my $bool = $foo->some(sub { ... });
627              
628             =head2 values
629              
630             Returns the raw Array(list) of the Data::LnArray Object.
631              
632             my @values = $foo->values;
633              
634             =head1 AUTHOR
635              
636             LNATION, C<< >>
637              
638             =head1 BUGS
639              
640             Please report any bugs or feature requests to C, or through
641             the web interface at L. I will be notified, and then you'll
642             automatically be notified of progress on your bug as I make changes.
643              
644             =head1 SUPPORT
645              
646             You can find documentation for this module with the perldoc command.
647              
648             perldoc Data::LnArray
649              
650             You can also look for information at:
651              
652             =over 4
653              
654             =item * RT: CPAN's request tracker (report bugs here)
655              
656             L
657              
658             =item * AnnoCPAN: Annotated CPAN documentation
659              
660             L
661              
662             =item * CPAN Ratings
663              
664             L
665              
666             =item * Search CPAN
667              
668             L
669              
670             =back
671              
672             =head1 ACKNOWLEDGEMENTS
673              
674             MDN Array
675             L
676              
677             =head1 LICENSE AND COPYRIGHT
678              
679             This software is Copyright (c) 2020 by LNATION.
680              
681             This is free software, licensed under:
682              
683             The Artistic License 2.0 (GPL Compatible)
684              
685             =cut