File Coverage

blib/lib/Data/LnArray.pm
Criterion Covered Total %
statement 194 207 93.7
branch 43 54 79.6
condition 9 17 52.9
subroutine 39 41 95.1
pod 34 38 89.4
total 319 357 89.3


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