File Coverage

blib/lib/Data/Object/Array.pm
Criterion Covered Total %
statement 20 20 100.0
branch 2 6 33.3
condition 2 6 33.3
subroutine 8 8 100.0
pod 0 4 0.0
total 32 44 72.7


line stmt bran cond sub pod time code
1             # ABSTRACT: Array Object for Perl 5
2             package Data::Object::Array;
3              
4 89     89   51251 use 5.010;
  89         283  
5              
6 89     89   432 use Scalar::Util 'blessed';
  89         123  
  89         6547  
7 89     89   25785 use Data::Object 'deduce_deep', 'detract_deep', 'throw';
  89         173  
  89         6713  
8 89     89   28110 use Data::Object::Class 'with';
  89         207  
  89         901  
9              
10             with 'Data::Object::Role::Array';
11              
12             our $VERSION = '0.41'; # VERSION
13              
14             sub new {
15 166     166 0 116740 my $class = shift;
16 166 50       630 my $args = @_ > 1 ? [@_] : shift;
17 166         288 my $role = 'Data::Object::Role::Type';
18              
19 166 0 33     1195 $args = $args->data if blessed($args)
      33        
20             and $args->can('does')
21             and $args->does($role);
22              
23 166 50       762 throw 'Type Instantiation Error: Not an ArrayRef'
24             unless 'ARRAY' eq ref $args;
25              
26 166         683 return bless $args, $class;
27             }
28              
29             around 'all' => sub {
30             my ($orig, $self, @args) = @_;
31             my $result = $self->$orig(@args);
32             return scalar deduce_deep $result;
33             };
34              
35             around 'any' => sub {
36             my ($orig, $self, @args) = @_;
37             my $result = $self->$orig(@args);
38             return scalar deduce_deep $result;
39             };
40              
41             around 'clear' => sub {
42             my ($orig, $self, @args) = @_;
43             my $result = $self->$orig(@args);
44             return scalar deduce_deep $result;
45             };
46              
47             around 'count' => sub {
48             my ($orig, $self, @args) = @_;
49             my $result = $self->$orig(@args);
50             return scalar deduce_deep $result;
51             };
52              
53             sub data {
54 2     2 0 11 goto &detract;
55             }
56              
57             sub detract {
58 3     3 0 35 return detract_deep shift;
59             }
60              
61             around 'defined' => sub {
62             my ($orig, $self, @args) = @_;
63             my $result = $self->$orig(@args);
64             return scalar deduce_deep $result;
65             };
66              
67             around 'delete' => sub {
68             my ($orig, $self, @args) = @_;
69             my $result = $self->$orig(@args);
70             return scalar deduce_deep $result;
71             };
72              
73             around 'each' => sub {
74             my ($orig, $self, @args) = @_;
75             my $result = $self->$orig(@args);
76             return scalar deduce_deep $result;
77             };
78              
79             around 'each_key' => sub {
80             my ($orig, $self, @args) = @_;
81             my $result = $self->$orig(@args);
82             return scalar deduce_deep $result;
83             };
84              
85             around 'each_n_values' => sub {
86             my ($orig, $self, @args) = @_;
87             my $result = $self->$orig(@args);
88             return scalar deduce_deep $result;
89             };
90              
91             around 'each_value' => sub {
92             my ($orig, $self, @args) = @_;
93             my $result = $self->$orig(@args);
94             return scalar deduce_deep $result;
95             };
96              
97             around 'empty' => sub {
98             my ($orig, $self, @args) = @_;
99             my $result = $self->$orig(@args);
100             return scalar deduce_deep $result;
101             };
102              
103             around 'exists' => sub {
104             my ($orig, $self, @args) = @_;
105             my $result = $self->$orig(@args);
106             return scalar deduce_deep $result;
107             };
108              
109             around 'first' => sub {
110             my ($orig, $self, @args) = @_;
111             my $result = $self->$orig(@args);
112             return scalar deduce_deep $result;
113             };
114              
115             around 'get' => sub {
116             my ($orig, $self, @args) = @_;
117             my $result = $self->$orig(@args);
118             return scalar deduce_deep $result;
119             };
120              
121             around 'grep' => sub {
122             my ($orig, $self, @args) = @_;
123             my $result = $self->$orig(@args);
124             return scalar deduce_deep $result;
125             };
126              
127             around 'hashify' => sub {
128             my ($orig, $self, @args) = @_;
129             my $result = $self->$orig(@args);
130             return scalar deduce_deep $result;
131             };
132              
133             around 'head' => sub {
134             my ($orig, $self, @args) = @_;
135             my $result = $self->$orig(@args);
136             return scalar deduce_deep $result;
137             };
138              
139             around 'iterator' => sub {
140             my ($orig, $self, @args) = @_;
141             my $result = $self->$orig(@args);
142             return scalar deduce_deep $result;
143             };
144              
145             around 'join' => sub {
146             my ($orig, $self, @args) = @_;
147             my $result = $self->$orig(@args);
148             return scalar deduce_deep $result;
149             };
150              
151             around 'keyed' => sub {
152             my ($orig, $self, @args) = @_;
153             my $result = $self->$orig(@args);
154             return scalar deduce_deep $result;
155             };
156              
157             around 'keys' => sub {
158             my ($orig, $self, @args) = @_;
159             my $result = $self->$orig(@args);
160             return scalar deduce_deep $result;
161             };
162              
163             around 'last' => sub {
164             my ($orig, $self, @args) = @_;
165             my $result = $self->$orig(@args);
166             return scalar deduce_deep $result;
167             };
168              
169             around 'length' => sub {
170             my ($orig, $self, @args) = @_;
171             my $result = $self->$orig(@args);
172             return scalar deduce_deep $result;
173             };
174              
175             sub list {
176 2     2 0 68 goto &values;
177             }
178              
179             around 'map' => sub {
180             my ($orig, $self, @args) = @_;
181             my $result = $self->$orig(@args);
182             return scalar deduce_deep $result;
183             };
184              
185             around 'max' => sub {
186             my ($orig, $self, @args) = @_;
187             my $result = $self->$orig(@args);
188             return scalar deduce_deep $result;
189             };
190              
191             around 'min' => sub {
192             my ($orig, $self, @args) = @_;
193             my $result = $self->$orig(@args);
194             return scalar deduce_deep $result;
195             };
196              
197             around 'none' => sub {
198             my ($orig, $self, @args) = @_;
199             my $result = $self->$orig(@args);
200             return scalar deduce_deep $result;
201             };
202              
203             around 'nsort' => sub {
204             my ($orig, $self, @args) = @_;
205             my $result = $self->$orig(@args);
206             return scalar deduce_deep $result;
207             };
208              
209             around 'one' => sub {
210             my ($orig, $self, @args) = @_;
211             my $result = $self->$orig(@args);
212             return scalar deduce_deep $result;
213             };
214              
215             around 'pairs' => sub {
216             my ($orig, $self, @args) = @_;
217             my $result = $self->$orig(@args);
218             return scalar deduce_deep $result;
219             };
220              
221             around 'pairs_array' => sub {
222             my ($orig, $self, @args) = @_;
223             my $result = $self->$orig(@args);
224             return scalar deduce_deep $result;
225             };
226              
227             around 'pairs_hash' => sub {
228             my ($orig, $self, @args) = @_;
229             my $result = $self->$orig(@args);
230             return scalar deduce_deep $result;
231             };
232              
233             around 'part' => sub {
234             my ($orig, $self, @args) = @_;
235             my $result = $self->$orig(@args);
236             return scalar deduce_deep $result;
237             };
238              
239             around 'pop' => sub {
240             my ($orig, $self, @args) = @_;
241             my $result = $self->$orig(@args);
242             return scalar deduce_deep $result;
243             };
244              
245             around 'push' => sub {
246             my ($orig, $self, @args) = @_;
247             my $result = $self->$orig(@args);
248             return scalar deduce_deep $result;
249             };
250              
251             around 'random' => sub {
252             my ($orig, $self, @args) = @_;
253             my $result = $self->$orig(@args);
254             return scalar deduce_deep $result;
255             };
256              
257             around 'reverse' => sub {
258             my ($orig, $self, @args) = @_;
259             my $result = $self->$orig(@args);
260             return scalar deduce_deep $result;
261             };
262              
263             around 'rnsort' => sub {
264             my ($orig, $self, @args) = @_;
265             my $result = $self->$orig(@args);
266             return scalar deduce_deep $result;
267             };
268              
269             around 'rotate' => sub {
270             my ($orig, $self, @args) = @_;
271             my $result = $self->$orig(@args);
272             return scalar deduce_deep $result;
273             };
274              
275             around 'rsort' => sub {
276             my ($orig, $self, @args) = @_;
277             my $result = $self->$orig(@args);
278             return scalar deduce_deep $result;
279             };
280              
281             around 'set' => sub {
282             my ($orig, $self, @args) = @_;
283             my $result = $self->$orig(@args);
284             return scalar deduce_deep $result;
285             };
286              
287             around 'shift' => sub {
288             my ($orig, $self, @args) = @_;
289             my $result = $self->$orig(@args);
290             return scalar deduce_deep $result;
291             };
292              
293             around 'size' => sub {
294             my ($orig, $self, @args) = @_;
295             my $result = $self->$orig(@args);
296             return scalar deduce_deep $result;
297             };
298              
299             around 'slice' => sub {
300             my ($orig, $self, @args) = @_;
301             my $result = $self->$orig(@args);
302             return scalar deduce_deep $result;
303             };
304              
305             around 'sort' => sub {
306             my ($orig, $self, @args) = @_;
307             my $result = $self->$orig(@args);
308             return scalar deduce_deep $result;
309             };
310              
311             around 'sum' => sub {
312             my ($orig, $self, @args) = @_;
313             my $result = $self->$orig(@args);
314             return scalar deduce_deep $result;
315             };
316              
317             around 'tail' => sub {
318             my ($orig, $self, @args) = @_;
319             my $result = $self->$orig(@args);
320             return scalar deduce_deep $result;
321             };
322              
323             around 'unique' => sub {
324             my ($orig, $self, @args) = @_;
325             my $result = $self->$orig(@args);
326             return scalar deduce_deep $result;
327             };
328              
329             around 'unshift' => sub {
330             my ($orig, $self, @args) = @_;
331             my $result = $self->$orig(@args);
332             return scalar deduce_deep $result;
333             };
334              
335             around 'values' => sub {
336             my ($orig, $self, @args) = @_;
337             my $result = deduce_deep $self->$orig(@args);
338             return wantarray ? (@$result) : $result;
339             };
340              
341             1;
342              
343             __END__