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 |