File Coverage

blib/lib/Class/MakeMethods/Utility/ArraySplicer.pm
Criterion Covered Total %
statement 29 55 52.7
branch 6 32 18.7
condition 7 27 25.9
subroutine 9 9 100.0
pod 1 1 100.0
total 52 124 41.9


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Class::MakeMethods::Utility::ArraySplicer - Common array ops
4              
5             =head1 SYNOPSIS
6              
7             use Class::MakeMethods::Utility::ArraySplicer;
8            
9             # Get one or more values
10             $value = array_splicer( $array_ref, $index );
11             @values = array_splicer( $array_ref, $index_array_ref );
12            
13             # Set one or more values
14             array_splicer( $array_ref, $index => $new_value, ... );
15            
16             # Splice selected values in or out
17             array_splicer( $array_ref, [ $start_index, $end_index], [ @values ]);
18              
19             =head1 DESCRIPTION
20              
21             This module provides a utility function and several associated constants which support a general purpose array-splicer interface, used by several of the Standard and Composite method generators.
22              
23             =cut
24              
25             ########################################################################
26              
27             package Class::MakeMethods::Utility::ArraySplicer;
28              
29             $VERSION = 1.000;
30              
31             @EXPORT_OK = qw(
32             array_splicer
33             array_set array_clear array_push array_pop array_unshift array_shift
34             );
35 13 50   13   17819 sub import { require Exporter and goto &Exporter::import } # lazy Exporter
36              
37 10     10   53 use strict;
  10         18  
  10         7466  
