Readonly-Tiny-4000755011611011611 012760313764 13377 5ustar00mauzousers000000000000Readonly-Tiny-4/Build.PL000444011611011611 101312760313764 15023 0ustar00mauzousers000000000000use Module::Build; Module::Build->new( module_name => "Readonly::Tiny", license => "bsd", configure_requires => { "Module::Build" => "0.38", }, build_requires => { "Test::More" => "0.96", "Test::Exception" => 0, "Test::Exports" => 0, }, meta_merge => { resources => { repository => "http://github.com/mauzo/Readonly-Tiny", bugtracker => "https://rt.cpan.org/Public/Dist/" . "Display.html?Name=Readonly-Tiny", }, }, )->create_build_script; Readonly-Tiny-4/MANIFEST000444011611011611 22112760313764 14640 0ustar00mauzousers000000000000Build.PL Changes lib/Readonly/Tiny.pm MANIFEST This list of files META.json META.yml t/00use.t t/compat.t t/readonly.t t/readwrite.t t/Util.pm Readonly-Tiny-4/META.json000444011611011611 220112760313764 15150 0ustar00mauzousers000000000000{ "abstract" : "Simple, correct readonly values", "author" : [ "Ben Morrow " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4214", "license" : [ "bsd" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Readonly-Tiny", "prereqs" : { "build" : { "requires" : { "Test::Exception" : "0", "Test::Exports" : "0", "Test::More" : "0.96" } }, "configure" : { "requires" : { "Module::Build" : "0.38" } } }, "provides" : { "Readonly::Tiny" : { "file" : "lib/Readonly/Tiny.pm", "version" : "4" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Readonly-Tiny" }, "license" : [ "http://opensource.org/licenses/bsd-license.php" ], "repository" : { "url" : "http://github.com/mauzo/Readonly-Tiny" } }, "version" : "4" } Readonly-Tiny-4/Changes000444011611011611 57512760313764 15016 0ustar00mauzousers000000000000Revision history for Readonly::Tiny 4 2016-08-27 Internals::hv_clear_placeholders has moved. Use the public Hash::Util API instead. 3 2016-01-07 Fix qr//s on perls before 5.12. 2 2015-12-26 Export tests. I forgot the MANIFEST (sorry). 1 2015-12-26 Initial version, creating readonly values using SvREADONLY without cloning deep structures. Readonly-Tiny-4/META.yml000444011611011611 133412760313764 15006 0ustar00mauzousers000000000000--- abstract: 'Simple, correct readonly values' author: - 'Ben Morrow ' build_requires: Test::Exception: '0' Test::Exports: '0' Test::More: '0.96' configure_requires: Module::Build: '0.38' dynamic_config: 1 generated_by: 'Module::Build version 0.4214, CPAN::Meta::Converter version 2.150001' license: bsd meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Readonly-Tiny provides: Readonly::Tiny: file: lib/Readonly/Tiny.pm version: '4' resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Readonly-Tiny license: http://opensource.org/licenses/bsd-license.php repository: http://github.com/mauzo/Readonly-Tiny version: '4' Readonly-Tiny-4/t000755011611011611 012760313764 13642 5ustar00mauzousers000000000000Readonly-Tiny-4/t/readonly.t000444011611011611 1000512760313764 16015 0ustar00mauzousers000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Exception; use t::Util; use Readonly::Tiny; use File::Spec::Functions qw/devnull/; { my $x = 1; readonly \$x; is $x, 1, "readonly doesn't affect scalar value"; ok SvRO(\$x), "readonly makes scalars SvRO"; throws_ok { $x = 2 } $mod, "readonly makes scalars readonly"; throws_ok { undef $x } $mod, "readonly scalar can't be undefined"; } { my $x = 1; my $y = \$x; readonly \$y; is $y, \$x, "readonly doesn't affect REF value"; ok SvRO(\$y), "readonly makes REF SvRO"; throws_ok { $y = 2 } $mod, "readonly makes REF readonly"; throws_ok { undef $y } $mod, "readonly REF can't be undefined"; } { my @x = (1, 2); readonly \@x; is_deeply \@x, [1, 2], "readonly doesn't affect array value"; ok SvRO(\@x), "readonly makes array SvRO"; ok SvRO(\$x[0]), "readonly makes array elem SvRO"; throws_ok { $x[0] = 2 } $mod, "readonly array elem can't be changed"; throws_ok { push @x, 3 } $mod, "readonly array can't be extended"; throws_ok { pop @x } $mod, "readonly array can't be shortened"; throws_ok { @x = () } $mod, "readonly array can't be cleared"; throws_ok { undef @x } $mod, "readonly array can't be undefined"; } { my %x = (foo => 1); readonly \%x; is_deeply \%x, {foo => 1}, "readonly doesn't affect hash value"; ok SvRO(\%x), "readonly makes hashes SvRO"; ok SvRO(\$x{foo}), "readonly makes hash elem SvRO"; throws_ok { $x{foo} = 2 } $mod, "readonly hash elem can't be changed"; throws_ok { $x{bar} = 1 } $mod, "readonly hash can't be extended"; throws_ok { delete $x{foo} } $mod, "readonly hash can't be shortened"; throws_ok { %x = () } $mod, "readonly hash can't be cleared"; throws_ok { undef %x } $mod, "readonly hash can't be undefined"; } { my $x = 1; *x = \$x; my @x = (1, 2); *x = \@x; my %x = (foo => 1); *x = \%x; my $c = sub {1}; *x = $c; open *x, "<", devnull; my $i = *x{IO}; readonly \*x; is *x{SCALAR}, \$x, "readonly doesn't affect glob SCALAR slot"; is *x{ARRAY}, \@x, "readonly doesn't affect glob ARRAY slot"; is *x{HASH}, \%x, "readonly doesn't affect glob HASH slot"; is *x{CODE}, $c, "readonly doesn't affect glob CODE slot"; is *x{IO}, $i, "readonly doesn't affect glob IO slot"; ok SvRO(\*x), "readonly makes glob SvRO"; ok SvRO(*x{SCALAR}), "readonly makes glob SCALAR SvRO"; ok SvRO(*x{ARRAY}), "readonly makes glob ARRAY SvRO"; ok SvRO(*x{HASH}), "readonly makes glob HASH SvRO"; ok !SvRO(*x{CODE}), "readonly doesn't make CODE slot SvRO"; ok !SvRO(*x{IO}), "readonly doesn't make IO slot SvRO"; throws_ok { *x = \1 } $mod, "readonly SCALAR slot can't be changed"; throws_ok { *x = [] } $mod, "readonly ARRAY slot can't be changed"; throws_ok { *x = {} } $mod, "readonly HASH slot can't be changed"; throws_ok { *x = sub {2} } $mod, "readonly CODE slot can't be changed"; throws_ok { *x = *STDOUT{IO} } $mod, "readonly IO slot can't be changed"; } { my $x = bless []; readonly $x; ok !SvRO($x), "readonly doesn't affect object"; } { my $x = bless []; readonly $x, {peek=>1}; ok SvRO($x), "readonly w/peek affects objects"; } sub foo { } readonly \&foo; ok !SvRO(\&foo), "readonly doesn't affect subref"; readonly *STDOUT{IO}; ok !SvRO(*STDOUT{IO}), "readonly doesn't affect ioref"; { my $x = qr/x/; readonly $x, {peek => 1}; ok !SvRO($x), "readonly doesn't affect qr//"; } done_testing; Readonly-Tiny-4/t/readwrite.t000444011611011611 745512760313764 16165 0ustar00mauzousers000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Exception; use t::Util; use Readonly::Tiny qw/readonly readwrite/; use File::Spec::Functions qw/devnull/; sub ro_rw { readonly $_[0], {peek=>1}; readwrite @_ } { my $x = 1; ro_rw \$x; is $x, 1, "readwrite doesn't affect scalar value"; ok !SvRO(\$x), "readwrite makes scalars SvRW"; lives_ok { $x = 2 } "readwrite makes scalars readwrite"; lives_ok { undef $x } "readwrite scalar can't be undefined"; } { my $x = 1; my $y = \$x; ro_rw \$y; is $y, \$x, "readwrite doesn't affect REF value"; ok !SvRO(\$y), "readwrite makes REF SvRW"; lives_ok { $y = 2 } "readwrite makes REF readwrite"; lives_ok { undef $y } "readwrite REF can't be undefined"; } { my @x = (1, 2); ro_rw \@x; is_deeply \@x, [1, 2], "readwrite doesn't affect array value"; ok !SvRO(\@x), "readwrite makes array SvRW"; ok !SvRO(\$x[0]), "readwrite makes array elem SvRW"; lives_ok { $x[0] = 2 } "readwrite array elem can't be changed"; lives_ok { push @x, 3 } "readwrite array can't be extended"; lives_ok { pop @x } "readwrite array can't be shortened"; lives_ok { @x = () } "readwrite array can't be cleared"; lives_ok { undef @x } "readwrite array can't be undefined"; } { my %x = (foo => 1); ro_rw \%x; is_deeply \%x, {foo => 1}, "readwrite doesn't affect hash value"; ok !SvRO(\%x), "readwrite makes hashes SvRW"; ok !SvRO(\$x{foo}), "readwrite makes hash elem SvRW"; lives_ok { $x{foo} = 2 } "readwrite hash elem can't be changed"; lives_ok { $x{bar} = 1 } "readwrite hash can't be extended"; lives_ok { delete $x{foo} } "readwrite hash can't be shortened"; lives_ok { %x = () } "readwrite hash can't be cleared"; lives_ok { undef %x } "readwrite hash can't be undefined"; } { no warnings "redefine"; my $x = 1; *x = \$x; my @x = (1, 2); *x = \@x; my %x = (foo => 1); *x = \%x; my $c = sub {1}; *x = $c; open *x, "<", devnull; my $i = *x{IO}; ro_rw \*x; is *x{SCALAR}, \$x, "readwrite doesn't affect glob SCALAR slot"; is *x{ARRAY}, \@x, "readwrite doesn't affect glob ARRAY slot"; is *x{HASH}, \%x, "readwrite doesn't affect glob HASH slot"; is *x{CODE}, $c, "readwrite doesn't affect glob CODE slot"; is *x{IO}, $i, "readwrite doesn't affect glob IO slot"; ok !SvRO(\*x), "readwrite makes glob SvRW"; ok !SvRO(*x{SCALAR}), "readwrite makes glob SCALAR SvRW"; ok !SvRO(*x{ARRAY}), "readwrite makes glob ARRAY SvRW"; ok !SvRO(*x{HASH}), "readwrite makes glob HASH SvRW"; lives_ok { *x = \1 } "readwrite SCALAR slot can't be changed"; lives_ok { *x = [] } "readwrite ARRAY slot can't be changed"; lives_ok { *x = {} } "readwrite HASH slot can't be changed"; lives_ok { *x = sub {2} } "readwrite CODE slot can't be changed"; lives_ok { *x = *STDOUT{IO} } "readwrite IO slot can't be changed"; } { my $x = bless []; ro_rw $x; ok SvRO($x), "readwrite doesn't affect object"; } { my $x = bless []; ro_rw $x, {peek=>1}; ok !SvRO($x), "readwrite w/peek affects objects"; } for ( ["undef", \undef ], ["yes", \!0 ], ["no", \!1 ], ) { my ($n, $r) = @$_; readwrite $r; ok SvRO($r), "readwrite doesn't affect PL_sv_$n"; } done_testing; Readonly-Tiny-4/t/00use.t000444011611011611 113312760313764 15116 0ustar00mauzousers000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Exports; my $RT = "Readonly::Tiny"; require_ok $RT or BAIL_OUT "Module will not load!"; import_ok $RT, [], "default import OK"; is_import qw/readonly/, $RT, "default imports readonly"; cant_ok qw/readwrite Readonly/, "default only imports readonly"; my @all = qw/readonly readwrite Readonly/; new_import_pkg; import_ok $RT, \@all, "explicit import OK"; is_import @all, $RT, "explicit import succeeds"; Test::More->builder->is_passing or BAIL_OUT "Module will not load!"; done_testing; Readonly-Tiny-4/t/Util.pm000444011611011611 40712760313764 15233 0ustar00mauzousers000000000000package t::Util; use warnings; use strict; use Exporter "import"; our @EXPORT = qw/SvRO $mod/; sub SvRO { goto &Internals::SvREADONLY } our $mod = qr/ Modification\ of\ a\ read-only\ value\ attempted | Attempt\ to\ .*\ a\ restricted\ hash /x; 1; Readonly-Tiny-4/t/compat.t000444011611011611 121512760313764 15446 0ustar00mauzousers000000000000#!/usr/bin/perl use warnings; use strict; use Test::More; use t::Util; use Readonly::Tiny qw/Readonly/; Readonly my $x, 2; is $x, 2, "Readonly assigns to scalar"; ok SvRO(\$x), "Readonly makes scalar RO"; Readonly my @x, 1, 2, 3; is_deeply \@x, [1, 2, 3], "Readonly assigns to array"; ok SvRO(\@x), "Readonly makes array RO"; ok SvRO(\$x[0]), "Readonly makes array elem RO"; Readonly my %x, foo => 1; is_deeply \%x, {foo => 1}, "Readonly assigns to hash"; ok SvRO(\%x), "Readonly makes hash RO"; ok SvRO(\$x{foo}), "Readonly makes hash elem RO"; done_testing; Readonly-Tiny-4/lib000755011611011611 012760313764 14145 5ustar00mauzousers000000000000Readonly-Tiny-4/lib/Readonly000755011611011611 012760313764 15722 5ustar00mauzousers000000000000Readonly-Tiny-4/lib/Readonly/Tiny.pm000444011611011611 1473512760313764 17372 0ustar00mauzousers000000000000package Readonly::Tiny; =head1 NAME Readonly::Tiny - Simple, correct readonly values =head1 SYNOPSIS use Readonly::Tiny; my $x = readonly [1, 2, 3]; # $x is not readonly, but the array it points to is. my @y = (4, 5, 6); readonly \@y; # @y is readonly, as well as its contents. =head1 DESCRIPTION Readonly::Tiny provides a simple and correct way of making values readonly. Unlike L it does not cause arrays and hashes to be tied, it just uses the core C flag. =head1 FUNCTIONS =cut use 5.008; use warnings; use strict; our $VERSION = "4"; use Exporter "import"; our @EXPORT = qw/readonly/; our @EXPORT_OK = qw/readonly readwrite Readonly/; use Carp qw/croak/; use Scalar::Util qw/reftype refaddr blessed/; use Hash::Util; #use Data::Dump qw/pp/; use constant RX_MAGIC => (reftype(qr/x/) ne "REGEXP"); if (RX_MAGIC) { require B; *is_regexp = sub { my $o = B::svref_2object($_[0]) or return; blessed($o) eq "B::PVMG" or return; my $m = $o->MAGIC; while ($m) { $m->TYPE eq "r" and return 1; $m = $m->MOREMAGIC; } return; }; } sub debug { #warn sprintf "%s [%x] %s\n", @_; } =head2 readonly my $ro = readonly $ref, \%opts; Make a data structure readonly. C<$ref> must be a reference; the referenced value, and any values referenced recursively, will be made readonly. C<$ref> is returned, but it will not itself be readonly; it is possible to make a variable readonly by passing a reference to it, as in the L. C<%opts> is a hashref of options: =over 4 =item peek Normally blessed references will not be looked through. The scalar holding the reference will be made readonly (so a different object cannot be assigned) but the contents of the object itself will be left alone. Supplying C<< peek => 1 >> allows blessed refs to be looked through. =item skip This should be a hashref keyed by refaddr. Any object whose refaddr is in the hash will be skipped. =back Note that making a hash readonly has the same effect as calling L|Hash::Util/lock_hash>; in particular, it causes restricted hashes to be re-restricted to their current set of keys. =head2 readwrite my $rw = readwrite $ref, \%opts; Undo the effects of C. C<%opts> is the same. Note that making a hash readwrite will undo any restrictions put in place using L. B calling this on values you have not made readonly yourself. It will silently ignore attempts to make the core values C, C and C readwrite, but there are many other values the core makes readonly, usually with good reason. Recent versions of perl will not allow you to make readwrite a value the core has set readonly, but you should probably not rely on this. =cut sub _recurse; sub readonly { _recurse 1, @_; $_[0] } sub readwrite { _recurse 0, @_; $_[0] } my %immortal = map +(refaddr $_, 1), \undef, \!1, \!0; sub _recurse { my ($ro, $r, $o) = @_; my $x = refaddr $r or croak "readonly needs a reference"; exists $o->{skip}{$x} and return $r; $o->{skip}{$x} = 1; !$ro && $immortal{$x} and return $r; blessed $r && !$o->{peek} and return $r; my $t = reftype $r; #debug $t, $x, pp $r; # It's not clear it's meaningful to SvREADONLY these types. A qr// # is a ref to a REGEXP, so a scalar holding one can be made # readonly; the REGEXP itself would normally be skipped anyway # because it's blessed. $t eq "CODE" || $t eq "IO" || $t eq "FORMAT" || $t eq "REGEXP" and return $r; # Look for r magic pre-5.12 RX_MAGIC and is_regexp($r) and return $r; unless ($o->{shallow}) { if ($t eq "REF") { _recurse $ro, $$r, $o; } if ($t eq "ARRAY") { _recurse $ro, \$_, $o for @$r; } if ($t eq "HASH") { &Internals::SvREADONLY($r, 0); _recurse $ro, \$_, $o for values %$r; Hash::Util::lock_keys(%$r); } if ($t eq "GLOB") { *$r{$_} and _recurse $ro, *$r{$_}, $o for qw/SCALAR ARRAY HASH/; } } # bleeding prototypes... &Internals::SvREADONLY($r, $ro); #debug "READONLY", $r, &Internals::SvREADONLY($r); } =head2 Readonly Readonly my $x, 1; Readonly my @y, 2, 3, 4; Readonly my %z, foo => 5; This is a compatibility shim for L. It is prototyped to take a reference to its first argument, and assigns the rest of the argument list to that argument before making the whole thing readonly. =cut sub Readonly (\[$@%]@) { my $r = shift; my $t = reftype $r or croak "Readonly needs a reference"; if ($t eq "SCALAR" or $t eq "REF") { $$r = $_[0]; } if ($t eq "ARRAY") { @$r = @_; } if ($t eq "HASH") { %$r = @_; } if ($t eq "GLOB") { *$r = $_[0]; } readonly $r; } 1; =head1 EXPORTS C is exported by default. C and C are exported on request. =head1 SEE ALSO L was the first module to supply readonly values. It was written for Perl 5.6, and as a result the interface and implementation are both rather clunky. With L the performance is improved for scalar varuables, but arrays and hashes still use a tied implementation which is very slow. L is a greatly improved reaoonly module which uses perl's internal C flag instead of ties. The differences between this module and L are: =over 4 =item * The C function does not insist on performing an assignment, it just returns a readonly value. This is, IMHO, more useful, since it means a readonly value can be returned from a function. In particular, it is often useful to return a readonly value from a builder method. =item * It does not attempt to clone deep structures. If C is applied to a structure with cross-links it will clone the whole thing, on the principle that parts of the graph may be shared with something else which should not be readonly. This module takes the approach that if you asked for something to be made readonly you meant it, and if it points to something it shouldn't that's your mistake. =back =head1 BUGS Please report bugs to >. =head1 AUTHOR Ben Morrow =head1 COPYRIGHT Copyright 2015 Ben Morrow. Released under the 2-clause BSD licence.