line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
5
|
|
|
5
|
|
81842
|
use 5.008001; |
|
5
|
|
|
|
|
25
|
|
2
|
5
|
|
|
5
|
|
25
|
use strict; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
96
|
|
3
|
5
|
|
|
5
|
|
22
|
use warnings; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
359
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package Data::Fake::Core; |
6
|
|
|
|
|
|
|
# ABSTRACT: General purpose generators |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '0.006'; |
9
|
|
|
|
|
|
|
|
10
|
5
|
|
|
5
|
|
33
|
use Exporter 5.57 qw/import/; |
|
5
|
|
|
|
|
84
|
|
|
5
|
|
|
|
|
425
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our @EXPORT = qw( |
13
|
|
|
|
|
|
|
fake_hash |
14
|
|
|
|
|
|
|
fake_array |
15
|
|
|
|
|
|
|
fake_flatten |
16
|
|
|
|
|
|
|
fake_pick |
17
|
|
|
|
|
|
|
fake_binomial |
18
|
|
|
|
|
|
|
fake_weighted |
19
|
|
|
|
|
|
|
fake_int |
20
|
|
|
|
|
|
|
fake_float |
21
|
|
|
|
|
|
|
fake_digits |
22
|
|
|
|
|
|
|
fake_template |
23
|
|
|
|
|
|
|
fake_join |
24
|
|
|
|
|
|
|
); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
our @EXPORT_OK = qw/_transform/; |
27
|
|
|
|
|
|
|
|
28
|
5
|
|
|
5
|
|
33
|
use Carp qw/croak/; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
390
|
|
29
|
5
|
|
|
5
|
|
33
|
use List::Util qw/sum/; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
7856
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
#pod =func fake_hash |
32
|
|
|
|
|
|
|
#pod |
33
|
|
|
|
|
|
|
#pod $generator = fake_hash( |
34
|
|
|
|
|
|
|
#pod { |
35
|
|
|
|
|
|
|
#pod name => fake_name, |
36
|
|
|
|
|
|
|
#pod pet => fake_pick(qw/dog cat frog/), |
37
|
|
|
|
|
|
|
#pod } |
38
|
|
|
|
|
|
|
#pod ); |
39
|
|
|
|
|
|
|
#pod |
40
|
|
|
|
|
|
|
#pod $generator = fake_hash( @hash_or_hash_generators ); |
41
|
|
|
|
|
|
|
#pod |
42
|
|
|
|
|
|
|
#pod The C function returns a code reference that, when run, |
43
|
|
|
|
|
|
|
#pod generates a hash reference. |
44
|
|
|
|
|
|
|
#pod |
45
|
|
|
|
|
|
|
#pod The simplest way to use it is to provide a hash reference with some values |
46
|
|
|
|
|
|
|
#pod replaced with C generator functions. When the generator runs, the |
47
|
|
|
|
|
|
|
#pod hash will be walked recursively and any code reference found will be |
48
|
|
|
|
|
|
|
#pod replaced with its output. |
49
|
|
|
|
|
|
|
#pod |
50
|
|
|
|
|
|
|
#pod If more than one argument is provided, when the generator runs, they will |
51
|
|
|
|
|
|
|
#pod be merged according to the following rules: |
52
|
|
|
|
|
|
|
#pod |
53
|
|
|
|
|
|
|
#pod =for :list |
54
|
|
|
|
|
|
|
#pod * code references will be replaced with their outputs |
55
|
|
|
|
|
|
|
#pod * after replacement, if any arguments aren't hash references, an exception |
56
|
|
|
|
|
|
|
#pod will be thrown |
57
|
|
|
|
|
|
|
#pod * hash references will be shallow-merged |
58
|
|
|
|
|
|
|
#pod |
59
|
|
|
|
|
|
|
#pod This merging allows for generating sections of hashes differently or |
60
|
|
|
|
|
|
|
#pod generating hashes that have missing keys (e.g. using L): |
61
|
|
|
|
|
|
|
#pod |
62
|
|
|
|
|
|
|
#pod # 25% of the time, generate a hash with a 'spouse' key |
63
|
|
|
|
|
|
|
#pod $factory = fake_hash( |
64
|
|
|
|
|
|
|
#pod { ... }, |
65
|
|
|
|
|
|
|
#pod fake_binomial( 0.25, { spouse => fake_name() }, {} ), |
66
|
|
|
|
|
|
|
#pod ); |
67
|
|
|
|
|
|
|
#pod |
68
|
|
|
|
|
|
|
#pod =cut |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub fake_hash { |
71
|
5
|
|
|
5
|
1
|
622
|
my (@parts) = @_; |
72
|
|
|
|
|
|
|
return sub { |
73
|
26
|
|
|
26
|
|
10311
|
my $result = {}; |
74
|
26
|
|
|
|
|
46
|
for my $next ( map { _transform($_) } @parts ) { |
|
28
|
|
|
|
|
51
|
|
75
|
28
|
50
|
|
|
|
66
|
croak "fake_hash can only merge hash references" |
76
|
|
|
|
|
|
|
unless ref($next) eq 'HASH'; |
77
|
28
|
|
|
|
|
57
|
@{$result}{ keys %$next } = @{$next}{ keys %$next }; |
|
28
|
|
|
|
|
74
|
|
|
28
|
|
|
|
|
56
|
|
78
|
|
|
|
|
|
|
} |
79
|
26
|
|
|
|
|
75
|
return $result; |
80
|
5
|
|
|
|
|
35
|
}; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
#pod =func fake_array |
84
|
|
|
|
|
|
|
#pod |
85
|
|
|
|
|
|
|
#pod $generator = fake_array( 5, fake_digits("###-###-####") ); |
86
|
|
|
|
|
|
|
#pod |
87
|
|
|
|
|
|
|
#pod The C takes a positive integer size and source argument and |
88
|
|
|
|
|
|
|
#pod returns a generator that returns an array reference with each element built |
89
|
|
|
|
|
|
|
#pod from the source. |
90
|
|
|
|
|
|
|
#pod |
91
|
|
|
|
|
|
|
#pod If the size is a code reference, it will be run and can set a different size |
92
|
|
|
|
|
|
|
#pod for every array generated: |
93
|
|
|
|
|
|
|
#pod |
94
|
|
|
|
|
|
|
#pod # arrays from size 1 to size 6 |
95
|
|
|
|
|
|
|
#pod $generator = fake_array( fake_int(1,6), fake_digits("###-###-###") ); |
96
|
|
|
|
|
|
|
#pod |
97
|
|
|
|
|
|
|
#pod If the source is a code reference, it will be run; if the source is a hash |
98
|
|
|
|
|
|
|
#pod or array reference, it will be recursively evaluated like C. |
99
|
|
|
|
|
|
|
#pod |
100
|
|
|
|
|
|
|
#pod =cut |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub fake_array { |
103
|
14
|
|
|
14
|
1
|
2850
|
my ( $size, $template ) = @_; |
104
|
|
|
|
|
|
|
return sub { |
105
|
79
|
|
|
79
|
|
110596
|
[ map { _transform($template) } 1 .. _transform($size) ]; |
|
194
|
|
|
|
|
293
|
|
106
|
14
|
|
|
|
|
56
|
}; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
#pod =func fake_pick |
110
|
|
|
|
|
|
|
#pod |
111
|
|
|
|
|
|
|
#pod $generator = fake_pick( qw/one two three/ ); |
112
|
|
|
|
|
|
|
#pod $generator = fake_pick( @generators ); |
113
|
|
|
|
|
|
|
#pod |
114
|
|
|
|
|
|
|
#pod Given literal values or code references, returns a generator that randomly |
115
|
|
|
|
|
|
|
#pod selects one of them with equal probability. If the choice is a code |
116
|
|
|
|
|
|
|
#pod reference, it will be run; if the choice is a hash or array reference, it |
117
|
|
|
|
|
|
|
#pod will be recursively evaluated like C or C would do. |
118
|
|
|
|
|
|
|
#pod |
119
|
|
|
|
|
|
|
#pod =cut |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub fake_pick { |
122
|
26
|
|
|
26
|
1
|
30635
|
my (@list) = @_; |
123
|
26
|
|
|
|
|
41
|
my $size = scalar @list; |
124
|
26
|
|
|
255
|
|
132
|
return sub { _transform( $list[ int( rand($size) ) ] ) }; |
|
255
|
|
|
|
|
9463
|
|
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
#pod =func fake_binomial |
128
|
|
|
|
|
|
|
#pod |
129
|
|
|
|
|
|
|
#pod $generator = fake_binomial( |
130
|
|
|
|
|
|
|
#pod 0.90, |
131
|
|
|
|
|
|
|
#pod { name => fake_name() }, # 90% likely |
132
|
|
|
|
|
|
|
#pod {}, # 10% likely |
133
|
|
|
|
|
|
|
#pod ); |
134
|
|
|
|
|
|
|
#pod |
135
|
|
|
|
|
|
|
#pod $generator = fake_binomial( $prob, $lte_outcome, $gt_outcome ); |
136
|
|
|
|
|
|
|
#pod |
137
|
|
|
|
|
|
|
#pod The C function takes a probability and two outcomes. The |
138
|
|
|
|
|
|
|
#pod probability (between 0 and 1.0) indicates the likelihood that the return |
139
|
|
|
|
|
|
|
#pod value will the first outcome. The rest of the time, the return value will |
140
|
|
|
|
|
|
|
#pod be the second outcome. If the outcome is a code reference, it will be run; |
141
|
|
|
|
|
|
|
#pod if the outcome is a hash or array reference, it will be recursively |
142
|
|
|
|
|
|
|
#pod evaluated like C or C would do. |
143
|
|
|
|
|
|
|
#pod |
144
|
|
|
|
|
|
|
#pod =cut |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub fake_binomial { |
147
|
2
|
|
|
2
|
1
|
6032
|
my ( $prob, $first, $second ) = @_; |
148
|
2
|
50
|
33
|
|
|
21
|
croak "fake_binomial probability must be between 0 and 1.0" |
|
|
|
33
|
|
|
|
|
149
|
|
|
|
|
|
|
unless defined($prob) && $prob >= 0 && $prob <= 1.0; |
150
|
|
|
|
|
|
|
return sub { |
151
|
6
|
100
|
|
6
|
|
49
|
return _transform( rand() <= $prob ? $first : $second ); |
152
|
2
|
|
|
|
|
13
|
}; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
#pod =func fake_weighted |
156
|
|
|
|
|
|
|
#pod |
157
|
|
|
|
|
|
|
#pod $generator = fake_weighted( |
158
|
|
|
|
|
|
|
#pod [ 'a_choice', 1 ], |
159
|
|
|
|
|
|
|
#pod [ 'ten_times_likely', 10 ], |
160
|
|
|
|
|
|
|
#pod [ $another_generator, 1 ], |
161
|
|
|
|
|
|
|
#pod ); |
162
|
|
|
|
|
|
|
#pod |
163
|
|
|
|
|
|
|
#pod Given a list of array references, each containing a value and a |
164
|
|
|
|
|
|
|
#pod non-negative weight, returns a generator that randomly selects a value |
165
|
|
|
|
|
|
|
#pod according to the relative weights. |
166
|
|
|
|
|
|
|
#pod |
167
|
|
|
|
|
|
|
#pod If the value is a code reference, it will be run; if it is a hash or array |
168
|
|
|
|
|
|
|
#pod reference, it will be recursively evaluated like C or C |
169
|
|
|
|
|
|
|
#pod would do. |
170
|
|
|
|
|
|
|
#pod |
171
|
|
|
|
|
|
|
#pod =cut |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub fake_weighted { |
174
|
2
|
|
|
2
|
1
|
4037
|
my (@list) = @_; |
175
|
|
|
|
0
|
|
|
return sub { } |
176
|
2
|
50
|
|
|
|
7
|
unless @list; |
177
|
|
|
|
|
|
|
|
178
|
2
|
50
|
|
|
|
7
|
if ( @list != grep { ref($_) eq 'ARRAY' } @list ) { |
|
6
|
|
|
|
|
16
|
|
179
|
0
|
|
|
|
|
0
|
croak("fake_weighted requires a list of array references"); |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
# normalize weights into cumulative probabilities |
183
|
2
|
|
|
|
|
5
|
my $sum = sum( 0, map { $_->[1] } @list ); |
|
6
|
|
|
|
|
15
|
|
184
|
2
|
|
|
|
|
5
|
my $max = 0; |
185
|
2
|
|
|
|
|
5
|
for my $s (@list) { |
186
|
6
|
|
|
|
|
13
|
$s->[1] = $max += $s->[1] / $sum; |
187
|
|
|
|
|
|
|
} |
188
|
2
|
|
|
|
|
5
|
my $last = pop @list; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
return sub { |
191
|
3
|
|
|
3
|
|
20
|
my $rand = rand(); |
192
|
3
|
|
|
|
|
5
|
for my $s (@list) { |
193
|
3
|
50
|
|
|
|
9
|
return _transform( $s->[0] ) if $rand <= $s->[1]; |
194
|
|
|
|
|
|
|
} |
195
|
0
|
|
|
|
|
0
|
return _transform( $last->[0] ); |
196
|
2
|
|
|
|
|
15
|
}; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
#pod =func fake_int |
200
|
|
|
|
|
|
|
#pod |
201
|
|
|
|
|
|
|
#pod $generator = fake_int(1, 6); |
202
|
|
|
|
|
|
|
#pod |
203
|
|
|
|
|
|
|
#pod Given a minimum and a maximum value as inputs, returns a generator that |
204
|
|
|
|
|
|
|
#pod will produce a random integer in that range. |
205
|
|
|
|
|
|
|
#pod |
206
|
|
|
|
|
|
|
#pod =cut |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub fake_int { |
209
|
34
|
|
|
34
|
1
|
25236
|
my ( $min, $max ) = map { int($_) } @_; |
|
68
|
|
|
|
|
141
|
|
210
|
34
|
50
|
33
|
|
|
142
|
croak "fake_int requires minimum and maximum" |
211
|
|
|
|
|
|
|
unless defined $min && defined $max; |
212
|
34
|
|
|
|
|
64
|
my $range = $max - $min + 1; |
213
|
|
|
|
|
|
|
return sub { |
214
|
144
|
|
|
144
|
|
16793
|
return $min + int( rand($range) ); |
215
|
34
|
|
|
|
|
163
|
}; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
#pod =func fake_float |
219
|
|
|
|
|
|
|
#pod |
220
|
|
|
|
|
|
|
#pod $generator = fake_float(1.0, 6.0); |
221
|
|
|
|
|
|
|
#pod |
222
|
|
|
|
|
|
|
#pod Given a minimum and a maximum value as inputs, returns a generator that |
223
|
|
|
|
|
|
|
#pod will produce a random floating point value in that range. |
224
|
|
|
|
|
|
|
#pod |
225
|
|
|
|
|
|
|
#pod =cut |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sub fake_float { |
228
|
13
|
|
|
13
|
1
|
6817
|
my ( $min, $max ) = @_; |
229
|
13
|
50
|
33
|
|
|
78
|
croak "fake_float requires minimum and maximum" |
230
|
|
|
|
|
|
|
unless defined $min && defined $max; |
231
|
13
|
|
|
|
|
28
|
my $range = $max - $min; |
232
|
|
|
|
|
|
|
return sub { |
233
|
55
|
|
|
55
|
|
12274
|
return $min + rand($range); |
234
|
13
|
|
|
|
|
57
|
}; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
#pod =func fake_digits |
238
|
|
|
|
|
|
|
#pod |
239
|
|
|
|
|
|
|
#pod $generator = fake_digits('###-####'); # "555-1234" |
240
|
|
|
|
|
|
|
#pod $generator = fake_digits('\###'); # "#12" |
241
|
|
|
|
|
|
|
#pod |
242
|
|
|
|
|
|
|
#pod Given a text pattern, returns a generator that replaces all occurrences of |
243
|
|
|
|
|
|
|
#pod the sharp character (C<#>) with a randomly selected digit. To have a |
244
|
|
|
|
|
|
|
#pod literal sharp character, escape it with a backslash (do it in a |
245
|
|
|
|
|
|
|
#pod single-quoted string to avoid having to double your backslash to get a |
246
|
|
|
|
|
|
|
#pod backslash in the string.). |
247
|
|
|
|
|
|
|
#pod |
248
|
|
|
|
|
|
|
#pod Use this for phone numbers, currencies, or whatever else needs random |
249
|
|
|
|
|
|
|
#pod digits: |
250
|
|
|
|
|
|
|
#pod |
251
|
|
|
|
|
|
|
#pod fake_digits('###-##-####'); # US Social Security Number |
252
|
|
|
|
|
|
|
#pod fake_digits('(###) ###-####'); # (800) 555-1212 |
253
|
|
|
|
|
|
|
#pod |
254
|
|
|
|
|
|
|
#pod =cut |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
my $DIGIT_RE = qr/(?
|
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
sub fake_digits { |
259
|
5
|
|
|
5
|
1
|
4736
|
my ($template) = @_; |
260
|
|
|
|
|
|
|
return sub { |
261
|
5
|
|
|
5
|
|
9
|
my $copy = $template; |
262
|
5
|
|
|
|
|
39
|
1 while $copy =~ s{$DIGIT_RE}{int(rand(10))}e; |
|
24
|
|
|
|
|
135
|
|
263
|
5
|
|
|
|
|
13
|
$copy =~ s{\\#}{#}g; |
264
|
5
|
|
|
|
|
15
|
return $copy; |
265
|
5
|
|
|
|
|
28
|
}; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
#pod =func fake_template |
269
|
|
|
|
|
|
|
#pod |
270
|
|
|
|
|
|
|
#pod $generator = fake_template("Hello, %s", fake_name()); |
271
|
|
|
|
|
|
|
#pod |
272
|
|
|
|
|
|
|
#pod Given a sprintf-style text pattern and a list of generators, returns a |
273
|
|
|
|
|
|
|
#pod generator that, when run, executes the generators and returns the string |
274
|
|
|
|
|
|
|
#pod populated with the output. |
275
|
|
|
|
|
|
|
#pod |
276
|
|
|
|
|
|
|
#pod Use this for creating custom generators from other generators. |
277
|
|
|
|
|
|
|
#pod |
278
|
|
|
|
|
|
|
#pod =cut |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
sub fake_template { |
281
|
24
|
|
|
24
|
1
|
57
|
my ( $template, @args ) = @_; |
282
|
|
|
|
|
|
|
return sub { |
283
|
12
|
|
|
12
|
|
36
|
return sprintf( $template, map { _transform($_) } @args ); |
|
30
|
|
|
|
|
55
|
|
284
|
24
|
|
|
|
|
94
|
}; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
#pod =func fake_join |
288
|
|
|
|
|
|
|
#pod |
289
|
|
|
|
|
|
|
#pod $generator = fake_join(" ", fake_first_name(), fake_surname() ); |
290
|
|
|
|
|
|
|
#pod |
291
|
|
|
|
|
|
|
#pod Given a character to join on a list of literals or generators, returns a |
292
|
|
|
|
|
|
|
#pod generator that, when run, executes any generators and returns them concatenated |
293
|
|
|
|
|
|
|
#pod together, separated by the separator character. |
294
|
|
|
|
|
|
|
#pod |
295
|
|
|
|
|
|
|
#pod The separator itself may also be a generator if you want that degree of |
296
|
|
|
|
|
|
|
#pod randomness as well. |
297
|
|
|
|
|
|
|
#pod |
298
|
|
|
|
|
|
|
#pod $generator = fake_join( fake_pick( q{}, q{ }, q{,} ), @args ); |
299
|
|
|
|
|
|
|
#pod |
300
|
|
|
|
|
|
|
#pod =cut |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub fake_join { |
303
|
2
|
|
|
2
|
1
|
686
|
my ( $char, @args ) = @_; |
304
|
|
|
|
|
|
|
return sub { |
305
|
2
|
|
|
2
|
|
10
|
return join( _transform($char), map { _transform($_) } @args ); |
|
3
|
|
|
|
|
7
|
|
306
|
2
|
|
|
|
|
11
|
}; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
#pod =func fake_flatten |
310
|
|
|
|
|
|
|
#pod |
311
|
|
|
|
|
|
|
#pod $flatten_generator = fake_flatten( fake_array( 3, fake_first_name() ) ); |
312
|
|
|
|
|
|
|
#pod @array_of_names = $flatten_generator->(); |
313
|
|
|
|
|
|
|
#pod |
314
|
|
|
|
|
|
|
#pod Given a generator that returns an array ref (such as fake_array) or a |
315
|
|
|
|
|
|
|
#pod hash ref (fake_hash), fake_flatten returns a generator that, when run, |
316
|
|
|
|
|
|
|
#pod executes the generators and returns their result in a dereferenced state. |
317
|
|
|
|
|
|
|
#pod |
318
|
|
|
|
|
|
|
#pod This is particularly useful when the return value is used directly as |
319
|
|
|
|
|
|
|
#pod input to another function, for example within a fake_join. |
320
|
|
|
|
|
|
|
#pod |
321
|
|
|
|
|
|
|
#pod $generator = fake_join( " ", $flatten_generator ); |
322
|
|
|
|
|
|
|
#pod |
323
|
|
|
|
|
|
|
#pod =cut |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
sub fake_flatten { |
326
|
7
|
|
|
7
|
1
|
6010
|
my ($ref) = @_; |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
return sub { |
329
|
12
|
|
|
12
|
|
2701
|
my $result = _transform($ref); |
330
|
12
|
|
|
|
|
27
|
my $result_ref = ref($result); |
331
|
12
|
100
|
|
|
|
31
|
if ( $result_ref eq 'ARRAY' ) { |
|
|
50
|
|
|
|
|
|
332
|
7
|
|
|
|
|
26
|
return @$result; |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
elsif ( $result_ref eq 'HASH' ) { |
335
|
5
|
|
|
|
|
23
|
return %$result; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
|
338
|
0
|
|
|
|
|
0
|
croak "I do not know how to flatten a $result_ref"; |
339
|
|
|
|
|
|
|
} |
340
|
7
|
|
|
|
|
33
|
} |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
sub _transform { |
343
|
648
|
|
|
648
|
|
990
|
my ($template) = @_; |
344
|
|
|
|
|
|
|
|
345
|
648
|
|
|
|
|
973
|
my $type = ref($template); |
346
|
|
|
|
|
|
|
|
347
|
648
|
100
|
|
|
|
1338
|
if ( $type eq 'CODE' ) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
348
|
319
|
|
|
|
|
490
|
return $template->(); |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
elsif ( $type eq 'HASH' ) { |
351
|
38
|
|
|
|
|
51
|
my $copy = {}; |
352
|
38
|
|
|
|
|
116
|
while ( my ( $k, $v ) = each %$template ) { |
353
|
65
|
50
|
|
|
|
174
|
$copy->{$k} = |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
354
|
|
|
|
|
|
|
ref($v) eq 'CODE' ? $v->() |
355
|
|
|
|
|
|
|
: ref($v) eq 'HASH' ? _transform($v) |
356
|
|
|
|
|
|
|
: ref($v) eq 'ARRAY' ? _transform($v) |
357
|
|
|
|
|
|
|
: $v; |
358
|
|
|
|
|
|
|
} |
359
|
38
|
|
|
|
|
99
|
return $copy; |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
elsif ( $type eq 'ARRAY' ) { |
362
|
|
|
|
|
|
|
my @copy = map { |
363
|
0
|
0
|
|
|
|
0
|
ref $_ eq 'CODE' ? $_->() |
|
0
|
0
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
|
364
|
|
|
|
|
|
|
: ref $_ eq 'HASH' ? _transform($_) |
365
|
|
|
|
|
|
|
: ref $_ eq 'ARRAY' ? _transform($_) |
366
|
|
|
|
|
|
|
: $_; |
367
|
|
|
|
|
|
|
} @$template; |
368
|
0
|
|
|
|
|
0
|
return \@copy; |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
else { |
371
|
|
|
|
|
|
|
# literal value |
372
|
291
|
|
|
|
|
857
|
return $template; |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
1; |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
# vim: ts=4 sts=4 sw=4 et tw=75: |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
__END__ |