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