line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package List::Tuples ; |
3
|
|
|
|
|
|
|
|
4
|
1
|
|
|
1
|
|
82349
|
use strict; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
48
|
|
5
|
1
|
|
|
1
|
|
6
|
use warnings ; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
61
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
BEGIN |
8
|
|
|
|
|
|
|
{ |
9
|
1
|
|
|
|
|
13
|
use Sub::Exporter -setup => |
10
|
|
|
|
|
|
|
{ |
11
|
|
|
|
|
|
|
exports => [ qw(tuples hash_tuples ref_mesh) ], |
12
|
|
|
|
|
|
|
groups => |
13
|
|
|
|
|
|
|
{ |
14
|
|
|
|
|
|
|
all => [ qw(tuples hash_tuples ref_mesh) ], |
15
|
|
|
|
|
|
|
} |
16
|
1
|
|
|
1
|
|
1198
|
}; |
|
1
|
|
|
|
|
45300
|
|
17
|
|
|
|
|
|
|
|
18
|
1
|
|
|
1
|
|
575
|
use vars qw ($VERSION); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
54
|
|
19
|
1
|
|
|
1
|
|
18
|
$VERSION = '0.04' ; |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
#------------------------------------------------------------------------------- |
23
|
|
|
|
|
|
|
|
24
|
1
|
|
|
1
|
|
1379
|
use Readonly ; |
|
1
|
|
|
|
|
5663
|
|
|
1
|
|
|
|
|
68
|
|
25
|
1
|
|
|
1
|
|
1216
|
use Carp::Diagnostics qw(cluck carp croak confess) ; |
|
1
|
|
|
|
|
2153506
|
|
|
1
|
|
|
|
|
10
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
#------------------------------------------------------------------------------- |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head1 NAME |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
List::Tuples - Makes tuples from lists |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=head1 SYNOPSIS |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
use List::Tuples qw(:all) ; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
my @tuples = tuples[2] => (1 .. 6) ; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# is equivalent to: |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
my @tuples = |
42
|
|
|
|
|
|
|
( |
43
|
|
|
|
|
|
|
[1, 2], |
44
|
|
|
|
|
|
|
[3, 4], |
45
|
|
|
|
|
|
|
[5, 6], |
46
|
|
|
|
|
|
|
) ; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
#------------------------------------------------------- |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
my @meshed_list = ref_mesh([1 .. 3], ['a' .. 'b'], ['*']) ; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
# is equivalent to: |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
my @meshed_list = (1, 'a', '*', 2, 'b', undef, 3, undef, undef) ; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
#------------------------------------------------------- |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
my @hashes = hash_tuples ['key', 'other_key'] => (1 .. 5) ; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# is equivalent to : |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
my @hashes = |
63
|
|
|
|
|
|
|
( |
64
|
|
|
|
|
|
|
{key => 1, other_key => 2}, |
65
|
|
|
|
|
|
|
{key => 3, other_key => 4}, |
66
|
|
|
|
|
|
|
{key => 5, other_key => undef}, |
67
|
|
|
|
|
|
|
) ; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 DESCRIPTION |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
This module defines subroutines that let you create tuples. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head1 DOCUMENTATION |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
Ever got frustrated that you couldn't easily get tuples into map{} or |
76
|
|
|
|
|
|
|
create multiple hashes from an ordered list? |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
Jonathan Scott in In "Everyday Perl 6" L writes: |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
# Perl 6 # Perl 5 |
81
|
|
|
|
|
|
|
for @array -> $a { ... } for my $a (@array) { ... } |
82
|
|
|
|
|
|
|
for @array -> $a, $b { ... } # too complex :) |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
The following subroutines will simplify your job. They could certainly be more effective implemented |
85
|
|
|
|
|
|
|
directly in the language, IE in Perl6. If you have millions of tuples to handle, you may want monitor memory usage. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head1 SUBROUTINES |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=cut |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
#---------------------------------------------------------------------- |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub tuples |
94
|
|
|
|
|
|
|
{ |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=head2 tuples([$limit], \@size, @list) |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
B will extract B<$size> elements from B<@lists> and group them in an array reference. |
99
|
|
|
|
|
|
|
It will extract as many tuples as possible up to the, optional, B<$limit> you pass as argument. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
tuples 3 => [2] => (1 .. 14); # 3 tuples with 2 elements are returned |
102
|
|
|
|
|
|
|
tuples[2] => (1 .. 14); # 7 tuples with 2 elements are returned |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
for my $tuple (tuples[2] => @array) |
105
|
|
|
|
|
|
|
{ |
106
|
|
|
|
|
|
|
print "[$tuple->[0], $tuple->[1]]\n" ; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
B |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=over 2 |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=item * $limit - an optional maximum number of tuples to create |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=item * \@size - an array reference containing the number of elements in a tuple |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=item * @list - a list to be split into tuples |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=back |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
B |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=over 2 |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=item * A list of tuples (array references) |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=back |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=head3 Input list with insufficient elements |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
my @tuples = tuples[2] => (1 .. 3)) ; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
# is equivalent to: |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
my @tuples = |
137
|
|
|
|
|
|
|
( |
138
|
|
|
|
|
|
|
[1, 2], |
139
|
|
|
|
|
|
|
[3], |
140
|
|
|
|
|
|
|
) ; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=head3 Diagnostics |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=cut |
145
|
|
|
|
|
|
|
|
146
|
0
|
|
|
0
|
1
|
|
my ($limit, $size, @array) = @_ ; |
147
|
|
|
|
|
|
|
|
148
|
0
|
0
|
|
|
|
|
if ('ARRAY' eq ref $limit) |
149
|
|
|
|
|
|
|
{ |
150
|
|
|
|
|
|
|
# handle optional limit |
151
|
0
|
0
|
|
|
|
|
unshift @array, $size if defined $size ; |
152
|
0
|
|
|
|
|
|
$size = $limit ; |
153
|
0
|
|
|
|
|
|
$limit = undef ; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
0
|
|
|
|
|
|
my $number_of_tuples = 0 ; |
157
|
|
|
|
|
|
|
|
158
|
0
|
0
|
|
|
|
|
if('ARRAY' eq ref $size) |
159
|
|
|
|
|
|
|
{ |
160
|
0
|
|
|
|
|
|
$size = $size->[0] ; |
161
|
|
|
|
|
|
|
|
162
|
0
|
0
|
|
|
|
|
if(defined $size) |
163
|
|
|
|
|
|
|
{ |
164
|
0
|
0
|
|
|
|
|
if($size > 0) |
165
|
|
|
|
|
|
|
{ |
166
|
0
|
|
|
|
|
|
$number_of_tuples = @array / $size ; |
167
|
0
|
0
|
|
|
|
|
$number_of_tuples++ if @array % $size ; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
else |
170
|
|
|
|
|
|
|
{ |
171
|
0
|
|
|
|
|
|
confess |
172
|
|
|
|
|
|
|
( |
173
|
|
|
|
|
|
|
'Error: List::Tuples::tuples expects tuple size to be positive!', |
174
|
|
|
|
|
|
|
<<'END_OF_POD', |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=over |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=item * Error: List::Tuples::tuples expects tuple size to be positive! |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
example: |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
my @tuples = tuples[2] => @list ; |
183
|
|
|
|
|
|
|
^ |
184
|
|
|
|
|
|
|
`- size must be positive |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=back |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=cut |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
END_OF_POD |
191
|
|
|
|
|
|
|
) ; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
else |
195
|
|
|
|
|
|
|
{ |
196
|
0
|
|
|
|
|
|
confess |
197
|
|
|
|
|
|
|
( |
198
|
|
|
|
|
|
|
'Error: List::Tuples::tuples expects a tuple size!', |
199
|
|
|
|
|
|
|
<<'END_OF_POD', |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=over |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
=item * Error: List::Tuples::tuples expects a tuple size! |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
example: |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
my @tuples = tuples[2] => @list ; |
208
|
|
|
|
|
|
|
^ |
209
|
|
|
|
|
|
|
`- size must be defined |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=back |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=cut |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
END_OF_POD |
216
|
|
|
|
|
|
|
) ; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
0
|
0
|
|
|
|
|
if(defined $limit) |
220
|
|
|
|
|
|
|
{ |
221
|
0
|
0
|
|
|
|
|
if($limit > 0) |
222
|
|
|
|
|
|
|
{ |
223
|
0
|
0
|
|
|
|
|
$number_of_tuples = $number_of_tuples > $limit ? $limit : $number_of_tuples ; |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
else |
226
|
|
|
|
|
|
|
{ |
227
|
0
|
|
|
|
|
|
confess |
228
|
|
|
|
|
|
|
( |
229
|
|
|
|
|
|
|
'Error: List::Tuples::tuples expects tuple limit to be positive!', |
230
|
|
|
|
|
|
|
<<'END_OF_POD', |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=over |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=item * Error: List::Tuples::tuples expects tuple limit to be positive ! |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
example: |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
my @tuples = tuples 3 => [2] => @list ; |
239
|
|
|
|
|
|
|
^ |
240
|
|
|
|
|
|
|
`- limit must be positive |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=back |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=cut |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
END_OF_POD |
247
|
|
|
|
|
|
|
) ; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
else |
252
|
|
|
|
|
|
|
{ |
253
|
0
|
|
|
|
|
|
confess |
254
|
|
|
|
|
|
|
( |
255
|
|
|
|
|
|
|
'Error: List::Tuples::tuples expects an array reference as size argument!', |
256
|
|
|
|
|
|
|
<<'END_OF_POD', |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=over |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=item * Error: List::Tuples::tuples expects an array reference as size argument! |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
example: |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
my @tuples = tuples[2] => @list ; |
265
|
|
|
|
|
|
|
^ |
266
|
|
|
|
|
|
|
`- size must be in an array reference |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=back |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
=cut |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
END_OF_POD |
273
|
|
|
|
|
|
|
) ; |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
0
|
0
|
|
|
|
|
if(@array) |
277
|
|
|
|
|
|
|
{ |
278
|
|
|
|
|
|
|
return |
279
|
|
|
|
|
|
|
( |
280
|
0
|
|
|
|
|
|
map{[splice(@array, 0, $size)] } (1 .. $number_of_tuples) |
|
0
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
) ; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
else |
284
|
|
|
|
|
|
|
{ |
285
|
0
|
|
|
|
|
|
return ; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------- |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
sub ref_mesh |
293
|
|
|
|
|
|
|
{ |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=head2 ref_mesh(\@array1, \@array2, ...) |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
Mixes elements from arrays, one element at the time. |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
my @list = |
300
|
|
|
|
|
|
|
ref_mesh |
301
|
|
|
|
|
|
|
['mum1', 'mum2', 'mum3'], |
302
|
|
|
|
|
|
|
['dad1', 'dad2'], |
303
|
|
|
|
|
|
|
[['child1_1', 'child1_2'], [], ['child3_1']] ; |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# is equivalent to : |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
my @list = |
308
|
|
|
|
|
|
|
( |
309
|
|
|
|
|
|
|
'mum1', |
310
|
|
|
|
|
|
|
'dad1', |
311
|
|
|
|
|
|
|
[child1_1, 'child1_2'], |
312
|
|
|
|
|
|
|
'mum2', |
313
|
|
|
|
|
|
|
'dad2', |
314
|
|
|
|
|
|
|
[], |
315
|
|
|
|
|
|
|
'mum3', |
316
|
|
|
|
|
|
|
'undef, |
317
|
|
|
|
|
|
|
[child3_1] |
318
|
|
|
|
|
|
|
) ; |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
This is equivalent to B from L except the fact it takes arrays references instead for lists. |
321
|
|
|
|
|
|
|
The implementation is directly taken from L. |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
B |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
=over 2 |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=item * a list of array reference |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=back |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
B |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
=over 2 |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
=item * a list consisting of the first elements of each array reference, then the second, then the third, etc, until all arrays are exhausted |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=back |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
=head3 Diagnostics |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=cut |
342
|
|
|
|
|
|
|
|
343
|
0
|
|
|
0
|
1
|
|
my (@array_references) = @_ ; |
344
|
|
|
|
|
|
|
|
345
|
0
|
|
|
|
|
|
Readonly my $INVALID_MAXIMUM_VALUE => -1 ; |
346
|
|
|
|
|
|
|
|
347
|
0
|
|
|
|
|
|
my $max = $INVALID_MAXIMUM_VALUE ; |
348
|
0
|
|
|
|
|
|
my $index = 0 ; |
349
|
|
|
|
|
|
|
|
350
|
0
|
|
|
|
|
|
for my $array_ref (@array_references) |
351
|
|
|
|
|
|
|
{ |
352
|
0
|
0
|
|
|
|
|
confess |
353
|
|
|
|
|
|
|
( |
354
|
|
|
|
|
|
|
"Error: List::Tuples::ref_mesh: element '$index' is not an array reference!", |
355
|
|
|
|
|
|
|
<<"END_OF_POD", |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
=over |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=item * Error: List::Tuples::ref_mesh: element '$index' is not an array reference! |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
example: |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
my \@list = ref_mesh([1, 2], [5, 10], [10, 20], ...) ; |
364
|
|
|
|
|
|
|
^ |
365
|
|
|
|
|
|
|
`- arguments must be array references |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
=back |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
=cut |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
END_OF_POD |
372
|
|
|
|
|
|
|
) unless 'ARRAY' eq ref $array_ref ; |
373
|
|
|
|
|
|
|
|
374
|
0
|
0
|
|
|
|
|
$max < $#{$array_ref} && ($max = $#{$array_ref} ) ; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
|
376
|
0
|
|
|
|
|
|
$index++ ; |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
return |
380
|
|
|
|
|
|
|
( |
381
|
0
|
|
|
|
|
|
map |
382
|
|
|
|
|
|
|
{ |
383
|
0
|
|
|
|
|
|
my $ix = $_ ; |
384
|
0
|
|
|
|
|
|
map {$_->[$ix]} |
|
0
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
@array_references |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
0..$max |
388
|
|
|
|
|
|
|
) ; |
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------- |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
sub hash_tuples |
394
|
|
|
|
|
|
|
{ |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
=head2 hash_tuples([$limit], \@hash_keys, @input_array) |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
B uses elements from \@input_array and combine them with \@hash_keys to create hash references. |
399
|
|
|
|
|
|
|
It will create as many hashes as possible up to the, optional, $limit. |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
my @hashes = |
402
|
|
|
|
|
|
|
hash_tuples |
403
|
|
|
|
|
|
|
['Mum', 'Dad', 'Children'] => |
404
|
|
|
|
|
|
|
'Lena', 'Nadim', ['Yasmin', 'Miriam'], |
405
|
|
|
|
|
|
|
'Monika', 'ola', ['astrid'] ; |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
# is equivalent to: |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
my @hashes = |
410
|
|
|
|
|
|
|
( |
411
|
|
|
|
|
|
|
{ |
412
|
|
|
|
|
|
|
'Mum' => 'Lena', |
413
|
|
|
|
|
|
|
'Children' => ['Yasmin','Miriam'], |
414
|
|
|
|
|
|
|
'Dad' => 'Nadim' |
415
|
|
|
|
|
|
|
}, |
416
|
|
|
|
|
|
|
{ |
417
|
|
|
|
|
|
|
'Mum' => 'Monika', |
418
|
|
|
|
|
|
|
'Children' => ['astrid'], |
419
|
|
|
|
|
|
|
'Dad' => 'ola' |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
) ; |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
for my $tuple (hash_tuples(['a', 'b'] => @array)) |
425
|
|
|
|
|
|
|
{ |
426
|
|
|
|
|
|
|
print $tuple->{a} . "\n" ; |
427
|
|
|
|
|
|
|
print $tuple->{b} . "\n" ; |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
B |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
=over 2 |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
=item * $limit - an optional maximum number of hashes to create |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
=item * \@hash_keys - an array reference containing the list of keys apply to the input array |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
=item * \@input_array- an array reference. the array contains the elements to extract |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
=back |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
B |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=over 2 |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
=item * A list of hashes |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
=back |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
=head3 Diagnostics |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=cut |
453
|
|
|
|
|
|
|
|
454
|
0
|
|
|
0
|
1
|
|
my ($limit, $hash_keys, @input_array) = @_ ; |
455
|
|
|
|
|
|
|
|
456
|
0
|
0
|
|
|
|
|
if ('ARRAY' eq ref $limit) |
457
|
|
|
|
|
|
|
{ |
458
|
0
|
0
|
|
|
|
|
unshift @input_array, $hash_keys if defined $hash_keys ; |
459
|
0
|
|
|
|
|
|
$hash_keys = $limit ; |
460
|
0
|
|
|
|
|
|
$limit = undef ; |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
|
463
|
0
|
0
|
|
|
|
|
if('ARRAY' eq ref $hash_keys) |
464
|
|
|
|
|
|
|
{ |
465
|
0
|
0
|
|
|
|
|
unless(@{$hash_keys}) |
|
0
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
{ |
467
|
0
|
|
|
|
|
|
confess |
468
|
|
|
|
|
|
|
( |
469
|
|
|
|
|
|
|
'Error: List::Tuples::hash_tuples expects at least one key in the key list!', |
470
|
|
|
|
|
|
|
<<'END_OF_POD', |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
=over |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
=item * Error: List::Tuples::hash_tuples expects at least one key in the key list! |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
example: |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
my @hashes = hash_tuples['Mum', 'Dad', 'Children'] => @list ; |
479
|
|
|
|
|
|
|
^ |
480
|
|
|
|
|
|
|
`- key list must contain at least one keys |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
=back |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
=cut |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
END_OF_POD |
487
|
|
|
|
|
|
|
) ; |
488
|
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
|
490
|
0
|
0
|
|
|
|
|
if(defined $limit) |
491
|
|
|
|
|
|
|
{ |
492
|
0
|
0
|
|
|
|
|
if($limit <= 0) |
493
|
|
|
|
|
|
|
{ |
494
|
0
|
|
|
|
|
|
confess |
495
|
|
|
|
|
|
|
( |
496
|
|
|
|
|
|
|
'Error: List::Tuples::hash_tuples expects tuple limit to be positive!', |
497
|
|
|
|
|
|
|
<<'END_OF_POD', |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
=over |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
=item * Error: List::Tuples::hash_tuples expects tuple limit to be positive! |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
example: |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
my @hashes = hash_tuples 3 => ['Mum', 'Dad', 'Children'] => @list ; |
506
|
|
|
|
|
|
|
^ |
507
|
|
|
|
|
|
|
`- limit must be positive |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=back |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
=cut |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
END_OF_POD |
514
|
|
|
|
|
|
|
) ; |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
else |
519
|
|
|
|
|
|
|
{ |
520
|
0
|
|
|
|
|
|
confess |
521
|
|
|
|
|
|
|
( |
522
|
|
|
|
|
|
|
'Error: List::Tuples::hash_tuples expects an array reference to define the keys!', |
523
|
|
|
|
|
|
|
<<'END_OF_POD', |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
=over |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
=item * Error: List::Tuples::hash_tuples expects an array reference to define the keys! |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
example: |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
my @hashes = hash_tuples ['Mum', 'Dad', 'Children'] => @list ; |
532
|
|
|
|
|
|
|
^ |
533
|
|
|
|
|
|
|
`- key list must be an array reference |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
=back |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
=cut |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
END_OF_POD |
540
|
|
|
|
|
|
|
) ; |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
|
543
|
0
|
0
|
|
|
|
|
if(@input_array) |
544
|
|
|
|
|
|
|
{ |
545
|
|
|
|
|
|
|
return |
546
|
|
|
|
|
|
|
( |
547
|
0
|
|
|
|
|
|
map |
548
|
|
|
|
|
|
|
{ |
549
|
0
|
|
|
|
|
|
{ |
550
|
|
|
|
|
|
|
ref_mesh($hash_keys => $_) |
551
|
|
|
|
|
|
|
} |
552
|
|
|
|
|
|
|
} |
553
|
0
|
|
|
|
|
|
tuples $limit => [scalar(@{$hash_keys})] => @input_array |
554
|
|
|
|
|
|
|
) ; |
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
else |
557
|
|
|
|
|
|
|
{ |
558
|
0
|
|
|
|
|
|
return ; |
559
|
|
|
|
|
|
|
} |
560
|
|
|
|
|
|
|
} |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
#------------------------------------------------------------------------------------------------------------- |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
1 ; |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
None so far. |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
=head1 AUTHOR |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
Khemir Nadim ibn Hamouda |
574
|
|
|
|
|
|
|
CPAN ID: NKH |
575
|
|
|
|
|
|
|
mailto:nadim@khemir.net |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
This program is free software; you can redistribute |
580
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself. |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
=head1 SUPPORT |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
perldoc List::Tuples |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
You can also look for information at: |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
=over 4 |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
L |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
Please report any bugs or feature requests to L . |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
We will be notified, and then you'll automatically be notified of progress on |
601
|
|
|
|
|
|
|
your bug as we make changes. |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
=item * Search CPAN |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
L |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
=back |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
=head1 SEE ALSO |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
L |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
=cut |