1package ReadonlyX; 2use 5.008; 3use strict; 4use warnings; 5our $VERSION = "1.04"; 6BEGIN { *ReadonlyX:: = *Readonly:: } 7package # hide from PAUSE 8 Readonly; # I wish... 9use Carp; 10use Exporter; 11use vars qw/@ISA @EXPORT @EXPORT_OK/; 12push @ISA, 'Exporter'; 13push @EXPORT, qw/Readonly/; 14push @EXPORT_OK, qw/Scalar Array Hash/; 15our $VERSION = "1.04"; # Fake 16# 17sub Array(\@;@); 18sub Hash(\%;@); 19sub Scalar($;$); 20sub Readonly(\[%@$]$); 21# 22sub Array(\@;@) { 23 my $var = $#_ == 0 && defined $_[0] ? $_[0] : $_[1]; 24 @{$_[0]} 25 = ref $var eq 'ARRAY' 26 && $#_ == 1 27 && ref $var eq 'ARRAY' ? @{$var} : @_[1 .. $#_] 28 if $#_ > 0; 29 _readonly($_[0]); 30} 31 32sub Hash(\%;@) { 33 my $var = $#_ == 0 && defined $_[0] ? $_[0] : $_[1]; 34 my $ref = ref $var; 35 Carp::croak 'Odd number of elements in hash assignment' 36 unless (@_ % 2 == 1) || $ref eq 'HASH'; 37 %{$_[0]} = ref $var eq 'HASH' && $#_ == 1 ? %{$var} : @_[1 .. $#_] 38 if $#_ > 0; 39 _readonly($_[0]); 40} 41 42sub Scalar($;$) { 43 my $var = $#_ == 0 && defined $_[0] ? $_[0] : $_[1]; 44 my $ref = ref $var; 45 $ref eq 'ARRAY' ? $_[0] = $var : $ref eq 'HASH' ? $_[0] 46 = $var : $ref eq 'SCALAR' 47 or $ref eq '' ? $_[0] = $var : $ref eq 'REF' ? $_[0] = \$_[1] : 1; 48 _readonly($_[0]); 49 Internals::SvREADONLY($_[0], 1); 50} 51 52sub Readonly(\[%@$]$) { 53 my $type = ref $_[0]; 54 return Scalar(${$_[0]}, defined $_[1] ? $_[1] : ()) 55 if $type eq 'SCALAR' or $type eq ''; 56 return Hash(%{$_[0]}, defined $_[1] ? $_[1] : ()) if $type eq 'HASH'; 57 return Array(@{$_[0]}, defined $_[1] ? $_[1] : []) if $type eq 'ARRAY'; 58} 59 60sub _readonly { 61 my $type = ref $_[0]; 62 my ($onoff) = $#_ ? $_[1] : 1; 63 if ($type eq '') { 64 return Internals::SvREADONLY($_[0], $onoff); 65 } 66 elsif ($type eq 'SCALAR') { 67 return Internals::SvREADONLY(${$_[0]}, $onoff); 68 } 69 elsif ($type eq 'HASH') { 70 for my $key (keys %{$_[0]}) { 71 _readonly($_[0]->{$key}, $onoff); 72 Internals::SvREADONLY($_[0]->{$key}, $onoff); 73 } 74 return Internals::SvREADONLY(%{$_[0]}, $onoff); 75 } 76 elsif ($type eq 'ARRAY') { 77 for my $index (0 .. $#{$_[0]}) { 78 _readonly($_[0]->[$index], $onoff); 79 Internals::SvREADONLY($_[0]->[$index], $onoff); 80 } 81 return Internals::SvREADONLY(@{$_[0]}, $onoff); 82 } 83 elsif ($type eq 'REF') { 84 my $refref = ref ${$_[0]}; 85 _readonly(${$_[0]}, $onoff); 86 return Internals::SvREADONLY(@${$_[0]}, $onoff) 87 if $refref eq 'ARRAY'; 88 return Internals::SvREADONLY(%${$_[0]}, $onoff) 89 if $refref eq 'HASH'; 90 return Internals::SvREADONLY(${$_[0]}, $onoff); 91 } 92 Carp::carp 'We do not know what to do with ' . $type; 93} 94 95sub Clone(\[$@%]) { 96 require Storable; 97 my $retval = Storable::dclone($_[0]); 98 $retval = $$retval if ref $retval eq 'REF'; 99 my $type = ref $retval; 100 _readonly(( $type eq 'SCALAR' || $type eq '' ? $$retval 101 : $type eq 'HASH' ? $retval 102 : $type eq 'ARRAY' ? @$retval 103 : $retval 104 ), 105 0 106 ); 107 return $type eq 'SCALAR' ? 108 $$retval 109 : ($type eq 'ARRAY' ? 110 wantarray ? 111 @$retval 112 : $retval 113 : ($type eq 'HASH' ? wantarray ? %$retval : $retval : $retval) 114 ); 115} 1161; 117 118=head1 NAME 119 120ReadonlyX - Faster facility for creating read-only scalars, arrays, hashes 121 122=head1 Synopsis 123 124 use strict; 125 use warnings; 126 use ReadonlyX; 127 128 # Read-only scalar 129 my $sca1; 130 Readonly::Scalar $sca1 => 3.14; 131 Readonly::Scalar my $sca2 => time; 132 Readonly::Scalar my $sca3 => 'Welcome'; 133 my $sca4 = time(); 134 Readonly::Scalar $sca4; # Value is not clobbered 135 136 # Read-only array 137 my @arr1; 138 Readonly::Array @arr1 => [1 .. 4]; 139 140 # or: 141 Readonly::Array my @arr2 => (1, 3, 5, 7, 9); 142 143 # Read-only hash 144 my %hash1; 145 Readonly::Hash %hash1 => (key => 'value', key2 => 'value'); 146 Readonly::Hash my %hash2 => (key => 'value', key2 => 'value'); 147 148 # or: 149 Readonly::Hash my %hash3 => {key => 'value', key2 => 'value'}; 150 151 # You can use the read-only variables like any regular variables: 152 print $sca1; 153 my $something = $sca1 + $arr1[2]; 154 warn 'Blah!' if $hash1{key2}; 155 156 # But if you try to modify a value, your program will die: 157 $sca2 = 7; # "Modification of a read-only value attempted" 158 push @arr1, 'seven'; # "Modification of a read-only value attempted" 159 $arr1[1] = 'nine'; # "Modification of a read-only value attempted" 160 delete $hash1{key}; # Attempt to delete readonly key 'key' from a restricted hash 161 162 # Create mutable clones 163 Readonly::Scalar $scalar => {qw[this that]}; 164 # $scalar->{'eh'} = 'foo'; # Modification of a read-only value attempted 165 my $scalar_clone = Readonly::Clone $scalar; 166 $scalar_clone->{'eh'} = 'foo'; 167 # $scalar_clone is now {this => 'that', eh => 'foo'}; 168 169=head1 Description 170 171This is a near-drop-in replacement for L<Readonly>, the popular facility for 172creating non-modifiable variables. This is useful for configuration files, 173headers, etc. It can also be useful as a development and debugging tool for 174catching updates to variables that should not be changed. 175 176If you really need to have immutable variables in new code, use this instead 177of Readonly. You'll thank me later. See the section entitled 178L<ReadonlyX vs. Readonly> for more. 179 180=head1 Functions 181 182All of these functions can be imported into your package by name. 183 184=head2 Readonly::Scalar 185 186 Readonly::Scalar $pi => 3.14; 187 Readonly::Scalar my $aref => [qw[this that]]; # list ref 188 Readonly::Scalar my $href => {qw[this that]}; # hash ref 189 190Creates a non-modifiable scalar and assigns a value of to it. Thereafter, its 191value may not be changed. Any attempt to modify the value will cause your 192program to die. 193 194If the given value is a reference to a scalar, array, or hash, then this 195function will mark the scalar, array, or hash it points to as being readonly 196as well, and it will recursively traverse the structure, marking the whole 197thing as readonly. 198 199If the variable is already readonly, the program will die with an error about 200reassigning readonly variables. 201 202=head2 Readonly::Array 203 204 Readonly::Array @arr1 => [1 .. 4]; 205 Readonly::Array my @arr2 => (1, 3, 5, 7, 9); 206 207Creates a non-modifiable array and assigns the specified list of values to it. 208Thereafter, none of its values may be changed; the array may not be lengthened 209or shortened. Any attempt to do so will cause your program to die. 210 211If any of the values passed is a reference to a scalar, array, or hash, then 212this function will mark the scalar, array, or hash it points to as being 213Readonly as well, and it will recursively traverse the structure, marking the 214whole thing as Readonly. 215 216If the variable is already readonly, the program will die with an error about 217reassigning readonly variables. 218 219=head2 Readonly::Hash 220 221 Readonly::Hash %h => (key => 'value', key2 => 'value'); 222 Readonly::Hash %h => {key => 'value', key2 => 'value'}; 223 224Creates a non-modifiable hash and assigns the specified keys and values to it. 225Thereafter, its keys or values may not be changed. Any attempt to do so will 226cause your program to die. 227 228A list of keys and values may be specified (with parentheses in the synopsis 229above), or a hash reference may be specified (curly braces in the synopsis 230above). If a list is specified, it must have an even number of elements, or 231the function will die. 232 233If any of the values is a reference to a scalar, array, or hash, then this 234function will mark the scalar, array, or hash it points to as being Readonly 235as well, and it will recursively traverse the structure, marking the whole 236thing as Readonly. 237 238If the variable is already readonly, the program will die with an error about 239reassigning readonly variables. 240 241=head2 Readonly::Clone 242 243 my $scalar_clone = Readonly::Clone $scalar; 244 245When cloning using L<Storable> or L<Clone> you will notice that the value 246stays readonly, which is correct. If you want to clone the value without 247copying the readonly flag, use this. 248 249 Readonly::Scalar my $scalar => {qw[this that]}; 250 # $scalar->{'eh'} = 'foo'; # Modification of a read-only value attempted 251 my $scalar_clone = Readonly::Clone $scalar; 252 $scalar_clone->{'eh'} = 'foo'; 253 # $scalar_clone is now {this => 'that', eh => 'foo'}; 254 255In this example, the new variable (C<$scalar_clone>) is a mutable clone of the 256original C<$scalar>. You can change it like any other variable. 257 258=head1 Examples 259 260Here are a few very simple examples again to get you started: 261 262=head2 Scalars 263 264A plain old read-only value: 265 266 Readonly::Scalar $a => "A string value"; 267 268The value need not be a compile-time constant: 269 270 Readonly::Scalar $a => $computed_value; 271 272Need an undef constant? Okay: 273 274 Readonly::Scalar $a; 275 276=head2 Arrays/Lists 277 278A read-only array: 279 280 Readonly::Array @a => (1, 2, 3, 4); 281 282The parentheses are optional: 283 284 Readonly::Array @a => 1, 2, 3, 4; 285 286You can use Perl's built-in array quoting syntax: 287 288 Readonly::Array @a => qw[1 2 3 4]; 289 290You can initialize a read-only array from a variable one: 291 292 Readonly::Array @a => @computed_values; 293 294A read-only array can be empty, too: 295 296 Readonly::Array @a => (); 297 # or 298 Readonly::Array @a; 299 300=head2 Hashes 301 302Typical usage: 303 304 Readonly::Hash %a => (key1 => 'value1', key2 => 'value2'); 305 # or 306 Readonly::Hash %a => {key1 => 'value1', key2 => 'value2'}; 307 308A read-only hash can be initialized from a variable one: 309 310 Readonly::Hash %a => %computed_values; 311 312A read-only hash can be empty: 313 314 Readonly::Hash %a => (); 315 # or 316 Readonly::Hash %a; 317 318If you pass an odd number of values, the program will die: 319 320 Readonly::Hash my %a => (key1 => 'value1', "value2"); 321 # This dies with "Odd number of elements in hash assignment" 322 323=head1 ReadonlyX vs. Readonly 324 325The original Readonly module was written nearly twenty years ago when the 326built-in capability to lock variables didn't exist in perl's core. The 327original author came up with the amazingly brilliant idea to use the new (at 328the time) C<tie(...)> construct. It worked amazingly well! But it wasn't long 329before the speed penalty of tied varibles became embarrassingly obvious. Check 330any review of Readonly written before 2013; the main complaint was how slow it 331was and the benchmarks proved it. 332 333In an equally brilliant move to work around tie, Readonly::XS was released for 334perl 5.8.9 and above. This bypassed C<tie(...)> for basic scalars which made a 335huge difference. 336 337During all this, two very distinct APIs were also designed and supported by 338Readonly. One for (then) modern perl and one written for perl 5.6. To make 339this happen, time consuming eval operations were required and the codebase 340grew so complex that fixing bugs was nearly impossible. Readonly was three 341different modules all with different sets of quirks and bugs to fix depending 342on what version of perl and what other modules you had installed. It was a 343mess. 344 345So, after the original author abandoned both Readonly and Readonly::XS, as 346bugs were found, they went unfixed. The combination of speed and lack of 347development spawned several similar modules which usually did a better job but 348none were a total drop-in replacement. 349 350Until now. 351 352ReadonlyX is the best of recent versions of Readonly without the old API and 353without the speed penalty of C<tie(...)>. It's what I'd like to do with 354Readonly if resolving bugs in it wouldn't break 16 years of code out there in 355Darkpan. 356 357In short, unlike Readonly, ReadonlyX... 358 359=over 360 361=item ...does not use slow C<tie(...)> magic or eval. There shouldn't be a 362 speed penalty after making the structure immutable. See the 363 L<Benchmarks> section below 364 365=item ...does not strive to work on perl versions I can't even find a working 366 build of to test against 367 368=item ...has a single, clean API! What do all of these different forms of the 369 original Readonly API do? 370 371 use Readonly; 372 Readonly my @array1 => [2]; 373 Readonly \my @array2 => [2]; 374 Readonly::Array my @array3 => [2]; 375 Readonly::Array1 my @array4 => [2]; 376 377Be careful because they all behave very differently. Even your version of perl 378and the contents of the list changes how they work. Give up? Yeah, me too. 379Bonus: Guess which one doesn't actually make the list items read only. 380 381=item ...does the right thing when it comes to deep vs. shallow structures 382 383=item ...allows implicit undef values for scalars (Readonly inconsistantly 384 allows this for hashes and arrays but not scalars) 385 386=item ...a lot more I can't think of right now but will add when they come to 387 me 388 389=item ...is around 100 lines instead of 460ish so maintaining it will be a 390 breeze 391 392=item ...doesn't clobber predefined variables when making them readonly 393 394Using Readonly, this: 395 396 my @array = qw[very important stuff]; 397 Readonly::Array @array; 398 print "@array"; 399 400...wouldn't print anything. I consider it a bug but I'm not sure why it was 401designed this way originally. With ReadonlyX, you won't lose your 402C<'very important stuff'>. 403 404Note that this is an incompatible change! If you attempt to do this and then 405switch to plain 'ol Readonly, your code will not work. 406 407=back 408 409=head1 Benchmarks 410 411Don't believe Readonly is slow? Here's the result of basic benchmarking: 412 413 Hash Benchmark: timing 5000000 iterations of const, normal, readonly, readonlyx... 414 const: 3 wallclock secs ( 2.73 usr + 0.02 sys = 2.75 CPU) @ 1818181.82/s (n=5000000) 415 normal: 3 wallclock secs ( 3.02 usr + -0.02 sys = 3.00 CPU) @ 1666666.67/s (n=5000000) 416 readonly: 47 wallclock secs (40.64 usr + 0.03 sys = 40.67 CPU) @ 122931.67/s (n=5000000) 417 readonlyx: 4 wallclock secs ( 3.22 usr + -0.01 sys = 3.20 CPU) @ 1560549.31/s (n=5000000) 418 Array Benchmark: timing 5000000 iterations of const, normal, readonly, readonlyx... 419 const: 3 wallclock secs ( 2.19 usr + 0.03 sys = 2.22 CPU) @ 2253267.24/s (n=5000000) 420 normal: 1 wallclock secs ( 1.44 usr + 0.00 sys = 1.44 CPU) @ 3474635.16/s (n=5000000) 421 readonly: 36 wallclock secs (32.52 usr + 0.13 sys = 32.64 CPU) @ 153181.58/s (n=5000000) 422 readonlyx: 1 wallclock secs ( 1.12 usr + -0.02 sys = 1.11 CPU) @ 4512635.38/s (n=5000000) 423 Scalar Benchmark: timing 5000000 iterations of const, normal, readonly, readonlyx... 424 const: 1 wallclock secs ( 1.14 usr + -0.02 sys = 1.12 CPU) @ 4448398.58/s (n=5000000) 425 normal: 1 wallclock secs ( 0.99 usr + 0.02 sys = 1.00 CPU) @ 4995005.00/s (n=5000000) 426 readonly: 1 wallclock secs ( 1.25 usr + 0.00 sys = 1.25 CPU) @ 4000000.00/s (n=5000000) 427 readonlyx: 2 wallclock secs ( 1.20 usr + 0.00 sys = 1.20 CPU) @ 4156275.98/s (n=5000000) 428 429Find the script to run them yourself in C<eg/benchmark.pl>. 430 431=head1 Requirements 432 433There are no non-core requirements. 434 435=head1 Bug Reports 436 437If email is better for you, L<my address is mentioned below|/"Author"> but I 438would rather have bugs sent through the issue tracker found at 439http://github.com/sanko/readonly/issues. 440 441ReadonlyX can be found is the branch of Readonly found here: 442https://github.com/sanko/readonly/tree/ReadonlyX 443 444=head1 Author 445 446Sanko Robinson <sanko@cpan.org> - http://sankorobinson.com/ 447 448CPAN ID: SANKO 449 450=head1 License and Legal 451 452Copyright (C) 2016 by Sanko Robinson <sanko@cpan.org> 453 454This module is free software; you can redistribute it and/or modify it under 455the same terms as Perl itself. 456 457=cut 458