line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::Transform::ExplicitMetadata; |
2
|
|
|
|
|
|
|
|
3
|
5
|
|
|
5
|
|
2659
|
use strict; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
133
|
|
4
|
5
|
|
|
5
|
|
19
|
use warnings; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
128
|
|
5
|
|
|
|
|
|
|
|
6
|
5
|
|
|
5
|
|
18
|
use Scalar::Util; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
271
|
|
7
|
5
|
|
|
5
|
|
2532
|
use Symbol; |
|
5
|
|
|
|
|
3967
|
|
|
5
|
|
|
|
|
351
|
|
8
|
5
|
|
|
5
|
|
27
|
use Carp; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
349
|
|
9
|
5
|
|
|
5
|
|
23
|
use Fcntl qw(F_GETFL O_WRONLY O_RDWR O_APPEND); |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
339
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = "0.07"; |
12
|
|
|
|
|
|
|
|
13
|
5
|
|
|
5
|
|
25
|
use base 'Exporter'; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
8872
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our @EXPORT_OK = qw( encode decode ); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
our $HAS_FMODE; |
18
|
|
|
|
|
|
|
BEGIN { |
19
|
5
|
|
50
|
5
|
|
13
|
$HAS_FMODE = eval { require FileHandle::Fmode } || ''; |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub _get_open_mode_filehandle_fmode { |
23
|
0
|
|
|
0
|
|
0
|
my $fh = shift; |
24
|
|
|
|
|
|
|
|
25
|
0
|
0
|
|
|
|
0
|
return unless FileHandle::Fmode::is_FH($fh); |
26
|
|
|
|
|
|
|
|
27
|
0
|
|
|
|
|
0
|
my $is_append = FileHandle::Fmode::is_A($fh); |
28
|
0
|
0
|
|
|
|
0
|
if (FileHandle::Fmode::is_WO($fh)) { |
|
|
0
|
|
|
|
|
|
29
|
0
|
0
|
|
|
|
0
|
return $is_append ? '>>' : '>'; |
30
|
|
|
|
|
|
|
} elsif (FileHandle::Fmode::is_RW($fh)) { |
31
|
0
|
0
|
|
|
|
0
|
return $is_append ? '+>>' : '+<'; |
32
|
|
|
|
|
|
|
} else { |
33
|
0
|
|
|
|
|
0
|
return '<'; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub _get_open_mode_fcntl { |
38
|
7
|
|
|
7
|
|
8
|
my $fh = shift; |
39
|
|
|
|
|
|
|
|
40
|
5
|
|
|
5
|
|
9306
|
my $flags = eval { no warnings 'uninitialized'; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
7973
|
|
|
7
|
|
|
|
|
10
|
|
41
|
7
|
|
|
|
|
44
|
fcntl($fh, F_GETFL, my $junk) }; |
42
|
7
|
50
|
|
|
|
15
|
return unless $flags; |
43
|
|
|
|
|
|
|
|
44
|
7
|
|
|
|
|
12
|
my $is_append = $flags & O_APPEND; |
45
|
7
|
100
|
|
|
|
22
|
if ($flags & O_WRONLY) { |
|
|
100
|
|
|
|
|
|
46
|
3
|
100
|
|
|
|
19
|
return $is_append ? '>>' : '>'; |
47
|
|
|
|
|
|
|
} elsif ($flags & O_RDWR) { |
48
|
2
|
100
|
|
|
|
7
|
return $is_append ? '+>>' : '+<'; |
49
|
|
|
|
|
|
|
} else { |
50
|
2
|
|
|
|
|
13
|
return '<'; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub _get_open_mode { |
55
|
7
|
|
|
7
|
|
8
|
my $fh = shift; |
56
|
|
|
|
|
|
|
|
57
|
7
|
|
33
|
|
|
16
|
return _get_open_mode_fcntl($fh) |
58
|
|
|
|
|
|
|
|| |
59
|
|
|
|
|
|
|
($HAS_FMODE && _get_open_mode_filehandle_fmode($fh)); |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub encode { |
63
|
111
|
|
|
111
|
1
|
22408
|
my $value = shift; |
64
|
111
|
|
|
|
|
96
|
my $path_expr = shift; |
65
|
111
|
|
|
|
|
96
|
my $seen = shift; |
66
|
|
|
|
|
|
|
|
67
|
111
|
100
|
|
|
|
204
|
if (!ref($value)) { |
68
|
52
|
|
|
|
|
52
|
my $ref_to_value = \$value; |
69
|
52
|
|
|
|
|
64
|
my $ref = ref($ref_to_value); |
70
|
52
|
|
|
|
|
47
|
my $encoded_value = $value; |
71
|
|
|
|
|
|
|
# perl 5.8 - ref() with a vstring returns SCALAR |
72
|
52
|
50
|
33
|
|
|
324
|
if ($ref eq 'GLOB' |
|
|
|
33
|
|
|
|
|
73
|
|
|
|
|
|
|
or |
74
|
|
|
|
|
|
|
$ref eq 'VSTRING' or Scalar::Util::isvstring($value) |
75
|
|
|
|
|
|
|
) { |
76
|
0
|
|
|
|
|
0
|
$encoded_value = encode($ref_to_value, $path_expr, $seen); |
77
|
0
|
|
|
|
|
0
|
delete $encoded_value->{__refaddr}; |
78
|
0
|
|
|
|
|
0
|
delete $seen->{$ref_to_value}; |
79
|
|
|
|
|
|
|
} |
80
|
52
|
|
|
|
|
145
|
return $encoded_value; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
59
|
|
100
|
|
|
162
|
$path_expr ||= '$VAR'; |
84
|
59
|
|
100
|
|
|
129
|
$seen ||= {}; |
85
|
|
|
|
|
|
|
|
86
|
59
|
|
|
|
|
122
|
my $reftype = Scalar::Util::reftype($value); |
87
|
59
|
|
|
|
|
86
|
my $refaddr = Scalar::Util::refaddr($value); |
88
|
59
|
|
|
|
|
96
|
my $blesstype = Scalar::Util::blessed($value); |
89
|
|
|
|
|
|
|
|
90
|
59
|
|
|
|
|
58
|
my $encoded_value; |
91
|
|
|
|
|
|
|
|
92
|
59
|
100
|
|
|
|
148
|
if ($seen->{$value}) { |
93
|
|
|
|
|
|
|
$encoded_value = { __reftype => $reftype, |
94
|
|
|
|
|
|
|
__refaddr => $refaddr, |
95
|
|
|
|
|
|
|
__recursive => 1, |
96
|
7
|
|
|
|
|
23
|
__value => $seen->{$value} }; |
97
|
7
|
100
|
|
|
|
16
|
$encoded_value->{__blessed} = $blesstype if $blesstype; |
98
|
7
|
|
|
|
|
21
|
return $encoded_value; |
99
|
|
|
|
|
|
|
} |
100
|
52
|
|
|
|
|
99
|
$seen->{$value} = $path_expr; |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# Build a new path string for recursive calls |
103
|
|
|
|
|
|
|
my $_p = sub { |
104
|
86
|
100
|
100
|
86
|
|
399
|
return join('', '${', $path_expr, '}') if ($reftype eq 'SCALAR' or $reftype eq 'REF'); |
105
|
64
|
100
|
|
|
|
175
|
return join('', '*{', $path_expr, '}') if ($reftype eq 'GLOB'); |
106
|
|
|
|
|
|
|
|
107
|
42
|
100
|
|
|
|
100
|
my @bracket = $reftype eq 'ARRAY' ? ( '[', ']' ) : ( '{', '}' ); |
108
|
42
|
|
|
|
|
249
|
return sprintf('%s->%s%s%s', $path_expr, $bracket[0], $_, $bracket[1]); |
109
|
52
|
|
|
|
|
187
|
}; |
110
|
|
|
|
|
|
|
|
111
|
52
|
100
|
|
|
|
172
|
if (my $tied = _is_tied($value)) { |
112
|
4
|
|
|
|
|
7
|
local $_ = 'tied'; # &$_p needs this |
113
|
4
|
|
|
|
|
12
|
my $original = encode(_untie_and_get_original_value($value), &$_p, $seen); |
114
|
|
|
|
|
|
|
$encoded_value = { __reftype => $reftype, |
115
|
|
|
|
|
|
|
__refaddr => $refaddr, |
116
|
4
|
100
|
|
|
|
20
|
__tied => ref($original) ? $original->{__value} : $original, |
117
|
|
|
|
|
|
|
__value => encode($tied, &$_p, $seen) }; |
118
|
4
|
|
|
|
|
11
|
_retie($value, $tied); |
119
|
4
|
50
|
|
|
|
11
|
$encoded_value->{__blessed} = $blesstype if $blesstype; |
120
|
4
|
|
|
|
|
34
|
return $encoded_value; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
48
|
100
|
100
|
|
|
390
|
if ($reftype eq 'HASH') { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
124
|
6
|
|
|
|
|
33
|
$encoded_value = { map { $_ => encode($value->{$_}, &$_p, $seen) } sort(keys %$value) }; |
|
13
|
|
|
|
|
26
|
|
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
} elsif ($reftype eq 'ARRAY') { |
127
|
12
|
|
|
|
|
38
|
$encoded_value = [ map { encode($value->[$_], &$_p, $seen) } (0 .. $#$value) ]; |
|
25
|
|
|
|
|
56
|
|
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
} elsif ($reftype eq 'GLOB') { |
130
|
12
|
|
|
|
|
15
|
my %encoded_value = map { $_ => encode(*{$value}{$_}, |
|
12
|
|
|
|
|
31
|
|
131
|
|
|
|
|
|
|
&$_p."{$_}", |
132
|
|
|
|
|
|
|
$seen) } |
133
|
9
|
|
|
|
|
17
|
grep { *{$value}{$_} } |
|
27
|
|
|
|
|
24
|
|
|
27
|
|
|
|
|
49
|
|
134
|
|
|
|
|
|
|
qw(HASH ARRAY SCALAR); |
135
|
9
|
|
|
|
|
13
|
@encoded_value{'NAME','PACKAGE'} = (*{$value}{NAME}, *{$value}{PACKAGE}); |
|
9
|
|
|
|
|
18
|
|
|
9
|
|
|
|
|
26
|
|
136
|
9
|
100
|
|
|
|
10
|
if (*{$value}{CODE}) { |
|
9
|
|
|
|
|
25
|
|
137
|
1
|
|
|
|
|
2
|
$encoded_value{CODE} = encode(*{$value}{CODE}, &$_p, $seen); |
|
1
|
|
|
|
|
5
|
|
138
|
|
|
|
|
|
|
} |
139
|
9
|
100
|
|
|
|
8
|
if (*{$value}{IO}) { |
|
9
|
|
|
|
|
57
|
|
140
|
7
|
50
|
|
|
|
43
|
if ( $encoded_value{IO} = encode(fileno(*{$value}{IO}), &$_p, $seen) ) |
|
7
|
|
|
|
|
31
|
|
141
|
|
|
|
|
|
|
{ |
142
|
7
|
|
|
|
|
8
|
$encoded_value{IOmode} = _get_open_mode(*{$value}{IO}); |
|
7
|
|
|
|
|
17
|
|
143
|
7
|
|
|
|
|
38
|
$encoded_value{IOseek} = sysseek($value, 0, 1); |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
} |
146
|
9
|
|
|
|
|
19
|
$encoded_value = \%encoded_value; |
147
|
|
|
|
|
|
|
} elsif (($reftype eq 'REGEXP') |
148
|
|
|
|
|
|
|
or ($reftype eq 'SCALAR' and defined($blesstype) and $blesstype eq 'Regexp') |
149
|
|
|
|
|
|
|
) { |
150
|
0
|
|
|
|
|
0
|
$reftype = 'REGEXP'; |
151
|
0
|
0
|
|
|
|
0
|
undef($blesstype) unless $blesstype ne 'Regexp'; |
152
|
0
|
|
|
|
|
0
|
my($pattern, $modifiers); |
153
|
0
|
0
|
|
|
|
0
|
if ($^V ge v5.9.5) { |
154
|
0
|
|
|
|
|
0
|
require re; |
155
|
|
|
|
|
|
|
} |
156
|
0
|
0
|
|
|
|
0
|
if (defined &re::regexp_pattern) { |
157
|
0
|
|
|
|
|
0
|
($pattern, $modifiers) = re::regexp_pattern($value); |
158
|
|
|
|
|
|
|
} else { |
159
|
0
|
|
|
|
|
0
|
my $value_as_str = "$value"; |
160
|
0
|
|
|
|
|
0
|
($modifiers, $pattern) = $value_as_str =~ m/\(\?(\w*)-\w*:(.*)\)$/; |
161
|
|
|
|
|
|
|
} |
162
|
0
|
|
|
|
|
0
|
$encoded_value = [ $pattern, $modifiers ]; |
163
|
|
|
|
|
|
|
} elsif ($reftype eq 'CODE') { |
164
|
1
|
|
|
|
|
3
|
(my $copy = $value.'') =~ s/^(\w+)\=//; # Hack to change CodeClass=CODE(0x123) to CODE=(0x123) |
165
|
1
|
|
|
|
|
5
|
$encoded_value = $copy; |
166
|
|
|
|
|
|
|
} elsif ($reftype eq 'REF') { |
167
|
6
|
|
|
|
|
8
|
$encoded_value = encode($$value, &$_p, $seen ); |
168
|
|
|
|
|
|
|
} elsif (($reftype eq 'VSTRING') or (ref($value) eq 'SCALAR' and Scalar::Util::isvstring($$value))) { |
169
|
0
|
|
|
|
|
0
|
$reftype = 'VSTRING'; |
170
|
0
|
|
|
|
|
0
|
$encoded_value = [ unpack('c*', $$value) ]; |
171
|
|
|
|
|
|
|
} elsif ($reftype eq 'SCALAR') { |
172
|
14
|
|
|
|
|
28
|
$encoded_value = encode($$value, &$_p, $seen); |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
48
|
|
|
|
|
134
|
$encoded_value = { __reftype => $reftype, __refaddr => $refaddr, __value => $encoded_value }; |
176
|
48
|
100
|
|
|
|
81
|
$encoded_value->{__blessed} = $blesstype if $blesstype; |
177
|
|
|
|
|
|
|
|
178
|
48
|
|
|
|
|
258
|
return $encoded_value; |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
sub _is_tied { |
182
|
56
|
|
|
56
|
|
55
|
my $ref = shift; |
183
|
|
|
|
|
|
|
|
184
|
56
|
|
|
|
|
108
|
my $reftype = Scalar::Util::reftype($ref); |
185
|
56
|
|
|
|
|
39
|
my $tied; |
186
|
56
|
100
|
|
|
|
198
|
if ($reftype eq 'HASH') { $tied = tied %$ref } |
|
8
|
100
|
|
|
|
16
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
187
|
14
|
|
|
|
|
22
|
elsif ($reftype eq 'ARRAY') { $tied = tied @$ref } |
188
|
16
|
|
|
|
|
19
|
elsif ($reftype eq 'SCALAR') { $tied = tied $$ref } |
189
|
11
|
|
|
|
|
13
|
elsif ($reftype eq 'GLOB') { $tied = tied *$ref } |
190
|
|
|
|
|
|
|
|
191
|
56
|
|
|
|
|
155
|
return $tied; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub _untie_and_get_original_value { |
195
|
4
|
|
|
4
|
|
6
|
my $ref = shift; |
196
|
|
|
|
|
|
|
|
197
|
4
|
|
|
|
|
10
|
my $tied_val = _is_tied($ref); |
198
|
4
|
|
|
|
|
14
|
my $class = Scalar::Util::blessed($tied_val); |
199
|
4
|
|
|
|
|
12
|
my $untie_function = join('::', $class, 'UNTIE'); |
200
|
5
|
|
|
5
|
|
303
|
no strict 'refs'; |
|
5
|
|
|
|
|
61
|
|
|
5
|
|
|
|
|
273
|
|
201
|
4
|
|
|
4
|
|
41
|
local *$untie_function = sub { }; |
202
|
5
|
|
|
5
|
|
21
|
use strict 'refs'; |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
1231
|
|
203
|
|
|
|
|
|
|
|
204
|
4
|
|
|
|
|
12
|
my $reftype = Scalar::Util::reftype($ref); |
205
|
4
|
|
|
|
|
5
|
my $original; |
206
|
4
|
50
|
|
|
|
32
|
if (!$reftype) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
207
|
0
|
|
|
|
|
0
|
untie $ref; |
208
|
0
|
|
|
|
|
0
|
$original = $ref; |
209
|
|
|
|
|
|
|
} elsif ($reftype eq 'SCALAR') { |
210
|
1
|
|
|
|
|
4
|
untie $$ref; |
211
|
1
|
|
|
|
|
2
|
$original = $$ref; |
212
|
|
|
|
|
|
|
} elsif ($reftype eq 'ARRAY') { |
213
|
1
|
|
|
|
|
4
|
untie @$ref; |
214
|
1
|
|
|
|
|
5
|
$original = [ @$ref ]; |
215
|
|
|
|
|
|
|
} elsif ($reftype eq 'HASH') { |
216
|
1
|
|
|
|
|
4
|
untie %$ref; |
217
|
1
|
|
|
|
|
5
|
$original = { %$ref }; |
218
|
|
|
|
|
|
|
} elsif ($reftype eq 'GLOB') { |
219
|
1
|
|
|
|
|
4
|
untie *$ref; |
220
|
1
|
|
|
|
|
4
|
my $pkg = *$ref{PACKAGE}; |
221
|
1
|
|
|
|
|
4
|
my $name = *$ref{NAME}; |
222
|
1
|
|
|
|
|
4
|
$original = _create_anon_ref_of_type('GLOB', $pkg, $name); |
223
|
1
|
|
|
|
|
5
|
*$original = *$ref; |
224
|
|
|
|
|
|
|
} else { |
225
|
0
|
|
|
|
|
0
|
Carp::croak("Cannot retrieve the original value of a tied $reftype"); |
226
|
|
|
|
|
|
|
} |
227
|
4
|
|
|
|
|
24
|
return $original; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
sub _retie { |
231
|
8
|
|
|
8
|
|
14
|
my($ref, $value) = @_; |
232
|
|
|
|
|
|
|
|
233
|
8
|
|
|
|
|
22
|
my $reftype = Scalar::Util::reftype($ref); |
234
|
8
|
|
|
|
|
23
|
my $class = Scalar::Util::blessed($value); |
235
|
5
|
|
|
5
|
|
26
|
no strict 'refs'; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
155
|
|
236
|
5
|
|
|
5
|
|
24
|
no warnings 'redefine'; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
2222
|
|
237
|
8
|
100
|
|
|
|
38
|
if ($reftype eq 'SCALAR') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
238
|
2
|
|
|
|
|
7
|
my $tiescalar = join('::',$class, 'TIESCALAR'); |
239
|
2
|
|
|
2
|
|
18
|
local *$tiescalar = sub { return $value }; |
|
2
|
|
|
|
|
12
|
|
240
|
2
|
|
|
|
|
10
|
tie $$ref, $class; |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
} elsif ($reftype eq 'ARRAY') { |
243
|
2
|
|
|
|
|
12
|
my $tiearray = join('::', $class, 'TIEARRAY'); |
244
|
2
|
|
|
2
|
|
15
|
local *$tiearray = sub { return $value }; |
|
2
|
|
|
|
|
10
|
|
245
|
2
|
|
|
|
|
8
|
tie @$ref, $class; |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
} elsif ($reftype eq 'HASH') { |
248
|
2
|
|
|
|
|
5
|
my $tiehash = join('::', $class, 'TIEHASH'); |
249
|
2
|
|
|
2
|
|
15
|
local *$tiehash = sub { return $value }; |
|
2
|
|
|
|
|
11
|
|
250
|
2
|
|
|
|
|
8
|
tie %$ref, $class; |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
} elsif ($reftype eq 'GLOB') { |
253
|
2
|
|
|
|
|
7
|
my $tiehandle = join('::', $class, 'TIEHANDLE'); |
254
|
2
|
|
|
2
|
|
14
|
local *$tiehandle = sub { return $value }; |
|
2
|
|
|
|
|
10
|
|
255
|
2
|
|
|
|
|
16
|
tie *$ref, $class; |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
} else { |
258
|
0
|
|
|
|
|
0
|
Carp::croak('Cannot recreate a tied '.scalar(ref $value)); |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub _create_anon_ref_of_type { |
263
|
8
|
|
|
8
|
|
19
|
my($type, $package, $name) = @_; |
264
|
|
|
|
|
|
|
|
265
|
8
|
100
|
|
|
|
45
|
if ($type eq 'SCALAR') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
266
|
1
|
|
|
|
|
6
|
my $anon; |
267
|
1
|
|
|
|
|
3
|
return \$anon; |
268
|
|
|
|
|
|
|
} elsif ($type eq 'ARRAY') { |
269
|
1
|
|
|
|
|
3
|
return []; |
270
|
|
|
|
|
|
|
} elsif ($type eq 'HASH') { |
271
|
1
|
|
|
|
|
4
|
return {}; |
272
|
|
|
|
|
|
|
} elsif ($type eq 'GLOB') { |
273
|
5
|
|
|
|
|
6
|
my $rv; |
274
|
5
|
100
|
66
|
|
|
66
|
if ($package and $name |
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
275
|
|
|
|
|
|
|
and |
276
|
|
|
|
|
|
|
$package ne 'Symbol' |
277
|
|
|
|
|
|
|
and |
278
|
|
|
|
|
|
|
$name !~ m/GEN\d/ |
279
|
|
|
|
|
|
|
) { |
280
|
4
|
|
|
|
|
10
|
my $globname = join('::',$package, $name); |
281
|
5
|
|
|
5
|
|
29
|
$rv = do { no strict 'refs'; local *$globname; \*$globname; }; |
|
5
|
|
|
|
|
13
|
|
|
5
|
|
|
|
|
7998
|
|
|
4
|
|
|
|
|
3
|
|
|
4
|
|
|
|
|
17
|
|
|
4
|
|
|
|
|
12
|
|
282
|
|
|
|
|
|
|
} else { |
283
|
1
|
|
|
|
|
6
|
$rv = Symbol::gensym(); |
284
|
|
|
|
|
|
|
} |
285
|
5
|
|
|
|
|
30
|
return $rv; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
sub _recreate_fh { |
290
|
1
|
|
|
1
|
|
2
|
my($fileno, $mode) = @_; |
291
|
|
|
|
|
|
|
|
292
|
1
|
|
|
|
|
1
|
my $fh; |
293
|
1
|
50
|
|
|
|
3
|
if ($mode) { |
294
|
0
|
0
|
|
|
|
0
|
open($fh, $mode . '&=', $fileno) |
295
|
|
|
|
|
|
|
|| Carp::carp("Couldn't open filehandle for descriptor $fileno with mode $mode: $!"); |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
} else { |
298
|
1
|
50
|
33
|
|
|
16
|
open($fh, '>&=', $fileno) |
299
|
|
|
|
|
|
|
|| open($fh, '<&=', $fileno) |
300
|
|
|
|
|
|
|
|| Carp::carp("Couldn't open filehandle for descriptor $fileno: $!"); |
301
|
|
|
|
|
|
|
} |
302
|
1
|
|
|
|
|
3
|
return $fh; |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
sub decode { |
306
|
71
|
|
|
71
|
1
|
19151
|
my($input, $recursive_queue, $recurse_fill) = @_; |
307
|
|
|
|
|
|
|
|
308
|
71
|
100
|
|
|
|
134
|
unless (ref $input) { |
309
|
27
|
|
|
|
|
109
|
return $input; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
44
|
|
|
|
|
83
|
_validate_decode_structure($input); |
313
|
|
|
|
|
|
|
|
314
|
44
|
|
|
|
|
87
|
my($value, $reftype, $refaddr, $blessed) = @$input{'__value','__reftype','__refaddr','__blessed'}; |
315
|
44
|
|
|
|
|
36
|
my $rv; |
316
|
44
|
|
|
|
|
47
|
my $is_first_invocation = ! $recursive_queue; |
317
|
44
|
|
100
|
|
|
100
|
$recursive_queue ||= []; |
318
|
|
|
|
|
|
|
|
319
|
44
|
100
|
|
|
|
174
|
if ($input->{__recursive}) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
320
|
7
|
|
|
|
|
8
|
my $path = $input->{__value}; |
321
|
|
|
|
|
|
|
push @$recursive_queue, |
322
|
|
|
|
|
|
|
sub { |
323
|
7
|
|
|
7
|
|
10
|
my $VAR = shift; |
324
|
7
|
|
|
|
|
437
|
$recurse_fill->(eval $path); |
325
|
7
|
|
|
|
|
17
|
}; |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
} elsif ($input->{__tied}) { |
328
|
4
|
|
|
|
|
10
|
$rv = _create_anon_ref_of_type($reftype); |
329
|
4
|
|
|
|
|
6
|
my $tied_value; |
330
|
4
|
|
|
0
|
|
29
|
$tied_value = decode($value, $recursive_queue, sub { $tied_value }); |
|
0
|
|
|
|
|
0
|
|
331
|
4
|
|
|
|
|
17
|
_retie($rv, $tied_value); |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
} elsif ($reftype eq 'SCALAR') { |
334
|
8
|
|
|
|
|
12
|
$rv = \$value; |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
} elsif ($reftype eq 'ARRAY') { |
337
|
11
|
|
|
|
|
21
|
$rv = []; |
338
|
11
|
|
|
|
|
40
|
for (my $i = 0; $i < @$value; $i++) { |
339
|
23
|
|
|
|
|
20
|
my $idx = $i; |
340
|
23
|
|
|
4
|
|
120
|
push @$rv, decode($value->[$i], $recursive_queue, sub { $rv->[$idx] = shift }); |
|
4
|
|
|
|
|
15
|
|
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
} elsif ($reftype eq 'HASH') { |
344
|
5
|
|
|
|
|
8
|
$rv = {}; |
345
|
5
|
|
|
|
|
20
|
foreach my $key ( sort keys %$value ) { |
346
|
12
|
|
|
|
|
12
|
my $k = $key; |
347
|
12
|
|
|
1
|
|
50
|
$rv->{$key} = decode($value->{$key}, $recursive_queue, sub { $rv->{$k} = shift }); |
|
1
|
|
|
|
|
4
|
|
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
} elsif ($reftype eq 'GLOB') { |
351
|
|
|
|
|
|
|
my $is_real_glob = ($value->{PACKAGE} ne 'Symbol' |
352
|
|
|
|
|
|
|
and $value->{NAME} !~ m/^GEN\d+/ |
353
|
3
|
|
33
|
|
|
27
|
and $value->{NAME} =~ m/^\w/); |
354
|
3
|
|
|
|
|
10
|
$rv = _create_anon_ref_of_type('GLOB', $value->{PACKAGE}, $value->{NAME}); |
355
|
|
|
|
|
|
|
|
356
|
3
|
|
|
|
|
9
|
foreach my $type ( keys %$value ) { |
357
|
14
|
50
|
100
|
|
|
85
|
next if ($type eq 'NAME' or $type eq 'PACKAGE' or $type eq 'IOseek' or $type eq 'IOmode'); |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
358
|
8
|
100
|
|
|
|
22
|
if ($type eq 'IO') { |
|
|
100
|
|
|
|
|
|
359
|
1
|
50
|
|
|
|
2
|
if (my $fileno = $value->{IO}) { |
360
|
1
|
|
|
|
|
5
|
$rv = _recreate_fh($fileno, $value->{IOmode}); |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
} elsif ($type eq 'CODE') { |
363
|
1
|
50
|
|
|
|
2
|
*{$rv} = \&_dummy_sub unless ($is_real_glob); |
|
0
|
|
|
|
|
0
|
|
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
} else { |
366
|
6
|
|
|
0
|
|
23
|
*{$rv} = decode($value->{$type}, $recursive_queue, sub { *{$rv} = shift }); |
|
6
|
|
|
|
|
14
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
3
|
50
|
|
|
|
8
|
$rv = *$rv unless $refaddr; |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
} elsif ($reftype eq 'CODE') { |
373
|
0
|
|
|
|
|
0
|
$rv = \&_dummy_sub; |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
} elsif ($reftype eq 'REF') { |
376
|
6
|
|
|
|
|
4
|
my $ref; |
377
|
6
|
|
|
2
|
|
22
|
$ref = decode($value, $recursive_queue, sub { $ref = shift }); |
|
2
|
|
|
|
|
6
|
|
378
|
6
|
|
|
|
|
8
|
$rv = \$ref; |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
} elsif ($reftype eq 'REGEXP') { |
381
|
0
|
|
|
|
|
0
|
my($pattern,$modifiers) = @$value[0,1]; |
382
|
0
|
|
|
|
|
0
|
$rv = eval "qr($pattern)$modifiers"; |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
} elsif ($reftype eq 'VSTRING') { |
385
|
0
|
|
|
|
|
0
|
my $vstring = eval 'v' . join('.', @$value); |
386
|
0
|
0
|
|
|
|
0
|
$rv = $refaddr ? \$vstring : $vstring; |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
44
|
100
|
100
|
|
|
112
|
bless $rv, $blessed if ($blessed and ! $input->{__recursive}); |
391
|
|
|
|
|
|
|
|
392
|
44
|
100
|
|
|
|
75
|
if ($is_first_invocation) { |
393
|
16
|
|
|
|
|
37
|
$_->($rv) foreach @$recursive_queue; |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
44
|
|
|
|
|
102
|
return $rv; |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
sub _dummy_sub { |
400
|
0
|
|
|
0
|
|
0
|
'Put in place by ' . __PACKAGE__ . ' when it could not find the named sub'; |
401
|
|
|
|
|
|
|
} |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
sub _validate_decode_structure { |
404
|
44
|
|
|
44
|
|
42
|
my $input = shift; |
405
|
|
|
|
|
|
|
|
406
|
44
|
50
|
|
|
|
88
|
ref($input) eq 'HASH' |
407
|
|
|
|
|
|
|
or Carp::croak('Invalid decode data: expected hashref but got '.ref($input)); |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
exists($input->{__value}) |
410
|
44
|
50
|
|
|
|
78
|
or Carp::croak('Invalid decode data: expected key __value'); |
411
|
|
|
|
|
|
|
exists($input->{__reftype}) |
412
|
44
|
50
|
|
|
|
76
|
or Carp::croak('Invalid decode data: expected key __reftype'); |
413
|
|
|
|
|
|
|
|
414
|
44
|
|
|
|
|
77
|
my($reftype, $value, $blesstype) = @$input{'__reftype','__value','__blesstype'}; |
415
|
|
|
|
|
|
|
$reftype eq 'GLOB' |
416
|
|
|
|
|
|
|
or $reftype eq 'VSTRING' |
417
|
|
|
|
|
|
|
or exists($input->{__refaddr}) |
418
|
44
|
50
|
66
|
|
|
247
|
or Carp::croak('Invalid decode data: expected key __refaddr'); |
|
|
|
66
|
|
|
|
|
419
|
|
|
|
|
|
|
|
420
|
44
|
50
|
33
|
|
|
180
|
($blesstype and $reftype) |
|
|
|
33
|
|
|
|
|
421
|
|
|
|
|
|
|
or !$blesstype |
422
|
|
|
|
|
|
|
or Carp::croak('Invalid decode data: Cannot have __blesstype without __reftype'); |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
my $compatible_references = |
425
|
|
|
|
|
|
|
( ( $reftype eq 'SCALAR' and ! ref($value) ) |
426
|
|
|
|
|
|
|
or |
427
|
|
|
|
|
|
|
( $reftype eq ref($value) ) |
428
|
|
|
|
|
|
|
or |
429
|
|
|
|
|
|
|
( $reftype eq 'GLOB' and exists($value->{SCALAR})) |
430
|
|
|
|
|
|
|
or |
431
|
|
|
|
|
|
|
( $reftype eq 'CODE' and $value and ref($value) eq '' ) |
432
|
|
|
|
|
|
|
or |
433
|
|
|
|
|
|
|
( $reftype eq 'REF' and ref($value) eq 'HASH' and exists($value->{__reftype}) ) |
434
|
|
|
|
|
|
|
or |
435
|
|
|
|
|
|
|
( $reftype eq 'REGEXP' and ref($value) eq 'ARRAY' ) |
436
|
|
|
|
|
|
|
or |
437
|
|
|
|
|
|
|
( $reftype eq 'VSTRING' and ref($value) eq 'ARRAY' ) |
438
|
|
|
|
|
|
|
or |
439
|
|
|
|
|
|
|
( $reftype and ! ref($input->{__value}) and $input->{__recursive} ) |
440
|
|
|
|
|
|
|
or |
441
|
|
|
|
|
|
|
( $input->{__tied} and ref($input->{__value}) and $input->{__value}->{__blessed} ) |
442
|
44
|
|
66
|
|
|
517
|
); |
443
|
|
|
|
|
|
|
$compatible_references or Carp::croak('Invalid decode data: __reftype is ' |
444
|
|
|
|
|
|
|
. $input->{__reftype} |
445
|
|
|
|
|
|
|
. ' but __value is a ' |
446
|
44
|
50
|
|
|
|
70
|
. ref($input->{__value})); |
447
|
44
|
|
|
|
|
46
|
return 1; |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
1; |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=pod |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=head1 NAME |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
Data::Transform::ExplicitMetadata - Encode Perl values in a json-friendly way |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
=head1 SYNOPSIS |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
use Data::Transform::ExplicitMetadata qw(encode decode); |
461
|
|
|
|
|
|
|
use JSON; |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
my $val = encode($some_data_structure); |
464
|
|
|
|
|
|
|
$io->print( JSON::encode_json( $val )); |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
my $data_structure_copy = decode($val); |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
=head1 DESCRIPTION |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
Transforms an arbitrarily nested data structure into an analogous data |
471
|
|
|
|
|
|
|
structure composed of only simple scalars, arrayrefs and hashrefs that may |
472
|
|
|
|
|
|
|
be safely JSON-encoded, while retaining all the Perl-specific metadata |
473
|
|
|
|
|
|
|
about typeglobs, blessed and tied references, self-referential data, |
474
|
|
|
|
|
|
|
reference addresses, etc. |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
With a few exceptions, a copy of the original data structure can be recreated |
477
|
|
|
|
|
|
|
from the encoded version. |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
=head2 Functions |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
=over 4 |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
=item encode |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
Accepts a single value and returns a value that may be safely passed to |
486
|
|
|
|
|
|
|
JSON::encode_json(). encode_json() cannot handle Perl-specific data like |
487
|
|
|
|
|
|
|
blessed references or typeglobs. Non-reference scalar values like numbers |
488
|
|
|
|
|
|
|
and strings are returned unchanged. For all references, encode() |
489
|
|
|
|
|
|
|
returns a hashref with these keys |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
=over 4 |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
=item * __reftype |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
String indicating the type of reference, as returned by Scalar::Util::reftype() |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
=item * __refaddr |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
Memory address of the reference, as returned by Scalar::Util::refaddr() |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
=item * __blessed |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
Package this reference is blessed into, as returned by Scalar::Util::blessed. |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
=item * __value |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
Reference to the unblessed data. |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=item * __tied |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
The original value hidden by the tie() operation. |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=item * __recursive |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
Flag indicating this reference was seen before |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
=back |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
If the reference was not blessed or tied, then the __blessed and/or __tied keys |
520
|
|
|
|
|
|
|
will not be present. |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
C<__value> is generally a copy of the underlying data. For example, if the input |
523
|
|
|
|
|
|
|
value is an hashref, then __value will also be a hashref containing the input |
524
|
|
|
|
|
|
|
value's kays and values. For typeblobs and glob refs, __value will be a |
525
|
|
|
|
|
|
|
hashref with the keys NAME, PACKAGE, SCALAR, ARRAY, HASH, IO and CODE. For |
526
|
|
|
|
|
|
|
compiled regexps, __value will be a 2-element arrayref of the pattern and |
527
|
|
|
|
|
|
|
modifiers. For coderefs, __value will be the stringified reference, like |
528
|
|
|
|
|
|
|
"CODE=(0x12345678)". For v-strings and v-string refs, __value will by an |
529
|
|
|
|
|
|
|
arrayref containing the integers making up the v-string. |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
For tied objects, C<__tied> will be contain the original value hidden by tie() |
532
|
|
|
|
|
|
|
and __value will contain the tied data. The original data is retrieved by: |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
=over 4 |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
=item * |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
call tied() to get a copy of the tied data |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
=item * |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
localize the UNTIE method in the appropriate class |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
=item * |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
untie the variable |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
=item * |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
save a copy of the original value |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
=item * |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
localize the appropriate TIE* mythod to return the tied data |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
=item * |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
call tie() to retie the variable |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
=back |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
if C<__recursive> is true, then __value will contain a string representation |
563
|
|
|
|
|
|
|
of the first place this reference was seen in the data structure. |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
encode() handles arbitrarily nested data structures, meaning that |
566
|
|
|
|
|
|
|
values in the __values slot may also be encoded this way. |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
=item decode |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
Accepts a single value and returns a copy of the data structure originally |
571
|
|
|
|
|
|
|
passed to encode(). __refaddr information is discarded and new copies of |
572
|
|
|
|
|
|
|
nested data structures is created. Self-referential data is re-linked to the |
573
|
|
|
|
|
|
|
appropriate placxe in the new copy. Blessed references are re-bless into |
574
|
|
|
|
|
|
|
the original packages. |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
Tied variables are re-tied by localizing the appropriate TIE* method to return |
577
|
|
|
|
|
|
|
the tied data. The variable's original data is filled in before calling tie(). |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
The IO slot of typeglobs is recreated by opening the handle with the same |
580
|
|
|
|
|
|
|
descriptor number and open mode. It will first try fcntl() with F_GETFL |
581
|
|
|
|
|
|
|
to determine the open mode, falling back to using FileHandle::Fmode if it's |
582
|
|
|
|
|
|
|
available. Finally, it will first try re-opening the file descriptor in |
583
|
|
|
|
|
|
|
read mode, then write mode. |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
Coderefs cannot be decoded properly. They are recreated by returning a |
586
|
|
|
|
|
|
|
reference to a dummy sub that returns a message explaning the situation. |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
=back |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
=head1 SEE ALSO |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
L, L, L, L |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
=head1 AUTHOR |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
Anthony Brummett |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
=head1 COPYRIGHT |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
Copyright 2016, Anthony Brummett. This module is free software. It may |
601
|
|
|
|
|
|
|
be used, redistributed and/or modified under the same terms as Perl itself. |