1*0Sstevel@tonic-gatepackage Hash::Util; 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gaterequire 5.007003; 4*0Sstevel@tonic-gateuse strict; 5*0Sstevel@tonic-gateuse Carp; 6*0Sstevel@tonic-gate 7*0Sstevel@tonic-gaterequire Exporter; 8*0Sstevel@tonic-gateour @ISA = qw(Exporter); 9*0Sstevel@tonic-gateour @EXPORT_OK = qw(lock_keys unlock_keys lock_value unlock_value 10*0Sstevel@tonic-gate lock_hash unlock_hash hash_seed 11*0Sstevel@tonic-gate ); 12*0Sstevel@tonic-gateour $VERSION = 0.05; 13*0Sstevel@tonic-gate 14*0Sstevel@tonic-gate=head1 NAME 15*0Sstevel@tonic-gate 16*0Sstevel@tonic-gateHash::Util - A selection of general-utility hash subroutines 17*0Sstevel@tonic-gate 18*0Sstevel@tonic-gate=head1 SYNOPSIS 19*0Sstevel@tonic-gate 20*0Sstevel@tonic-gate use Hash::Util qw(lock_keys unlock_keys 21*0Sstevel@tonic-gate lock_value unlock_value 22*0Sstevel@tonic-gate lock_hash unlock_hash 23*0Sstevel@tonic-gate hash_seed); 24*0Sstevel@tonic-gate 25*0Sstevel@tonic-gate %hash = (foo => 42, bar => 23); 26*0Sstevel@tonic-gate lock_keys(%hash); 27*0Sstevel@tonic-gate lock_keys(%hash, @keyset); 28*0Sstevel@tonic-gate unlock_keys(%hash); 29*0Sstevel@tonic-gate 30*0Sstevel@tonic-gate lock_value (%hash, 'foo'); 31*0Sstevel@tonic-gate unlock_value(%hash, 'foo'); 32*0Sstevel@tonic-gate 33*0Sstevel@tonic-gate lock_hash (%hash); 34*0Sstevel@tonic-gate unlock_hash(%hash); 35*0Sstevel@tonic-gate 36*0Sstevel@tonic-gate my $hashes_are_randomised = hash_seed() != 0; 37*0Sstevel@tonic-gate 38*0Sstevel@tonic-gate=head1 DESCRIPTION 39*0Sstevel@tonic-gate 40*0Sstevel@tonic-gateC<Hash::Util> contains special functions for manipulating hashes that 41*0Sstevel@tonic-gatedon't really warrant a keyword. 42*0Sstevel@tonic-gate 43*0Sstevel@tonic-gateBy default C<Hash::Util> does not export anything. 44*0Sstevel@tonic-gate 45*0Sstevel@tonic-gate=head2 Restricted hashes 46*0Sstevel@tonic-gate 47*0Sstevel@tonic-gate5.8.0 introduces the ability to restrict a hash to a certain set of 48*0Sstevel@tonic-gatekeys. No keys outside of this set can be added. It also introduces 49*0Sstevel@tonic-gatethe ability to lock an individual key so it cannot be deleted and the 50*0Sstevel@tonic-gatevalue cannot be changed. 51*0Sstevel@tonic-gate 52*0Sstevel@tonic-gateThis is intended to largely replace the deprecated pseudo-hashes. 53*0Sstevel@tonic-gate 54*0Sstevel@tonic-gate=over 4 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gate=item lock_keys 57*0Sstevel@tonic-gate 58*0Sstevel@tonic-gate=item unlock_keys 59*0Sstevel@tonic-gate 60*0Sstevel@tonic-gate lock_keys(%hash); 61*0Sstevel@tonic-gate lock_keys(%hash, @keys); 62*0Sstevel@tonic-gate 63*0Sstevel@tonic-gateRestricts the given %hash's set of keys to @keys. If @keys is not 64*0Sstevel@tonic-gategiven it restricts it to its current keyset. No more keys can be 65*0Sstevel@tonic-gateadded. delete() and exists() will still work, but will not alter 66*0Sstevel@tonic-gatethe set of allowed keys. B<Note>: the current implementation prevents 67*0Sstevel@tonic-gatethe hash from being bless()ed while it is in a locked state. Any attempt 68*0Sstevel@tonic-gateto do so will raise an exception. Of course you can still bless() 69*0Sstevel@tonic-gatethe hash before you call lock_keys() so this shouldn't be a problem. 70*0Sstevel@tonic-gate 71*0Sstevel@tonic-gate unlock_keys(%hash); 72*0Sstevel@tonic-gate 73*0Sstevel@tonic-gateRemoves the restriction on the %hash's keyset. 74*0Sstevel@tonic-gate 75*0Sstevel@tonic-gate=cut 76*0Sstevel@tonic-gate 77*0Sstevel@tonic-gatesub lock_keys (\%;@) { 78*0Sstevel@tonic-gate my($hash, @keys) = @_; 79*0Sstevel@tonic-gate 80*0Sstevel@tonic-gate Internals::hv_clear_placeholders %$hash; 81*0Sstevel@tonic-gate if( @keys ) { 82*0Sstevel@tonic-gate my %keys = map { ($_ => 1) } @keys; 83*0Sstevel@tonic-gate my %original_keys = map { ($_ => 1) } keys %$hash; 84*0Sstevel@tonic-gate foreach my $k (keys %original_keys) { 85*0Sstevel@tonic-gate die sprintf "Hash has key '$k' which is not in the new key ". 86*0Sstevel@tonic-gate "set at %s line %d\n", (caller)[1,2] 87*0Sstevel@tonic-gate unless $keys{$k}; 88*0Sstevel@tonic-gate } 89*0Sstevel@tonic-gate 90*0Sstevel@tonic-gate foreach my $k (@keys) { 91*0Sstevel@tonic-gate $hash->{$k} = undef unless exists $hash->{$k}; 92*0Sstevel@tonic-gate } 93*0Sstevel@tonic-gate Internals::SvREADONLY %$hash, 1; 94*0Sstevel@tonic-gate 95*0Sstevel@tonic-gate foreach my $k (@keys) { 96*0Sstevel@tonic-gate delete $hash->{$k} unless $original_keys{$k}; 97*0Sstevel@tonic-gate } 98*0Sstevel@tonic-gate } 99*0Sstevel@tonic-gate else { 100*0Sstevel@tonic-gate Internals::SvREADONLY %$hash, 1; 101*0Sstevel@tonic-gate } 102*0Sstevel@tonic-gate 103*0Sstevel@tonic-gate return; 104*0Sstevel@tonic-gate} 105*0Sstevel@tonic-gate 106*0Sstevel@tonic-gatesub unlock_keys (\%) { 107*0Sstevel@tonic-gate my($hash) = shift; 108*0Sstevel@tonic-gate 109*0Sstevel@tonic-gate Internals::SvREADONLY %$hash, 0; 110*0Sstevel@tonic-gate return; 111*0Sstevel@tonic-gate} 112*0Sstevel@tonic-gate 113*0Sstevel@tonic-gate=item lock_value 114*0Sstevel@tonic-gate 115*0Sstevel@tonic-gate=item unlock_value 116*0Sstevel@tonic-gate 117*0Sstevel@tonic-gate lock_value (%hash, $key); 118*0Sstevel@tonic-gate unlock_value(%hash, $key); 119*0Sstevel@tonic-gate 120*0Sstevel@tonic-gateLocks and unlocks an individual key of a hash. The value of a locked 121*0Sstevel@tonic-gatekey cannot be changed. 122*0Sstevel@tonic-gate 123*0Sstevel@tonic-gate%hash must have already been locked for this to have useful effect. 124*0Sstevel@tonic-gate 125*0Sstevel@tonic-gate=cut 126*0Sstevel@tonic-gate 127*0Sstevel@tonic-gatesub lock_value (\%$) { 128*0Sstevel@tonic-gate my($hash, $key) = @_; 129*0Sstevel@tonic-gate carp "Cannot usefully lock values in an unlocked hash" 130*0Sstevel@tonic-gate unless Internals::SvREADONLY %$hash; 131*0Sstevel@tonic-gate Internals::SvREADONLY $hash->{$key}, 1; 132*0Sstevel@tonic-gate} 133*0Sstevel@tonic-gate 134*0Sstevel@tonic-gatesub unlock_value (\%$) { 135*0Sstevel@tonic-gate my($hash, $key) = @_; 136*0Sstevel@tonic-gate Internals::SvREADONLY $hash->{$key}, 0; 137*0Sstevel@tonic-gate} 138*0Sstevel@tonic-gate 139*0Sstevel@tonic-gate 140*0Sstevel@tonic-gate=item B<lock_hash> 141*0Sstevel@tonic-gate 142*0Sstevel@tonic-gate=item B<unlock_hash> 143*0Sstevel@tonic-gate 144*0Sstevel@tonic-gate lock_hash(%hash); 145*0Sstevel@tonic-gate 146*0Sstevel@tonic-gatelock_hash() locks an entire hash, making all keys and values readonly. 147*0Sstevel@tonic-gateNo value can be changed, no keys can be added or deleted. 148*0Sstevel@tonic-gate 149*0Sstevel@tonic-gate unlock_hash(%hash); 150*0Sstevel@tonic-gate 151*0Sstevel@tonic-gateunlock_hash() does the opposite of lock_hash(). All keys and values 152*0Sstevel@tonic-gateare made read/write. All values can be changed and keys can be added 153*0Sstevel@tonic-gateand deleted. 154*0Sstevel@tonic-gate 155*0Sstevel@tonic-gate=cut 156*0Sstevel@tonic-gate 157*0Sstevel@tonic-gatesub lock_hash (\%) { 158*0Sstevel@tonic-gate my($hash) = shift; 159*0Sstevel@tonic-gate 160*0Sstevel@tonic-gate lock_keys(%$hash); 161*0Sstevel@tonic-gate 162*0Sstevel@tonic-gate foreach my $key (keys %$hash) { 163*0Sstevel@tonic-gate lock_value(%$hash, $key); 164*0Sstevel@tonic-gate } 165*0Sstevel@tonic-gate 166*0Sstevel@tonic-gate return 1; 167*0Sstevel@tonic-gate} 168*0Sstevel@tonic-gate 169*0Sstevel@tonic-gatesub unlock_hash (\%) { 170*0Sstevel@tonic-gate my($hash) = shift; 171*0Sstevel@tonic-gate 172*0Sstevel@tonic-gate foreach my $key (keys %$hash) { 173*0Sstevel@tonic-gate unlock_value(%$hash, $key); 174*0Sstevel@tonic-gate } 175*0Sstevel@tonic-gate 176*0Sstevel@tonic-gate unlock_keys(%$hash); 177*0Sstevel@tonic-gate 178*0Sstevel@tonic-gate return 1; 179*0Sstevel@tonic-gate} 180*0Sstevel@tonic-gate 181*0Sstevel@tonic-gate 182*0Sstevel@tonic-gate=item B<hash_seed> 183*0Sstevel@tonic-gate 184*0Sstevel@tonic-gate my $hash_seed = hash_seed(); 185*0Sstevel@tonic-gate 186*0Sstevel@tonic-gatehash_seed() returns the seed number used to randomise hash ordering. 187*0Sstevel@tonic-gateZero means the "traditional" random hash ordering, non-zero means the 188*0Sstevel@tonic-gatenew even more random hash ordering introduced in Perl 5.8.1. 189*0Sstevel@tonic-gate 190*0Sstevel@tonic-gateB<Note that the hash seed is sensitive information>: by knowing it one 191*0Sstevel@tonic-gatecan craft a denial-of-service attack against Perl code, even remotely, 192*0Sstevel@tonic-gatesee L<perlsec/"Algorithmic Complexity Attacks"> for more information. 193*0Sstevel@tonic-gateB<Do not disclose the hash seed> to people who don't need to know it. 194*0Sstevel@tonic-gateSee also L<perlrun/PERL_HASH_SEED_DEBUG>. 195*0Sstevel@tonic-gate 196*0Sstevel@tonic-gate=cut 197*0Sstevel@tonic-gate 198*0Sstevel@tonic-gatesub hash_seed () { 199*0Sstevel@tonic-gate Internals::rehash_seed(); 200*0Sstevel@tonic-gate} 201*0Sstevel@tonic-gate 202*0Sstevel@tonic-gate=back 203*0Sstevel@tonic-gate 204*0Sstevel@tonic-gate=head1 CAVEATS 205*0Sstevel@tonic-gate 206*0Sstevel@tonic-gateNote that the trapping of the restricted operations is not atomic: 207*0Sstevel@tonic-gatefor example 208*0Sstevel@tonic-gate 209*0Sstevel@tonic-gate eval { %hash = (illegal_key => 1) } 210*0Sstevel@tonic-gate 211*0Sstevel@tonic-gateleaves the C<%hash> empty rather than with its original contents. 212*0Sstevel@tonic-gate 213*0Sstevel@tonic-gate=head1 AUTHOR 214*0Sstevel@tonic-gate 215*0Sstevel@tonic-gateMichael G Schwern <schwern@pobox.com> on top of code by Nick 216*0Sstevel@tonic-gateIng-Simmons and Jeffrey Friedl. 217*0Sstevel@tonic-gate 218*0Sstevel@tonic-gate=head1 SEE ALSO 219*0Sstevel@tonic-gate 220*0Sstevel@tonic-gateL<Scalar::Util>, L<List::Util>, L<Hash::Util>, 221*0Sstevel@tonic-gateand L<perlsec/"Algorithmic Complexity Attacks">. 222*0Sstevel@tonic-gate 223*0Sstevel@tonic-gate=cut 224*0Sstevel@tonic-gate 225*0Sstevel@tonic-gate1; 226