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