Skip to content

Commit

Permalink
work in progress - separate restricted fetch from readonly behavior f…
Browse files Browse the repository at this point in the history 
…or hashes
  • Loading branch information
@demerphq
demerphq committed Nov 18, 2013
1 parent f2756cb commit 4628ab6
Show file tree
Hide file tree
Showing 10 changed files with 678 additions and 31 deletions.
1 change: 1 addition & 0 deletions MANIFEST
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3608,6 +3608,7 @@ ext/Hash-Util-FieldHash/t/12_hashwarn.t Adapted from t/op/hashwarn.t
ext/Hash-Util/lib/Hash/Util.pm Hash::Util
ext/Hash-Util/Makefile.PL Makefile for Hash::Util
ext/Hash-Util/t/Util.t See if Hash::Util works
ext/Hash-Util/t/unrestricted.t See if Hash::Util unrestricted hashes work
ext/Hash-Util/Util.xs XS bits of Hash::Util
ext/I18N-Langinfo/Langinfo.pm I18N::Langinfo
ext/I18N-Langinfo/Langinfo.xs I18N::Langinfo
Expand Down
1 change: 1 addition & 0 deletions dump.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1430,6 +1430,7 @@ const struct flag_to_name cv_flags_names[] = {
};

const struct flag_to_name hv_flags_names[] = {
{SVphv_RESTRICTED, "RESTRICTED,"},
{SVphv_SHAREKEYS, "SHAREKEYS,"},
{SVphv_LAZYDEL, "LAZYDEL,"},
{SVphv_HASKFLAGS, "HASKFLAGS,"},
Expand Down
41 changes: 28 additions & 13 deletions ext/Hash-Util/lib/Hash/Util.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -165,6 +165,9 @@ Both routines return a reference to the hash operated on.

sub lock_ref_keys {
my($hash, @keys) = @_;
my $opts;
$opts= shift @keys
if @keys and ref $keys[0];

Internals::hv_clear_placeholders %$hash;
if( @keys ) {
Expand All @@ -178,13 +181,15 @@ sub lock_ref_keys {
foreach my $k (@keys) {
$hash->{$k} = undef unless exists $hash->{$k};
}
Internals::HvRESTRICTED %$hash, 1 unless $opts && $opts->{unrestricted};
Internals::SvREADONLY %$hash, 1;

foreach my $k (@keys) {
delete $hash->{$k} unless $original_keys{$k};
}
}
else {
Internals::HvRESTRICTED %$hash, 1 unless $opts && $opts->{unrestricted};
Internals::SvREADONLY %$hash, 1;
}

Expand All @@ -195,6 +200,7 @@ sub unlock_ref_keys {
my $hash = shift;

Internals::SvREADONLY %$hash, 0;
Internals::HvRESTRICTED %$hash, 0;
return $hash;
}

Expand All @@ -218,6 +224,10 @@ Returns a reference to %hash

sub lock_ref_keys_plus {
my ($hash,@keys) = @_;
my $opts;
$opts= shift @keys
if @keys and ref $keys[0];

my @delete;
Internals::hv_clear_placeholders(%$hash);
foreach my $key (@keys) {
Expand All @@ -226,6 +236,7 @@ sub lock_ref_keys_plus {
push @delete,$key;
}
}
Internals::HvRESTRICTED %$hash, 1 unless $opts && $opts->{unrestricted};
Internals::SvREADONLY(%$hash,1);
delete @{$hash}{@delete};
return $hash
Expand Down Expand Up @@ -292,9 +303,10 @@ Returns a reference to the %hash.
=cut

sub lock_hashref {
my $hash = shift;
my ($hash, $opts) = @_;
$opts ||= {};

lock_ref_keys($hash);
lock_ref_keys($hash, $opts);

foreach my $value (values %$hash) {
Internals::SvREADONLY($value,1);
Expand All @@ -304,19 +316,20 @@ sub lock_hashref {
}

sub unlock_hashref {
my $hash = shift;
my ($hash, $opts) = @_;
$opts ||= {};

foreach my $value (values %$hash) {
Internals::SvREADONLY($value, 0);
}

unlock_ref_keys($hash);
unlock_ref_keys($hash, $opts);

return $hash;
}

sub lock_hash (\%) { lock_hashref(@_) }
sub unlock_hash (\%) { unlock_hashref(@_) }
sub lock_hash (\%;$) { lock_hashref(@_) }
sub unlock_hash (\%;$) { unlock_hashref(@_) }

=item B<lock_hash_recurse>
Expand All @@ -343,30 +356,32 @@ Returns a reference to the %hash.
=cut

sub lock_hashref_recurse {
my $hash = shift;
my ($hash, $opts) = @_;
$opts ||= {};

lock_ref_keys($hash);
lock_ref_keys($hash, $opts);
foreach my $value (values %$hash) {
my $type = reftype($value);
if (defined($type) and $type eq 'HASH') {
lock_hashref_recurse($value);
lock_hashref_recurse($value, $opts);
}
Internals::SvREADONLY($value,1);
}
return $hash
}

sub unlock_hashref_recurse {
my $hash = shift;
my ($hash, $opts) = @_;
$opts ||= {};

foreach my $value (values %$hash) {
my $type = reftype($value);
if (defined($type) and $type eq 'HASH') {
unlock_hashref_recurse($value);
unlock_hashref_recurse($value, $opts);
}
Internals::SvREADONLY($value,1);
Internals::SvREADONLY($value,0);
}
unlock_ref_keys($hash);
unlock_ref_keys($hash, $opts);
return $hash;
}

Expand Down
22 changes: 11 additions & 11 deletions ext/Hash-Util/t/Util.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,7 @@ foreach my $func (@Exported_Funcs) {
my %hash = (foo => 42, bar => 23, locked => 'yep');
lock_keys(%hash);
eval { $hash{baz} = 99; };
like( $@, qr/^Attempt to access disallowed key 'baz' in a restricted hash/,
like( $@, qr/^Attempt to store disallowed key 'baz' in a readonly hash/,
'lock_keys()');
is( $hash{bar}, 23, '$hash{bar} == 23' );
ok( !exists $hash{baz},'!exists $hash{baz}' );
Expand All @@ -58,16 +58,16 @@ $hash{bar} = 69;
is( $hash{bar}, 69 ,'$hash{bar} == 69');

eval { () = $hash{i_dont_exist} };
like( $@, qr/^Attempt to access disallowed key 'i_dont_exist' in a restricted hash/,
like( $@, qr/^Attempt to fetch disallowed key 'i_dont_exist' in a restricted hash/,
'Disallowed 1' );

lock_value(%hash, 'locked');
eval { print "# oops" if $hash{four} };
like( $@, qr/^Attempt to access disallowed key 'four' in a restricted hash/,
like( $@, qr/^Attempt to fetch disallowed key 'four' in a restricted hash/,
'Disallowed 2' );

eval { $hash{"\x{2323}"} = 3 };
like( $@, qr/^Attempt to access disallowed key '(.*)' in a restricted hash/,
like( $@, qr/^Attempt to store disallowed key '(.*)' in a restricted hash/,
'wide hex key' );

eval { delete $hash{locked} };
Expand Down Expand Up @@ -104,7 +104,7 @@ is( $hash{locked}, 42, 'unlock_value' );

lock_keys(%hash);
eval { %hash = ( wubble => 42 ) }; # we know this will bomb
like( $@, qr/^Attempt to access disallowed key 'wubble'/,'Disallowed 3' );
like( $@, qr/^Attempt to store disallowed key 'wubble'/,'Disallowed 3' );
unlock_keys(%hash);
}

Expand Down Expand Up @@ -132,7 +132,7 @@ is( $hash{locked}, 42, 'unlock_value' );
$hash{foo} = 42;
is( keys %hash, 1, '1 element in hash' );
eval { $hash{wibble} = 42 };
like( $@, qr/^Attempt to access disallowed key 'wibble' in a restricted hash/,
like( $@, qr/^Attempt to store disallowed key 'wibble' in a restricted hash/,
'write threw error (locked)');

unlock_keys(%hash);
Expand All @@ -150,7 +150,7 @@ is( $hash{locked}, 42, 'unlock_value' );
is( $@, '','No error 1' );

eval { $hash{wibble} = 23 };
like( $@, qr/^Attempt to access disallowed key 'wibble' in a restricted hash/,
like( $@, qr/^Attempt to store disallowed key 'wibble' in a restricted hash/,
'locked "wibble"' );
}

Expand Down Expand Up @@ -194,7 +194,7 @@ lock_keys(%ENV);
eval { () = $ENV{I_DONT_EXIST} };
like(
$@,
qr/^Attempt to access disallowed key 'I_DONT_EXIST' in a restricted hash/,
qr/^Attempt to fetch disallowed key 'I_DONT_EXIST' in a restricted hash/,
'locked %ENV'
);
unlock_keys(%ENV); # Test::Builder cannot print test failures otherwise
Expand Down Expand Up @@ -223,11 +223,11 @@ unlock_keys(%ENV); # Test::Builder cannot print test failures otherwise

eval {$hash{zeroeth} = 0};
like ($@,
qr/^Attempt to access disallowed key 'zeroeth' in a restricted hash/,
qr/^Attempt to store disallowed key 'zeroeth' in a restricted hash/,
'locked key never mentioned before should fail');
eval {$hash{first} = -1};
like ($@,
qr/^Attempt to access disallowed key 'first' in a restricted hash/,
qr/^Attempt to store disallowed key 'first' in a restricted hash/,
'previously locked place holders should also fail');
is (scalar keys %hash, 0, "and therefore there are no keys");
$hash{second} = 1;
Expand All @@ -248,7 +248,7 @@ unlock_keys(%ENV); # Test::Builder cannot print test failures otherwise

eval {$hash{second} = -1};
like ($@,
qr/^Attempt to access disallowed key 'second' in a restricted hash/,
qr/^Attempt to store disallowed key 'second' in a restricted hash/,
'previously locked place holders should fail');

is ($hash{void}, undef,
Expand Down
Loading

0 comments on commit 4628ab6

Please sign in to comment.