38              
39             ########################################################################
40              
41             =head2 array_splicer
42              
43             This is a general-purpose array accessor function. Depending on the arguments passed to it, it will get, set, slice, splice, or otherwise modify your array.
44              
45             =over 4
46              
47             =item *
48              
49             If called without any arguments, returns the contents of the array in list context, or an array reference in scalar context (or undef).
50              
51             # Get all values
52             $value_ref = array_splicer( $array_ref );
53             @values = array_splicer( $array_ref );
54              
55             =item *
56              
57             If called with a single numeric argument, uses that argument as an index to retrieve from the referenced array, and returns that value (or undef).
58              
59             # Get one value
60             $value = array_splicer( $array_ref, $index );
61              
62             =item *
63              
64             If called with a single array ref argument, sets the contents of the array to match the contents of the provided one.
65              
66             # Set contents of array
67             array_splicer( $array_ref, [ $value1, $value2, ... ] );
68              
69             # Reset the array contents to empty
70             array_splicer( $array_ref, [] );
71              
72             =item *
73              
74             If called with a two arguments, the first undefined and the second an array ref argument, uses that array's contents as a list of indexes to return a slice of the referenced array.
75              
76             # Get slice of values
77             @values = array_splicer( $array_ref, undef, [ $index1, $index2, ... ] );
78              
79             =item *
80              
81             If called with a list of argument pairs, each with a numeric index and an associated value, stores the value at the given index in the referenced array. The current value in each position will be overwritten, and later arguments with the same index will override earlier ones. Returns the current array-ref value.
82              
83             # Set one or more values by index
84             array_splicer( $array_ref, $index1 => $value1, $index2 => $value2, ... );
85              
86             =item *
87              
88             If called with a list of argument pairs, each with the first item being a reference to an array of up to two numbers, loops over each pair and uses those numbers to splice the value array.
89              
90             # Splice selected values in or out
91             array_splicer( $array_ref, [ $start_index, $count], [ @values ]);
92              
93             The first controlling number is the position at which the splice will begin. Zero will start before the first item in the list. Negative numbers count backwards from the end of the array.
94              
95             The second number is the number of items to be removed from the list. If it is omitted, or undefined, or zero, no items are removed. If it is a positive integer, that many items will be returned.
96              
97             If both numbers are omitted, or are both undefined, they default to containing the entire value array.
98              
99             If the second argument is undef, no values will be inserted; if it is a non-reference value, that one value will be inserted; if it is an array-ref, its values will be copied.
100              
101             The method returns the items that removed from the array, if any.
102              
103             Here are some examples of common splicing operations.
104              
105             # Insert an item at position in the array
106             $obj->bar([3], 'Potatoes' );
107            
108             # Remove 1 item from position 3 in the array
109             $obj->bar([3, 1], undef );
110            
111             # Set a new value at position 2, and return the old value
112             print $obj->bar([2, 1], 'Froth' );
113              
114             # Unshift an item onto the front of the list
115             array_splicer( $array_ref, [0], 'Bubbles' );
116              
117             # Shift the first item off of the front of the list
118             print array_splicer( $array_ref, [0, 1], undef );
119              
120             # Push an item onto the end of the list
121             array_splicer( $array_ref, [undef], 'Bubbles' );
122              
123             # Pop the last item off of the end of the list
124             print array_splicer( $array_ref, [undef, 1], undef );
125              
126             =back
127              
128             =cut
129              
130             sub array_splicer {
131 8     8 1 11 my $value_ref = shift;
132            
133             # RETRIEVE VALUES
134 8 50 66     132 if ( scalar(@_) == 0 ) {
    100 66        
    50 33        
    50 33        
    0 33        
    0 0        
      0        
      0        
135 0 0       0 return wantarray ? @$value_ref : $value_ref;
136            
137             # FETCH BY INDEX
138             } elsif ( scalar(@_) == 1 and length($_[0]) and ! ref($_[0]) and $_[0] !~ /\D/) {
139 5         25 $value_ref->[ $_[0] ]
140            
141             # SET CONTENTS
142             } elsif ( scalar(@_) == 1 and ref $_[0] eq 'ARRAY' ) {
143 0         0 @$value_ref = @{ $_[0] };
  0         0  
144 0 0       0 return wantarray ? @$value_ref : $value_ref;
145            
146             # ASSIGN BY INDEX
147             } elsif ( ! ( scalar(@_) % 2 ) and ! grep { ! ( length($_) and ! ref($_) and $_ !~ /\D/ ) } map { $_[$_] } grep { ! ( $_ % 2 ) } ( 0 .. $#_ ) ) {
148 3         23 while ( scalar(@_) ) {
149 3         4 my $key = shift();
150 3         11 $value_ref->[ $key ] = shift();
151             }
152 3         12 $value_ref;
153              
154             # SLICE
155             } elsif ( ! scalar(@_) == 2 and ! defined $_[0] and ref $_[1] eq 'ARRAY' ) {
156 0           @{$value_ref}[ @{ $_[1] } ]
  0            
  0            
157            
158             # SPLICE
159             } elsif ( ! scalar(@_) % 2 and ref $_[0] eq 'ARRAY' ) {
160 0           my @results;
161 0           while ( scalar(@_) ) {
162 0           my $key = shift();
163 0           my $value = shift();
164 0 0         my @values = ! ( $value ) ? () : ! ref ( $value ) ? $value : @$value;
    0          
165 0           my $key_v = $key->[0];
166 0           my $key_c = $key->[1];
167 0 0         if ( defined $key_v ) {
168 0 0         if ( $key_c ) {
169             # straightforward two-value splice
170             } else {
171             # insert at position
172 0           $key_c = 0;
173             }
174             } else {
175 0 0         if ( ! defined $key_c ) {
    0          
176             # target the entire list
177 0           $key_v = 0;
178 0           $key_c = scalar @$value_ref;
179             } elsif ( $key_c ) {
180             # take count items off the end
181 0           $key_v = - $key_c
182             } else {
183             # insert at the end
184 0           $key_v = scalar @$value_ref;
185 0           $key_c = 0;
186             }
187             }
188 0           push @results, splice @$value_ref, $key_v, $key_c, @values
189             }
190 0 0 0       ( ! wantarray and scalar @results == 1 ) ? $results[0] : @results;
191            
192             } else {
193 0           Carp::confess 'Unexpected arguments to array accessor: ' . join(', ', map "'$_'", @_ );
194             }
195             }
196              
197             ########################################################################
198              
199             =head2 Constants
200              
201             There are also constants symbols to facilitate some common combinations of splicing arguments:
202              
203             # Reset the array contents to empty
204             array_splicer( $array_ref, array_clear );
205            
206             # Set the array contents to provided values
207             array_splicer( $array_ref, array_splice, [ 2, 3 ] );
208            
209             # Unshift an item onto the front of the list
210             array_splicer( $array_ref, array_unshift, 'Bubbles' );
211            
212             # Shift it back off again
213             print array_splicer( $array_ref, array_shift );
214            
215             # Push an item onto the end of the list
216             array_splicer( $array_ref, array_push, 'Bubbles' );
217            
218             # Pop it back off again
219             print array_splicer( $array_ref, array_pop );
220              
221             =cut
222              
223 10     10   67 use constant array_splice => undef;
  10         20  
  10         865  
224 10     10   53 use constant array_clear => ( [] );
  10         27  
  10         594  
225              
226 10     10   48 use constant array_push => [undef];
  10         18  
  10         525  
227 10     10   50 use constant array_pop => ( [undef, 1], undef );
  10         22  
  10         868  
228              
229 10     10   49 use constant array_unshift => [0];
  10         41  
  10         540  
230 10     10   51 use constant array_shift => ( [0, 1], undef );
  10         14  
  10         706  
231              
232             ########################################################################
233              
234             =head1 SEE ALSO
235              
236             See L for general information about this distribution.
237              
238             See L and numerous other classes for
239             examples of usage.
240              
241             =cut
242              
243             1;