| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Readonly; |
|
2
|
14
|
|
|
14
|
|
191057
|
use 5.005; |
|
|
14
|
|
|
|
|
33
|
|
|
3
|
14
|
|
|
14
|
|
47
|
use strict; |
|
|
14
|
|
|
|
|
13
|
|
|
|
14
|
|
|
|
|
848
|
|
|
4
|
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
#use warnings; |
|
6
|
|
|
|
|
|
|
#no warnings 'uninitialized'; |
|
7
|
|
|
|
|
|
|
package Readonly; |
|
8
|
|
|
|
|
|
|
our $VERSION = '2.05'; |
|
9
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# Autocroak (Thanks, MJD) |
|
12
|
|
|
|
|
|
|
# Only load Carp.pm if module is croaking. |
|
13
|
|
|
|
|
|
|
sub croak { |
|
14
|
50
|
|
|
50
|
0
|
216
|
require Carp; |
|
15
|
50
|
|
|
|
|
4526
|
goto &Carp::croak; |
|
16
|
|
|
|
|
|
|
} |
|
17
|
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# These functions may be overridden by Readonly::XS, if installed. |
|
19
|
14
|
|
|
14
|
|
50
|
use vars qw/$XSokay/; # Set to true in Readonly::XS, if available |
|
|
14
|
|
|
|
|
21
|
|
|
|
14
|
|
|
|
|
6422
|
|
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# Predeclare the following, so we can use them recursively |
|
22
|
|
|
|
|
|
|
sub _ARRAY (\@); |
|
23
|
|
|
|
|
|
|
sub _HASH (\%); |
|
24
|
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# For perl 5.8.x or higher |
|
26
|
|
|
|
|
|
|
# These functions are exposed in perl 5.8.x (Thanks, Leon!) |
|
27
|
|
|
|
|
|
|
# They may be overridden by Readonly::XS, if installed on old perl versions |
|
28
|
|
|
|
|
|
|
if ($] < 5.008) { # 'Classic' perl |
|
29
|
|
|
|
|
|
|
*is_sv_readonly = sub ($) {0}; |
|
30
|
|
|
|
|
|
|
*make_sv_readonly |
|
31
|
|
|
|
|
|
|
= sub ($) { die "make_sv_readonly called but not overridden" }; |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# See if we can use the XS stuff. |
|
34
|
|
|
|
|
|
|
$Readonly::XS::MAGIC_COOKIE = $Readonly::XS::MAGIC_COOKIE |
|
35
|
|
|
|
|
|
|
= "Do NOT use or require Readonly::XS unless you're me."; |
|
36
|
|
|
|
|
|
|
eval 'use Readonly::XS'; |
|
37
|
|
|
|
|
|
|
} |
|
38
|
|
|
|
|
|
|
else { # Modern perl doesn't need Readonly::XS |
|
39
|
30
|
|
|
30
|
|
221
|
*is_sv_readonly = sub ($) { Internals::SvREADONLY($_[0]) }; |
|
40
|
|
|
|
|
|
|
*make_sv_readonly |
|
41
|
17
|
|
|
17
|
|
29
|
= sub ($) { Internals::SvREADONLY($_[0], 1) }; |
|
42
|
|
|
|
|
|
|
$XSokay = 1; # We're using the new built-ins so this is a white lie |
|
43
|
|
|
|
|
|
|
} |
|
44
|
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# Undo setting readonly |
|
46
|
|
|
|
|
|
|
sub _SCALAR ($) { |
|
47
|
1
|
|
|
1
|
|
2
|
my ($r_var) = @_; |
|
48
|
1
|
50
|
|
|
|
2
|
if ($XSokay) { |
|
49
|
1
|
50
|
|
|
|
2
|
Internals::SvREADONLY($r_var, 0) if is_sv_readonly($r_var); |
|
50
|
|
|
|
|
|
|
} |
|
51
|
|
|
|
|
|
|
else { |
|
52
|
0
|
0
|
|
|
|
0
|
return if tied($r_var) !~ 'Readonly::Scalar'; |
|
53
|
0
|
|
|
|
|
0
|
my $r_scalar; |
|
54
|
|
|
|
|
|
|
{ |
|
55
|
0
|
|
|
|
|
0
|
my $obj = tied $$r_var; |
|
|
0
|
|
|
|
|
0
|
|
|
56
|
0
|
|
|
|
|
0
|
$r_scalar = $obj; |
|
57
|
|
|
|
|
|
|
} |
|
58
|
0
|
|
|
|
|
0
|
untie $r_var; |
|
59
|
0
|
|
|
|
|
0
|
$r_var = $r_scalar; |
|
60
|
|
|
|
|
|
|
} |
|
61
|
|
|
|
|
|
|
} |
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub _ARRAY (\@) { |
|
64
|
9
|
|
|
9
|
|
8
|
my ($r_var) = @_; |
|
65
|
9
|
100
|
|
|
|
123
|
return if !tied(@$r_var); |
|
66
|
5
|
50
|
|
|
|
15
|
return if tied(@$r_var) !~ 'Readonly::Array'; |
|
67
|
5
|
|
|
|
|
6
|
my $r_array; |
|
68
|
|
|
|
|
|
|
{ |
|
69
|
5
|
|
|
|
|
3
|
my $obj = tied @$r_var; |
|
|
5
|
|
|
|
|
3
|
|
|
70
|
5
|
|
|
|
|
5
|
$r_array = $obj; |
|
71
|
|
|
|
|
|
|
} |
|
72
|
5
|
|
|
|
|
10
|
untie @$r_var; |
|
73
|
5
|
|
|
|
|
8
|
@$r_var = @$r_array; |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# Recursively check child elements for references; clean if Readonly |
|
76
|
5
|
|
|
|
|
8
|
foreach (@$r_var) { |
|
77
|
12
|
|
|
|
|
9
|
my $_reftype = ref $_; |
|
78
|
12
|
50
|
|
|
|
36
|
if ($_reftype eq 'SCALAR') { _SCALAR($_) } |
|
|
0
|
100
|
|
|
|
0
|
|
|
|
|
50
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
elsif ($_reftype eq 'ARRAY') { |
|
80
|
1
|
|
|
|
|
4
|
_ARRAY(@$_); |
|
81
|
|
|
|
|
|
|
} |
|
82
|
|
|
|
|
|
|
elsif ($_reftype eq 'HASH') { |
|
83
|
0
|
|
|
|
|
0
|
_HASH(%$_); |
|
84
|
|
|
|
|
|
|
} |
|
85
|
|
|
|
|
|
|
} |
|
86
|
|
|
|
|
|
|
} |
|
87
|
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub _HASH (\%) { |
|
89
|
8
|
|
|
8
|
|
7
|
my ($r_var) = @_; |
|
90
|
8
|
100
|
|
|
|
129
|
return if !tied(%$r_var); |
|
91
|
4
|
50
|
|
|
|
14
|
return if tied(%$r_var) !~ 'Readonly::Hash'; |
|
92
|
4
|
|
|
|
|
3
|
my $r_hash; |
|
93
|
|
|
|
|
|
|
{ |
|
94
|
4
|
|
|
|
|
2
|
my $obj = tied %$r_var; |
|
|
4
|
|
|
|
|
5
|
|
|
95
|
4
|
|
|
|
|
4
|
$r_hash = $obj; |
|
96
|
|
|
|
|
|
|
} |
|
97
|
4
|
|
|
|
|
9
|
untie %$r_var; |
|
98
|
4
|
|
|
|
|
10
|
%$r_var = %$r_hash; |
|
99
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# Recursively check child elements for references; clean if Readonly |
|
101
|
4
|
|
|
|
|
9
|
foreach (values %$r_var) { |
|
102
|
4
|
|
|
|
|
4
|
my $_reftype = ref $_; |
|
103
|
4
|
50
|
|
|
|
20
|
if ($_reftype eq 'SCALAR') { _SCALAR($_) } |
|
|
0
|
100
|
|
|
|
0
|
|
|
|
|
50
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
elsif ($_reftype eq 'ARRAY') { |
|
105
|
1
|
|
|
|
|
2
|
_ARRAY(@$_); |
|
106
|
|
|
|
|
|
|
} |
|
107
|
|
|
|
|
|
|
elsif ($_reftype eq 'HASH') { |
|
108
|
0
|
|
|
|
|
0
|
_HASH(%$_); |
|
109
|
|
|
|
|
|
|
} |
|
110
|
|
|
|
|
|
|
} |
|
111
|
|
|
|
|
|
|
} |
|
112
|
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# Common error messages, or portions thereof |
|
114
|
14
|
|
|
14
|
|
55
|
use vars qw/$MODIFY $REASSIGN $ODDHASH/; |
|
|
14
|
|
|
|
|
13
|
|
|
|
14
|
|
|
|
|
5539
|
|
|
115
|
|
|
|
|
|
|
$MODIFY = 'Modification of a read-only value attempted'; |
|
116
|
|
|
|
|
|
|
$REASSIGN = 'Attempt to reassign a readonly'; |
|
117
|
|
|
|
|
|
|
$ODDHASH = 'May not store an odd number of values in a hash'; |
|
118
|
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# ---------------- |
|
120
|
|
|
|
|
|
|
# Read-only scalars |
|
121
|
|
|
|
|
|
|
# ---------------- |
|
122
|
|
|
|
|
|
|
package Readonly::Scalar; |
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub STORABLE_freeze { |
|
125
|
0
|
|
|
0
|
|
0
|
my ($self, $cloning) = @_; |
|
126
|
0
|
0
|
|
|
|
0
|
Readonly::_SCALAR($$self) if $cloning; |
|
127
|
|
|
|
|
|
|
} |
|
128
|
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub TIESCALAR { |
|
130
|
5
|
|
|
5
|
|
26
|
my $whence |
|
131
|
|
|
|
|
|
|
= (caller 2)[3]; # Check if naughty user is trying to tie directly. |
|
132
|
5
|
100
|
66
|
|
|
39
|
Readonly::croak "Invalid tie" |
|
133
|
|
|
|
|
|
|
unless $whence && $whence =~ /^Readonly::(?:Scalar1?|Readonly)$/; |
|
134
|
4
|
|
|
|
|
14
|
my $class = shift; |
|
135
|
4
|
50
|
|
|
|
31
|
Readonly::croak "No value specified for readonly scalar" unless @_; |
|
136
|
4
|
50
|
|
|
|
13
|
Readonly::croak "Too many values specified for readonly scalar" |
|
137
|
|
|
|
|
|
|
unless @_ == 1; |
|
138
|
4
|
|
|
|
|
6
|
my $value = shift; |
|
139
|
4
|
|
|
|
|
69
|
return bless \$value, $class; |
|
140
|
|
|
|
|
|
|
} |
|
141
|
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub FETCH { |
|
143
|
1
|
|
|
1
|
|
282
|
my $self = shift; |
|
144
|
1
|
|
|
|
|
6
|
return $$self; |
|
145
|
|
|
|
|
|
|
} |
|
146
|
1
|
|
|
1
|
|
8
|
*STORE = *STORE = sub { Readonly::croak $Readonly::MODIFY }; |
|
147
|
|
|
|
|
|
|
*UNTIE = *UNTIE |
|
148
|
0
|
0
|
|
0
|
|
0
|
= sub { Readonly::croak $Readonly::MODIFY if caller() ne 'Readonly' }; |
|
149
|
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# ---------------- |
|
151
|
|
|
|
|
|
|
# Read-only arrays |
|
152
|
|
|
|
|
|
|
# ---------------- |
|
153
|
|
|
|
|
|
|
package Readonly::Array; |
|
154
|
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
sub STORABLE_freeze { |
|
156
|
4
|
|
|
4
|
|
5
|
my ($self, $cloning) = @_; |
|
157
|
4
|
50
|
|
|
|
15
|
Readonly::_ARRAY(@$self) if $cloning; |
|
158
|
|
|
|
|
|
|
} |
|
159
|
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub TIEARRAY { |
|
161
|
28
|
|
|
28
|
|
685
|
my $whence |
|
162
|
|
|
|
|
|
|
= (caller 1)[3]; # Check if naughty user is trying to tie directly. |
|
163
|
28
|
100
|
|
|
|
122
|
Readonly::croak "Invalid tie" unless $whence =~ /^Readonly::Array1?$/; |
|
164
|
27
|
|
|
|
|
31
|
my $class = shift; |
|
165
|
27
|
|
|
|
|
40
|
my @self = @_; |
|
166
|
27
|
|
|
|
|
153
|
return bless \@self, $class; |
|
167
|
|
|
|
|
|
|
} |
|
168
|
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub FETCH { |
|
170
|
32
|
|
|
32
|
|
7153
|
my $self = shift; |
|
171
|
32
|
|
|
|
|
35
|
my $index = shift; |
|
172
|
32
|
|
|
|
|
128
|
return $self->[$index]; |
|
173
|
|
|
|
|
|
|
} |
|
174
|
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
sub FETCHSIZE { |
|
176
|
14
|
|
|
14
|
|
855
|
my $self = shift; |
|
177
|
14
|
|
|
|
|
39
|
return scalar @$self; |
|
178
|
|
|
|
|
|
|
} |
|
179
|
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
BEGIN { |
|
181
|
14
|
50
|
|
14
|
|
5245
|
eval q{ |
|
|
2
|
|
|
2
|
|
1009
|
|
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
10
|
|
|
182
|
|
|
|
|
|
|
sub EXISTS |
|
183
|
|
|
|
|
|
|
{ |
|
184
|
|
|
|
|
|
|
my $self = shift; |
|
185
|
|
|
|
|
|
|
my $index = shift; |
|
186
|
|
|
|
|
|
|
return exists $self->[$index]; |
|
187
|
|
|
|
|
|
|
} |
|
188
|
|
|
|
|
|
|
} if $] >= 5.006; # couldn't do "exists" on arrays before then |
|
189
|
|
|
|
|
|
|
} |
|
190
|
|
|
|
|
|
|
*STORE = *STORESIZE = *EXTEND = *PUSH = *POP = *UNSHIFT = *SHIFT = *SPLICE |
|
191
|
|
|
|
|
|
|
= *CLEAR = *STORE = *STORESIZE = *EXTEND = *PUSH = *POP = *UNSHIFT |
|
192
|
19
|
|
|
19
|
|
7586
|
= *SHIFT = *SPLICE = *CLEAR = sub { Readonly::croak $Readonly::MODIFY}; |
|
193
|
|
|
|
|
|
|
*UNTIE = *UNTIE |
|
194
|
6
|
100
|
|
6
|
|
508
|
= sub { Readonly::croak $Readonly::MODIFY if caller() ne 'Readonly' }; |
|
195
|
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# ---------------- |
|
197
|
|
|
|
|
|
|
# Read-only hashes |
|
198
|
|
|
|
|
|
|
# ---------------- |
|
199
|
|
|
|
|
|
|
package Readonly::Hash; |
|
200
|
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
sub STORABLE_freeze { |
|
202
|
4
|
|
|
4
|
|
5
|
my ($self, $cloning) = @_; |
|
203
|
4
|
50
|
|
|
|
15
|
Readonly::_HASH(%$self) if $cloning; |
|
204
|
|
|
|
|
|
|
} |
|
205
|
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub TIEHASH { |
|
207
|
25
|
|
|
25
|
|
454
|
my $whence |
|
208
|
|
|
|
|
|
|
= (caller 1)[3]; # Check if naughty user is trying to tie directly. |
|
209
|
25
|
100
|
|
|
|
108
|
Readonly::croak "Invalid tie" unless $whence =~ /^Readonly::Hash1?$/; |
|
210
|
24
|
|
|
|
|
28
|
my $class = shift; |
|
211
|
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
# must have an even number of values |
|
213
|
24
|
50
|
|
|
|
68
|
Readonly::croak $Readonly::ODDHASH unless (@_ % 2 == 0); |
|
214
|
24
|
|
|
|
|
55
|
my %self = @_; |
|
215
|
24
|
|
|
|
|
145
|
return bless \%self, $class; |
|
216
|
|
|
|
|
|
|
} |
|
217
|
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
sub FETCH { |
|
219
|
25
|
|
|
25
|
|
3086
|
my $self = shift; |
|
220
|
25
|
|
|
|
|
25
|
my $key = shift; |
|
221
|
25
|
|
|
|
|
73
|
return $self->{$key}; |
|
222
|
|
|
|
|
|
|
} |
|
223
|
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
sub EXISTS { |
|
225
|
8
|
|
|
8
|
|
416
|
my $self = shift; |
|
226
|
8
|
|
|
|
|
8
|
my $key = shift; |
|
227
|
8
|
|
|
|
|
28
|
return exists $self->{$key}; |
|
228
|
|
|
|
|
|
|
} |
|
229
|
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
sub FIRSTKEY { |
|
231
|
5
|
|
|
5
|
|
2593
|
my $self = shift; |
|
232
|
5
|
|
|
|
|
10
|
my $dummy = keys %$self; |
|
233
|
5
|
|
|
|
|
16
|
return scalar each %$self; |
|
234
|
|
|
|
|
|
|
} |
|
235
|
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
sub NEXTKEY { |
|
237
|
16
|
|
|
16
|
|
21
|
my $self = shift; |
|
238
|
16
|
|
|
|
|
31
|
return scalar each %$self; |
|
239
|
|
|
|
|
|
|
} |
|
240
|
|
|
|
|
|
|
*STORE = *DELETE = *CLEAR = *STORE = *DELETE = *CLEAR |
|
241
|
10
|
|
|
10
|
|
1514
|
= sub { Readonly::croak $Readonly::MODIFY}; |
|
242
|
|
|
|
|
|
|
*UNTIE = *UNTIE |
|
243
|
5
|
100
|
|
5
|
|
653
|
= sub { Readonly::croak $Readonly::MODIFY if caller() ne 'Readonly'; }; |
|
244
|
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
# ---------------------------------------------------------------- |
|
246
|
|
|
|
|
|
|
# Main package, containing convenience functions (so callers won't |
|
247
|
|
|
|
|
|
|
# have to explicitly tie the variables themselves). |
|
248
|
|
|
|
|
|
|
# ---------------------------------------------------------------- |
|
249
|
|
|
|
|
|
|
package Readonly; |
|
250
|
14
|
|
|
14
|
|
68
|
use Exporter; |
|
|
14
|
|
|
|
|
18
|
|
|
|
14
|
|
|
|
|
597
|
|
|
251
|
14
|
|
|
14
|
|
48
|
use vars qw/@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS/; |
|
|
14
|
|
|
|
|
26
|
|
|
|
14
|
|
|
|
|
14512
|
|
|
252
|
|
|
|
|
|
|
push @ISA, 'Exporter'; |
|
253
|
|
|
|
|
|
|
push @EXPORT, qw/Readonly/; |
|
254
|
|
|
|
|
|
|
push @EXPORT_OK, qw/Scalar Array Hash Scalar1 Array1 Hash1/; |
|
255
|
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
# Predeclare the following, so we can use them recursively |
|
257
|
|
|
|
|
|
|
sub Scalar ($$); |
|
258
|
|
|
|
|
|
|
sub Array (\@;@); |
|
259
|
|
|
|
|
|
|
sub Hash (\%;@); |
|
260
|
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
# Returns true if a string begins with "Readonly::" |
|
262
|
|
|
|
|
|
|
# Used to prevent reassignment of Readonly variables. |
|
263
|
|
|
|
|
|
|
sub _is_badtype { |
|
264
|
83
|
|
|
83
|
|
93
|
my $type = $_[0]; |
|
265
|
83
|
100
|
|
|
|
189
|
return lc $type if $type =~ s/^Readonly:://; |
|
266
|
78
|
|
|
|
|
179
|
return; |
|
267
|
|
|
|
|
|
|
} |
|
268
|
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
# Shallow Readonly scalar |
|
270
|
|
|
|
|
|
|
sub Scalar1 ($$) { |
|
271
|
3
|
100
|
|
3
|
1
|
571
|
croak "$REASSIGN scalar" if is_sv_readonly($_[0]); |
|
272
|
2
|
|
|
|
|
6
|
my $badtype = _is_badtype(ref tied $_[0]); |
|
273
|
2
|
50
|
|
|
|
3
|
croak "$REASSIGN $badtype" if $badtype; |
|
274
|
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
# xs method: flag scalar as readonly |
|
276
|
2
|
50
|
|
|
|
5
|
if ($XSokay) { |
|
277
|
2
|
|
|
|
|
3
|
$_[0] = $_[1]; |
|
278
|
2
|
|
|
|
|
3
|
make_sv_readonly($_[0]); |
|
279
|
2
|
|
|
|
|
2
|
return; |
|
280
|
|
|
|
|
|
|
} |
|
281
|
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
# pure-perl method: tied scalar |
|
283
|
0
|
|
|
|
|
0
|
my $tieobj = eval { tie $_[0], 'Readonly::Scalar', $_[1] }; |
|
|
0
|
|
|
|
|
0
|
|
|
284
|
0
|
0
|
|
|
|
0
|
if ($@) { |
|
285
|
0
|
0
|
|
|
|
0
|
croak "$REASSIGN scalar" if substr($@, 0, 43) eq $MODIFY; |
|
286
|
0
|
|
|
|
|
0
|
die $@; # some other error? |
|
287
|
|
|
|
|
|
|
} |
|
288
|
0
|
|
|
|
|
0
|
return $tieobj; |
|
289
|
|
|
|
|
|
|
} |
|
290
|
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
# Shallow Readonly array |
|
292
|
|
|
|
|
|
|
sub Array1 (\@;@) { |
|
293
|
2
|
|
|
2
|
1
|
1108
|
my $badtype = _is_badtype(ref tied $_[0]); |
|
294
|
2
|
50
|
|
|
|
5
|
croak "$REASSIGN $badtype" if $badtype; |
|
295
|
2
|
|
|
|
|
3
|
my $aref = shift; |
|
296
|
2
|
|
|
|
|
8
|
return tie @$aref, 'Readonly::Array', @_; |
|
297
|
|
|
|
|
|
|
} |
|
298
|
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
# Shallow Readonly hash |
|
300
|
|
|
|
|
|
|
sub Hash1 (\%;@) { |
|
301
|
1
|
|
|
1
|
1
|
566
|
my $badtype = _is_badtype(ref tied $_[0]); |
|
302
|
1
|
50
|
|
|
|
2
|
croak "$REASSIGN $badtype" if $badtype; |
|
303
|
1
|
|
|
|
|
1
|
my $href = shift; |
|
304
|
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# If only one value, and it's a hashref, expand it |
|
306
|
1
|
50
|
33
|
|
|
6
|
if (@_ == 1 && ref $_[0] eq 'HASH') { |
|
307
|
0
|
|
|
|
|
0
|
return tie %$href, 'Readonly::Hash', %{$_[0]}; |
|
|
0
|
|
|
|
|
0
|
|
|
308
|
|
|
|
|
|
|
} |
|
309
|
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
# otherwise, must have an even number of values |
|
311
|
1
|
50
|
|
|
|
3
|
croak $ODDHASH unless (@_ % 2 == 0); |
|
312
|
1
|
|
|
|
|
3
|
return tie %$href, 'Readonly::Hash', @_; |
|
313
|
|
|
|
|
|
|
} |
|
314
|
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
# Deep Readonly scalar |
|
316
|
|
|
|
|
|
|
sub Scalar ($$) { |
|
317
|
17
|
100
|
|
17
|
1
|
4080
|
croak "$REASSIGN scalar" if is_sv_readonly($_[0]); |
|
318
|
15
|
|
|
|
|
32
|
my $badtype = _is_badtype(ref tied $_[0]); |
|
319
|
15
|
50
|
|
|
|
28
|
croak "$REASSIGN $badtype" if $badtype; |
|
320
|
15
|
|
|
|
|
15
|
my $value = $_[1]; |
|
321
|
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
# Recursively check passed element for references; if any, make them Readonly |
|
323
|
15
|
|
|
|
|
35
|
foreach ($value) { |
|
324
|
15
|
100
|
|
|
|
63
|
if (ref eq 'SCALAR') { Scalar my $v => $$_; $_ = \$v } |
|
|
1
|
100
|
|
|
|
6
|
|
|
|
1
|
100
|
|
|
|
1
|
|
|
325
|
2
|
|
|
|
|
20
|
elsif (ref eq 'ARRAY') { Array my @v => @$_; $_ = \@v } |
|
|
2
|
|
|
|
|
4
|
|
|
326
|
2
|
|
|
|
|
5
|
elsif (ref eq 'HASH') { Hash my %v => $_; $_ = \%v } |
|
|
2
|
|
|
|
|
4
|
|
|
327
|
|
|
|
|
|
|
} |
|
328
|
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
# xs method: flag scalar as readonly |
|
330
|
15
|
50
|
|
|
|
59
|
if ($XSokay) { |
|
331
|
15
|
|
|
|
|
16
|
$_[0] = $value; |
|
332
|
15
|
|
|
|
|
25
|
make_sv_readonly($_[0]); |
|
333
|
15
|
|
|
|
|
23
|
return; |
|
334
|
|
|
|
|
|
|
} |
|
335
|
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
# pure-perl method: tied scalar |
|
337
|
0
|
|
|
|
|
0
|
my $tieobj = eval { tie $_[0], 'Readonly::Scalar', $value }; |
|
|
0
|
|
|
|
|
0
|
|
|
338
|
0
|
0
|
|
|
|
0
|
if ($@) { |
|
339
|
0
|
0
|
|
|
|
0
|
croak "$REASSIGN scalar" if substr($@, 0, 43) eq $MODIFY; |
|
340
|
0
|
|
|
|
|
0
|
die $@; # some other error? |
|
341
|
|
|
|
|
|
|
} |
|
342
|
0
|
|
|
|
|
0
|
return $tieobj; |
|
343
|
|
|
|
|
|
|
} |
|
344
|
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
# Deep Readonly array |
|
346
|
|
|
|
|
|
|
sub Array (\@;@) { |
|
347
|
27
|
|
|
27
|
1
|
4196
|
my $badtype = _is_badtype(ref tied @{$_[0]}); |
|
|
27
|
|
|
|
|
66
|
|
|
348
|
27
|
100
|
|
|
|
64
|
croak "$REASSIGN $badtype" if $badtype; |
|
349
|
25
|
|
|
|
|
59
|
my $aref = shift; |
|
350
|
25
|
|
|
|
|
43
|
my @values = @_; |
|
351
|
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
# Recursively check passed elements for references; if any, make them Readonly |
|
353
|
25
|
|
|
|
|
43
|
foreach (@values) { |
|
354
|
67
|
100
|
|
|
|
170
|
if (ref eq 'SCALAR') { Scalar my $v => $$_; $_ = \$v } |
|
|
1
|
100
|
|
|
|
4
|
|
|
|
1
|
100
|
|
|
|
2
|
|
|
355
|
1
|
|
|
|
|
4
|
elsif (ref eq 'ARRAY') { Array my @v => @$_; $_ = \@v } |
|
|
1
|
|
|
|
|
2
|
|
|
356
|
3
|
|
|
|
|
8
|
elsif (ref eq 'HASH') { Hash my %v => $_; $_ = \%v } |
|
|
3
|
|
|
|
|
7
|
|
|
357
|
|
|
|
|
|
|
} |
|
358
|
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
# Lastly, tie the passed reference |
|
360
|
25
|
|
|
|
|
97
|
return tie @$aref, 'Readonly::Array', @values; |
|
361
|
|
|
|
|
|
|
} |
|
362
|
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
# Deep Readonly hash |
|
364
|
|
|
|
|
|
|
sub Hash (\%;@) { |
|
365
|
27
|
|
|
27
|
1
|
3034
|
my $badtype = _is_badtype(ref tied %{$_[0]}); |
|
|
27
|
|
|
|
|
59
|
|
|
366
|
27
|
100
|
|
|
|
57
|
croak "$REASSIGN $badtype" if $badtype; |
|
367
|
25
|
|
|
|
|
23
|
my $href = shift; |
|
368
|
25
|
|
|
|
|
38
|
my @values = @_; |
|
369
|
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
# If only one value, and it's a hashref, expand it |
|
371
|
25
|
100
|
66
|
|
|
97
|
if (@_ == 1 && ref $_[0] eq 'HASH') { |
|
372
|
11
|
|
|
|
|
11
|
@values = %{$_[0]}; |
|
|
11
|
|
|
|
|
51
|
|
|
373
|
|
|
|
|
|
|
} |
|
374
|
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
# otherwise, must have an even number of values |
|
376
|
25
|
100
|
|
|
|
63
|
croak $ODDHASH unless (@values % 2 == 0); |
|
377
|
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
# Recursively check passed elements for references; if any, make them Readonly |
|
379
|
23
|
|
|
|
|
41
|
foreach (@values) { |
|
380
|
78
|
100
|
|
|
|
187
|
if (ref eq 'SCALAR') { Scalar my $v => $$_; $_ = \$v } |
|
|
1
|
100
|
|
|
|
3
|
|
|
|
1
|
100
|
|
|
|
2
|
|
|
381
|
3
|
|
|
|
|
14
|
elsif (ref eq 'ARRAY') { Array my @v => @$_; $_ = \@v } |
|
|
3
|
|
|
|
|
6
|
|
|
382
|
1
|
|
|
|
|
4
|
elsif (ref eq 'HASH') { Hash my %v => $_; $_ = \%v } |
|
|
1
|
|
|
|
|
2
|
|
|
383
|
|
|
|
|
|
|
} |
|
384
|
23
|
|
|
|
|
86
|
return tie %$href, 'Readonly::Hash', @values; |
|
385
|
|
|
|
|
|
|
} |
|
386
|
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
sub Clone(\[$@%]) { |
|
388
|
8
|
|
|
8
|
0
|
2263
|
require Storable; |
|
389
|
8
|
|
|
|
|
2367
|
my $retval = Storable::dclone($_[0]); |
|
390
|
8
|
100
|
|
|
|
22
|
$retval = $$retval if ref $retval eq 'REF'; |
|
391
|
8
|
|
|
|
|
8
|
my $reftype = ref $retval; |
|
392
|
8
|
100
|
|
|
|
23
|
if ($reftype eq 'SCALAR') { |
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
393
|
1
|
|
|
|
|
2
|
_SCALAR($retval); |
|
394
|
1
|
|
|
|
|
3
|
return $$retval; |
|
395
|
|
|
|
|
|
|
} |
|
396
|
|
|
|
|
|
|
elsif ($reftype eq 'ARRAY') { |
|
397
|
3
|
|
|
|
|
7
|
_ARRAY(@$retval); |
|
398
|
|
|
|
|
|
|
} |
|
399
|
|
|
|
|
|
|
elsif ($reftype eq 'HASH') { |
|
400
|
4
|
|
|
|
|
5
|
_HASH(%$retval); |
|
401
|
4
|
100
|
|
|
|
15
|
return %$retval if wantarray; |
|
402
|
|
|
|
|
|
|
} |
|
403
|
4
|
|
|
|
|
6
|
return $retval; |
|
404
|
|
|
|
|
|
|
} |
|
405
|
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
# Common entry-point for all supported data types |
|
407
|
24
|
50
|
100
|
24
|
1
|
11158
|
eval q{sub Readonly} . ($] < 5.008 ? '' : '(\[$@%]@)') . <<'SUB_READONLY'; |
|
|
9
|
100
|
66
|
|
|
10
|
|
|
|
9
|
50
|
100
|
|
|
34
|
|
|
|
9
|
100
|
|
|
|
11
|
|
|
|
9
|
0
|
|
|
|
24
|
|
|
|
9
|
50
|
|
|
|
24
|
|
|
|
8
|
100
|
|
|
|
18
|
|
|
|
8
|
100
|
|
|
|
21
|
|
|
|
5
|
100
|
|
|
|
20
|
|
|
|
4
|
50
|
|
|
|
6
|
|
|
|
4
|
0
|
|
|
|
3
|
|
|
|
4
|
|
|
|
|
22
|
|
|
|
4
|
|
|
|
|
10
|
|
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
|
4
|
|
|
|
|
30
|
|
|
|
6
|
|
|
|
|
9
|
|
|
|
6
|
|
|
|
|
21
|
|
|
|
9
|
|
|
|
|
21
|
|
|
|
9
|
|
|
|
|
54
|
|
|
|
8
|
|
|
|
|
22
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
{ |
|
409
|
|
|
|
|
|
|
if (ref $_[0] eq 'SCALAR') |
|
410
|
|
|
|
|
|
|
{ |
|
411
|
|
|
|
|
|
|
croak $MODIFY if is_sv_readonly ${$_[0]}; |
|
412
|
|
|
|
|
|
|
my $badtype = _is_badtype (ref tied ${$_[0]}); |
|
413
|
|
|
|
|
|
|
croak "$REASSIGN $badtype" if $badtype; |
|
414
|
|
|
|
|
|
|
croak "Readonly scalar must have only one value" if @_ > 2; |
|
415
|
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
# Because of problems with handling \$ prototypes declarations like |
|
417
|
|
|
|
|
|
|
# Readonly my @a = ... and Readonly my %h = ... are also caught here |
|
418
|
|
|
|
|
|
|
croak 'Invalid initialization by assignment' |
|
419
|
|
|
|
|
|
|
if @_ == 1 && defined ${$_[0]}; |
|
420
|
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
my $tieobj = eval {tie ${$_[0]}, 'Readonly::Scalar', $_[1]}; |
|
422
|
|
|
|
|
|
|
# Tie may have failed because user tried to tie a constant, or we screwed up somehow. |
|
423
|
|
|
|
|
|
|
if ($@) |
|
424
|
|
|
|
|
|
|
{ |
|
425
|
|
|
|
|
|
|
croak $MODIFY if $@ =~ /^$MODIFY at/; # Point the finger at the user. |
|
426
|
|
|
|
|
|
|
die "$@\n"; # Not a modify read-only message; must be our fault. |
|
427
|
|
|
|
|
|
|
} |
|
428
|
|
|
|
|
|
|
return $tieobj; |
|
429
|
|
|
|
|
|
|
} |
|
430
|
|
|
|
|
|
|
elsif (ref $_[0] eq 'ARRAY') |
|
431
|
|
|
|
|
|
|
{ |
|
432
|
|
|
|
|
|
|
my $aref = shift; |
|
433
|
|
|
|
|
|
|
return Array @$aref, @_; |
|
434
|
|
|
|
|
|
|
} |
|
435
|
|
|
|
|
|
|
elsif (ref $_[0] eq 'HASH') |
|
436
|
|
|
|
|
|
|
{ |
|
437
|
|
|
|
|
|
|
my $href = shift; |
|
438
|
|
|
|
|
|
|
croak $ODDHASH if @_%2 != 0 && !(@_ == 1 && ref $_[0] eq 'HASH'); |
|
439
|
|
|
|
|
|
|
return Hash %$href, @_; |
|
440
|
|
|
|
|
|
|
} |
|
441
|
|
|
|
|
|
|
elsif (ref $_[0]) |
|
442
|
|
|
|
|
|
|
{ |
|
443
|
|
|
|
|
|
|
croak "Readonly only supports scalar, array, and hash variables."; |
|
444
|
|
|
|
|
|
|
} |
|
445
|
|
|
|
|
|
|
else |
|
446
|
|
|
|
|
|
|
{ |
|
447
|
|
|
|
|
|
|
croak "First argument to Readonly must be a reference."; |
|
448
|
|
|
|
|
|
|
} |
|
449
|
|
|
|
|
|
|
} |
|
450
|
|
|
|
|
|
|
SUB_READONLY |
|
451
|
|
|
|
|
|
|
1; |
|
452
|
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
=head1 NAME |
|
454
|
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
Readonly - Facility for creating read-only scalars, arrays, hashes |
|
456
|
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
=head1 Synopsis |
|
458
|
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
use Readonly; |
|
460
|
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
# Deep Read-only scalar |
|
462
|
|
|
|
|
|
|
Readonly::Scalar $sca => $initial_value; |
|
463
|
|
|
|
|
|
|
Readonly::Scalar my $sca => $initial_value; |
|
464
|
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# Deep Read-only array |
|
466
|
|
|
|
|
|
|
Readonly::Array @arr => @values; |
|
467
|
|
|
|
|
|
|
Readonly::Array my @arr => @values; |
|
468
|
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
# Deep Read-only hash |
|
470
|
|
|
|
|
|
|
Readonly::Hash %has => (key => value, key => value, ...); |
|
471
|
|
|
|
|
|
|
Readonly::Hash my %has => (key => value, key => value, ...); |
|
472
|
|
|
|
|
|
|
# or: |
|
473
|
|
|
|
|
|
|
Readonly::Hash %has => {key => value, key => value, ...}; |
|
474
|
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
# You can use the read-only variables like any regular variables: |
|
476
|
|
|
|
|
|
|
print $sca; |
|
477
|
|
|
|
|
|
|
$something = $sca + $arr[2]; |
|
478
|
|
|
|
|
|
|
next if $has{$some_key}; |
|
479
|
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
# But if you try to modify a value, your program will die: |
|
481
|
|
|
|
|
|
|
$sca = 7; |
|
482
|
|
|
|
|
|
|
push @arr, 'seven'; |
|
483
|
|
|
|
|
|
|
delete $has{key}; |
|
484
|
|
|
|
|
|
|
# The error message is "Modification of a read-only value attempted" |
|
485
|
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
# Alternate form (Perl 5.8 and later) |
|
487
|
|
|
|
|
|
|
Readonly $sca => $initial_value; |
|
488
|
|
|
|
|
|
|
Readonly my $sca => $initial_value; |
|
489
|
|
|
|
|
|
|
Readonly @arr => @values; |
|
490
|
|
|
|
|
|
|
Readonly my @arr => @values; |
|
491
|
|
|
|
|
|
|
Readonly %has => (key => value, key => value, ...); |
|
492
|
|
|
|
|
|
|
Readonly my %has => (key => value, key => value, ...); |
|
493
|
|
|
|
|
|
|
Readonly my $sca; # Implicit undef, readonly value |
|
494
|
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
# Alternate form (for Perls earlier than v5.8) |
|
496
|
|
|
|
|
|
|
Readonly \$sca => $initial_value; |
|
497
|
|
|
|
|
|
|
Readonly \my $sca => $initial_value; |
|
498
|
|
|
|
|
|
|
Readonly \@arr => @values; |
|
499
|
|
|
|
|
|
|
Readonly \my @arr => @values; |
|
500
|
|
|
|
|
|
|
Readonly \%has => (key => value, key => value, ...); |
|
501
|
|
|
|
|
|
|
Readonly \my %has => (key => value, key => value, ...); |
|
502
|
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
=head1 Description |
|
504
|
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
This is a facility for creating non-modifiable variables. This is useful for |
|
506
|
|
|
|
|
|
|
configuration files, headers, etc. It can also be useful as a development and |
|
507
|
|
|
|
|
|
|
debugging tool for catching updates to variables that should not be changed. |
|
508
|
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=head1 Variable Depth |
|
510
|
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
Readonly has the ability to create both deep and shallow readonly variables. |
|
512
|
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
If you pass a C<$ref>, an C<@array> or a C<%hash> to corresponding functions |
|
514
|
|
|
|
|
|
|
C<::Scalar()>, C<::Array()> and C<::Hash()>, then those functions recurse over |
|
515
|
|
|
|
|
|
|
the data structure, marking everything as readonly. The entire structure is |
|
516
|
|
|
|
|
|
|
then non-modifiable. This is normally what you want. |
|
517
|
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
If you want only the top level to be readonly, use the alternate (and poorly |
|
519
|
|
|
|
|
|
|
named) C<::Scalar1()>, C<::Array1()>, and C<::Hash1()> functions. |
|
520
|
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
Plain C creates what the original author calls a "shallow" |
|
522
|
|
|
|
|
|
|
readonly variable, which is great if you don't plan to use it on anything but |
|
523
|
|
|
|
|
|
|
only one dimensional scalar values. |
|
524
|
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
C makes the variable 'deeply' readonly, so the following |
|
526
|
|
|
|
|
|
|
snippet kills over as you expect: |
|
527
|
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
use Readonly; |
|
529
|
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
Readonly::Scalar my $ref => { 1 => 'a' }; |
|
531
|
|
|
|
|
|
|
$ref->{1} = 'b'; |
|
532
|
|
|
|
|
|
|
$ref->{2} = 'b'; |
|
533
|
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
While the following snippet does B make your structure 'deeply' readonly: |
|
535
|
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
use Readonly; |
|
537
|
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
Readonly my $ref => { 1 => 'a' }; |
|
539
|
|
|
|
|
|
|
$ref->{1} = 'b'; |
|
540
|
|
|
|
|
|
|
$ref->{2} = 'b'; |
|
541
|
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
=head1 |
|
543
|
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
=head1 The Past |
|
545
|
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
The following sections are updated versions of the previous authors |
|
547
|
|
|
|
|
|
|
documentation. |
|
548
|
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
=head2 Comparison with "use constant" |
|
550
|
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
Perl provides a facility for creating constant values, via the L |
|
552
|
|
|
|
|
|
|
pragma. There are several problems with this pragma. |
|
553
|
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
=over 2 |
|
555
|
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
=item * The constants created have no leading sigils. |
|
557
|
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
=item * These constants cannot be interpolated into strings. |
|
559
|
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
=item * Syntax can get dicey sometimes. For example: |
|
561
|
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
use constant CARRAY => (2, 3, 5, 7, 11, 13); |
|
563
|
|
|
|
|
|
|
$a_prime = CARRAY[2]; # wrong! |
|
564
|
|
|
|
|
|
|
$a_prime = (CARRAY)[2]; # right -- MUST use parentheses |
|
565
|
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
=item * You have to be very careful in places where barewords are allowed. |
|
567
|
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
For example: |
|
569
|
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
use constant SOME_KEY => 'key'; |
|
571
|
|
|
|
|
|
|
%hash = (key => 'value', other_key => 'other_value'); |
|
572
|
|
|
|
|
|
|
$some_value = $hash{SOME_KEY}; # wrong! |
|
573
|
|
|
|
|
|
|
$some_value = $hash{+SOME_KEY}; # right |
|
574
|
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
(who thinks to use a unary plus when using a hash to scalarize the key?) |
|
576
|
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
=item * C |
|
578
|
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
=item * These constants are global to the package in which they're declared; |
|
580
|
|
|
|
|
|
|
cannot be lexically scoped. |
|
581
|
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
=item * Works only at compile time. |
|
583
|
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
=item * Can be overridden: |
|
585
|
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
use constant PI => 3.14159; |
|
587
|
|
|
|
|
|
|
... |
|
588
|
|
|
|
|
|
|
use constant PI => 2.71828; |
|
589
|
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
(this does generate a warning, however, if you have warnings enabled). |
|
591
|
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
=item * It is very difficult to make and use deep structures (complex data |
|
593
|
|
|
|
|
|
|
structures) with C |
|
594
|
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
=back |
|
596
|
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
=head1 Comparison with typeglob constants |
|
598
|
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
Another popular way to create read-only scalars is to modify the symbol table |
|
600
|
|
|
|
|
|
|
entry for the variable by using a typeglob: |
|
601
|
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
*a = \'value'; |
|
603
|
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
This works fine, but it only works for global variables ("my" variables have |
|
605
|
|
|
|
|
|
|
no symbol table entry). Also, the following similar constructs do B work: |
|
606
|
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
*a = [1, 2, 3]; # Does NOT create a read-only array |
|
608
|
|
|
|
|
|
|
*a = { a => 'A'}; # Does NOT create a read-only hash |
|
609
|
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
=head2 Pros |
|
611
|
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
Readonly.pm, on the other hand, will work with global variables and with |
|
613
|
|
|
|
|
|
|
lexical ("my") variables. It will create scalars, arrays, or hashes, all of |
|
614
|
|
|
|
|
|
|
which look and work like normal, read-write Perl variables. You can use them |
|
615
|
|
|
|
|
|
|
in scalar context, in list context; you can take references to them, pass them |
|
616
|
|
|
|
|
|
|
to functions, anything. |
|
617
|
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
Readonly.pm also works well with complex data structures, allowing you to tag |
|
619
|
|
|
|
|
|
|
the whole structure as nonmodifiable, or just the top level. |
|
620
|
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
Also, Readonly variables may not be reassigned. The following code will die: |
|
622
|
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
Readonly::Scalar $pi => 3.14159; |
|
624
|
|
|
|
|
|
|
... |
|
625
|
|
|
|
|
|
|
Readonly::Scalar $pi => 2.71828; |
|
626
|
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
=head2 Cons |
|
628
|
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
Readonly.pm used to impose a performance penalty. It was pretty slow. How |
|
630
|
|
|
|
|
|
|
slow? Run the C script that comes with Readonly. On my test |
|
631
|
|
|
|
|
|
|
system, "use constant" (const), typeglob constants (tglob), regular read/write |
|
632
|
|
|
|
|
|
|
Perl variables (normal/literal), and the new Readonly (ro/ro_simple) are all |
|
633
|
|
|
|
|
|
|
about the same speed, the old, tie based Readonly.pm constants were about 1/22 |
|
634
|
|
|
|
|
|
|
the speed. |
|
635
|
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
However, there is relief. There is a companion module available, Readonly::XS. |
|
637
|
|
|
|
|
|
|
You won't need this if you're using Perl 5.8.x or higher. |
|
638
|
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
I repeat, you do not need Readonly::XS if your environment has perl 5.8.x or |
|
640
|
|
|
|
|
|
|
higher. Please see section entitled L for more. |
|
641
|
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
=head1 Functions |
|
643
|
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
=over 4 |
|
645
|
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
=item Readonly::Scalar $var => $value; |
|
647
|
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
Creates a nonmodifiable scalar, C<$var>, and assigns a value of C<$value> to |
|
649
|
|
|
|
|
|
|
it. Thereafter, its value may not be changed. Any attempt to modify the value |
|
650
|
|
|
|
|
|
|
will cause your program to die. |
|
651
|
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
A value I be supplied. If you want the variable to have C as its |
|
653
|
|
|
|
|
|
|
value, you must specify C. |
|
654
|
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
If C<$value> is a reference to a scalar, array, or hash, then this function |
|
656
|
|
|
|
|
|
|
will mark the scalar, array, or hash it points to as being Readonly as well, |
|
657
|
|
|
|
|
|
|
and it will recursively traverse the structure, marking the whole thing as |
|
658
|
|
|
|
|
|
|
Readonly. Usually, this is what you want. However, if you want only the |
|
659
|
|
|
|
|
|
|
C<$value> marked as Readonly, use C. |
|
660
|
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
If $var is already a Readonly variable, the program will die with an error |
|
662
|
|
|
|
|
|
|
about reassigning Readonly variables. |
|
663
|
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
=item Readonly::Array @arr => (value, value, ...); |
|
665
|
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
Creates a nonmodifiable array, C<@arr>, and assigns the specified list of |
|
667
|
|
|
|
|
|
|
values to it. Thereafter, none of its values may be changed; the array may not |
|
668
|
|
|
|
|
|
|
be lengthened or shortened or spliced. Any attempt to do so will cause your |
|
669
|
|
|
|
|
|
|
program to die. |
|
670
|
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
If any of the values passed is a reference to a scalar, array, or hash, then |
|
672
|
|
|
|
|
|
|
this function will mark the scalar, array, or hash it points to as being |
|
673
|
|
|
|
|
|
|
Readonly as well, and it will recursively traverse the structure, marking the |
|
674
|
|
|
|
|
|
|
whole thing as Readonly. Usually, this is what you want. However, if you want |
|
675
|
|
|
|
|
|
|
only the hash C<%@arr> itself marked as Readonly, use C. |
|
676
|
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
If C<@arr> is already a Readonly variable, the program will die with an error |
|
678
|
|
|
|
|
|
|
about reassigning Readonly variables. |
|
679
|
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
=item Readonly::Hash %h => (key => value, key => value, ...); |
|
681
|
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
=item Readonly::Hash %h => {key => value, key => value, ...}; |
|
683
|
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
Creates a nonmodifiable hash, C<%h>, and assigns the specified keys and values |
|
685
|
|
|
|
|
|
|
to it. Thereafter, its keys or values may not be changed. Any attempt to do so |
|
686
|
|
|
|
|
|
|
will cause your program to die. |
|
687
|
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
A list of keys and values may be specified (with parentheses in the synopsis |
|
689
|
|
|
|
|
|
|
above), or a hash reference may be specified (curly braces in the synopsis |
|
690
|
|
|
|
|
|
|
above). If a list is specified, it must have an even number of elements, or |
|
691
|
|
|
|
|
|
|
the function will die. |
|
692
|
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
If any of the values is a reference to a scalar, array, or hash, then this |
|
694
|
|
|
|
|
|
|
function will mark the scalar, array, or hash it points to as being Readonly |
|
695
|
|
|
|
|
|
|
as well, and it will recursively traverse the structure, marking the whole |
|
696
|
|
|
|
|
|
|
thing as Readonly. Usually, this is what you want. However, if you want only |
|
697
|
|
|
|
|
|
|
the hash C<%h> itself marked as Readonly, use C. |
|
698
|
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
If C<%h> is already a Readonly variable, the program will die with an error |
|
700
|
|
|
|
|
|
|
about reassigning Readonly variables. |
|
701
|
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
=item Readonly $var => $value; |
|
703
|
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
=item Readonly @arr => (value, value, ...); |
|
705
|
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
=item Readonly %h => (key => value, ...); |
|
707
|
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
=item Readonly %h => {key => value, ...}; |
|
709
|
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
=item Readonly $var; |
|
711
|
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
The C function is an alternate to the C, C, and |
|
713
|
|
|
|
|
|
|
C functions. It has the advantage (if you consider it an advantage) of |
|
714
|
|
|
|
|
|
|
being one function. That may make your program look neater, if you're |
|
715
|
|
|
|
|
|
|
initializing a whole bunch of constants at once. You may or may not prefer |
|
716
|
|
|
|
|
|
|
this uniform style. |
|
717
|
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
It has the disadvantage of having a slightly different syntax for versions of |
|
719
|
|
|
|
|
|
|
Perl prior to 5.8. For earlier versions, you must supply a backslash, because |
|
720
|
|
|
|
|
|
|
it requires a reference as the first parameter. |
|
721
|
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
Readonly \$var => $value; |
|
723
|
|
|
|
|
|
|
Readonly \@arr => (value, value, ...); |
|
724
|
|
|
|
|
|
|
Readonly \%h => (key => value, ...); |
|
725
|
|
|
|
|
|
|
Readonly \%h => {key => value, ...}; |
|
726
|
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
You may or may not consider this ugly. |
|
728
|
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
Note that you can create implicit undefined variables with this function like |
|
730
|
|
|
|
|
|
|
so C while a verbose undefined value must be passed to the |
|
731
|
|
|
|
|
|
|
standard C, C, and C functions. |
|
732
|
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
=item Readonly::Scalar1 $var => $value; |
|
734
|
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
=item Readonly::Array1 @arr => (value, value, ...); |
|
736
|
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
=item Readonly::Hash1 %h => (key => value, key => value, ...); |
|
738
|
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
=item Readonly::Hash1 %h => {key => value, key => value, ...}; |
|
740
|
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
These alternate functions create shallow Readonly variables, instead of deep |
|
742
|
|
|
|
|
|
|
ones. For example: |
|
743
|
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
Readonly::Array1 @shal => (1, 2, {perl=>'Rules', java=>'Bites'}, 4, 5); |
|
745
|
|
|
|
|
|
|
Readonly::Array @deep => (1, 2, {perl=>'Rules', java=>'Bites'}, 4, 5); |
|
746
|
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
$shal[1] = 7; # error |
|
748
|
|
|
|
|
|
|
$shal[2]{APL}='Weird'; # Allowed! since the hash isn't Readonly |
|
749
|
|
|
|
|
|
|
$deep[1] = 7; # error |
|
750
|
|
|
|
|
|
|
$deep[2]{APL}='Weird'; # error, since the hash is Readonly |
|
751
|
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=back |
|
753
|
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=head1 Cloning |
|
755
|
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
When cloning using L or L you will notice that the value stays |
|
757
|
|
|
|
|
|
|
readonly, which is correct. If you want to clone the value without copying the |
|
758
|
|
|
|
|
|
|
readonly flag, use the C function: |
|
759
|
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
Readonly::Scalar my $scalar => {qw[this that]}; |
|
761
|
|
|
|
|
|
|
# $scalar->{'eh'} = 'foo'; # Modification of a read-only value attempted |
|
762
|
|
|
|
|
|
|
my $scalar_clone = Readonly::Clone $scalar; |
|
763
|
|
|
|
|
|
|
$scalar_clone->{'eh'} = 'foo'; |
|
764
|
|
|
|
|
|
|
# $scalar_clone is now {this => 'that', eh => 'foo'}; |
|
765
|
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
The new variable (C<$scalar_clone>) is a mutable clone of the original |
|
767
|
|
|
|
|
|
|
C<$scalar>. |
|
768
|
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
=head1 Examples |
|
770
|
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
These are a few very simple examples: |
|
772
|
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
=head2 Scalars |
|
774
|
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
A plain old read-only value |
|
776
|
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
Readonly::Scalar $a => "A string value"; |
|
778
|
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
The value need not be a compile-time constant: |
|
780
|
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
Readonly::Scalar $a => $computed_value; |
|
782
|
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
=head2 Arrays/Lists |
|
784
|
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
A read-only array: |
|
786
|
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
Readonly::Array @a => (1, 2, 3, 4); |
|
788
|
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
The parentheses are optional: |
|
790
|
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
Readonly::Array @a => 1, 2, 3, 4; |
|
792
|
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
You can use Perl's built-in array quoting syntax: |
|
794
|
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
Readonly::Array @a => qw/1 2 3 4/; |
|
796
|
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
You can initialize a read-only array from a variable one: |
|
798
|
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
Readonly::Array @a => @computed_values; |
|
800
|
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
A read-only array can be empty, too: |
|
802
|
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
Readonly::Array @a => (); |
|
804
|
|
|
|
|
|
|
Readonly::Array @a; # equivalent |
|
805
|
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
=head2 Hashes |
|
807
|
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
Typical usage: |
|
809
|
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
Readonly::Hash %a => (key1 => 'value1', key2 => 'value2'); |
|
811
|
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
A read-only hash can be initialized from a variable one: |
|
813
|
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
Readonly::Hash %a => %computed_values; |
|
815
|
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
A read-only hash can be empty: |
|
817
|
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
Readonly::Hash %a => (); |
|
819
|
|
|
|
|
|
|
Readonly::Hash %a; # equivalent |
|
820
|
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
If you pass an odd number of values, the program will die: |
|
822
|
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
Readonly::Hash %a => (key1 => 'value1', "value2"); |
|
824
|
|
|
|
|
|
|
# This dies with "May not store an odd number of values in a hash" |
|
825
|
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
=head1 Exports |
|
827
|
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
Historically, this module exports the C symbol into the calling |
|
829
|
|
|
|
|
|
|
program's namespace by default. The following symbols are also available for |
|
830
|
|
|
|
|
|
|
import into your program, if you like: C, C, C, |
|
831
|
|
|
|
|
|
|
C, C, and C. |
|
832
|
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
=head1 Internals |
|
834
|
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
Some people simply do not understand the relationship between this module and |
|
836
|
|
|
|
|
|
|
Readonly::XS so I'm adding this section. Odds are, they still won't understand |
|
837
|
|
|
|
|
|
|
but I like to write so... |
|
838
|
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
In the past, Readonly's "magic" was performed by C-ing variables to the |
|
840
|
|
|
|
|
|
|
C, C, and C packages (not |
|
841
|
|
|
|
|
|
|
to be confused with the functions of the same names) and acting on C, |
|
842
|
|
|
|
|
|
|
C, et. al. While this worked well, it was slow. Very slow. Like 20-30 |
|
843
|
|
|
|
|
|
|
times slower than accessing variables directly or using one of the other |
|
844
|
|
|
|
|
|
|
const-related modules that have cropped up since Readonly was released in |
|
845
|
|
|
|
|
|
|
2003. |
|
846
|
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
To 'fix' this, Readonly::XS was written. If installed, Readonly::XS used the |
|
848
|
|
|
|
|
|
|
internal methods C and C to lock simple scalars. On |
|
849
|
|
|
|
|
|
|
the surface, everything was peachy but things weren't the same behind the |
|
850
|
|
|
|
|
|
|
scenes. In edge cases, code performed very differently if Readonly::XS was |
|
851
|
|
|
|
|
|
|
installed and because it wasn't a required dependency in most code, it made |
|
852
|
|
|
|
|
|
|
downstream bugs very hard to track. |
|
853
|
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
In the years since Readonly::XS was released, the then private internal |
|
855
|
|
|
|
|
|
|
methods have been exposed and can be used in pure perl. Similar modules were |
|
856
|
|
|
|
|
|
|
written to take advantage of this and a patch to Readonly was created. We no |
|
857
|
|
|
|
|
|
|
longer need to build and install another module to make Readonly useful on |
|
858
|
|
|
|
|
|
|
modern builds of perl. |
|
859
|
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
=over |
|
861
|
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
=item * You do not need to install Readonly::XS. |
|
863
|
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
=item * You should stop listing Readonly::XS as a dependency or expect it to |
|
865
|
|
|
|
|
|
|
be installed. |
|
866
|
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
=item * Stop testing the C<$Readonly::XSokay> variable! |
|
868
|
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
=back |
|
870
|
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=head1 Requirements |
|
872
|
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
Please note that most users of Readonly no longer need to install the |
|
874
|
|
|
|
|
|
|
companion module Readonly::XS which is recommended but not required for perl |
|
875
|
|
|
|
|
|
|
5.6.x and under. Please do not force it as a requirement in new code and do |
|
876
|
|
|
|
|
|
|
not use the package variable C<$Readonly::XSokay> in code/tests. For more, see |
|
877
|
|
|
|
|
|
|
L. |
|
878
|
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
There are no non-core requirements. |
|
880
|
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
=head1 Bug Reports |
|
882
|
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
If email is better for you, L but I |
|
884
|
|
|
|
|
|
|
would rather have bugs sent through the issue tracker found at |
|
885
|
|
|
|
|
|
|
http://github.com/sanko/readonly/issues. |
|
886
|
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
=head1 Acknowledgements |
|
888
|
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
Thanks to Slaven Rezic for the idea of one common function (Readonly) for all |
|
890
|
|
|
|
|
|
|
three types of variables (13 April 2002). |
|
891
|
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
Thanks to Ernest Lergon for the idea (and initial code) for deeply-Readonly |
|
893
|
|
|
|
|
|
|
data structures (21 May 2002). |
|
894
|
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
Thanks to Damian Conway for the idea (and code) for making the Readonly |
|
896
|
|
|
|
|
|
|
function work a lot smoother under perl 5.8+. |
|
897
|
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
=head1 Author |
|
899
|
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
Sanko Robinson - http://sankorobinson.com/ |
|
901
|
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
CPAN ID: SANKO |
|
903
|
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
Original author: Eric J. Roode, roode@cpan.org |
|
905
|
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
=head1 License and Legal |
|
907
|
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
Copyright (C) 2013-2016 by Sanko Robinson |
|
909
|
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
Copyright (c) 2001-2004 by Eric J. Roode. All Rights Reserved. |
|
911
|
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or modify it under |
|
913
|
|
|
|
|
|
|
the same terms as Perl itself. |
|
914
|
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
=cut |