File Coverage

blib/lib/ReadonlyX.pm
Criterion Covered Total %
statement 62 73 84.9
branch 46 62 74.1
condition 11 15 73.3
subroutine 13 13 100.0
pod n/a
total 132 163 80.9


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