| 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 |