uawdijnntqw1x1x1
IP : 216.73.216.155
Hostname : vm5018.vps.agava.net
Kernel : Linux vm5018.vps.agava.net 3.10.0-1127.8.2.vz7.151.14 #1 SMP Tue Jun 9 12:58:54 MSK 2020 x86_64
Disable Function : None :)
OS : Linux
PATH:
/
var
/
..
/
usr
/
local
/
..
/
lib
/
perl
/
5.10.1
/
Hash
/
Util.pm
/
/
package Hash::Util; require 5.007003; use strict; use Carp; use warnings; use warnings::register; use Scalar::Util qw(reftype); require Exporter; our @ISA = qw(Exporter); our @EXPORT_OK = qw( fieldhash fieldhashes all_keys lock_keys unlock_keys lock_value unlock_value lock_hash unlock_hash lock_keys_plus hash_locked hidden_keys legal_keys lock_ref_keys unlock_ref_keys lock_ref_value unlock_ref_value lock_hashref unlock_hashref lock_ref_keys_plus hashref_locked hidden_ref_keys legal_ref_keys hash_seed hv_store ); our $VERSION = 0.07; require DynaLoader; local @ISA = qw(DynaLoader); bootstrap Hash::Util $VERSION; sub import { my $class = shift; if ( grep /fieldhash/, @_ ) { require Hash::Util::FieldHash; Hash::Util::FieldHash->import(':all'); # for re-export } unshift @_, $class; goto &Exporter::import; } sub lock_ref_keys { my($hash, @keys) = @_; Internals::hv_clear_placeholders %$hash; if( @keys ) { my %keys = map { ($_ => 1) } @keys; my %original_keys = map { ($_ => 1) } keys %$hash; foreach my $k (keys %original_keys) { croak "Hash has key '$k' which is not in the new key set" unless $keys{$k}; } foreach my $k (@keys) { $hash->{$k} = undef unless exists $hash->{$k}; } Internals::SvREADONLY %$hash, 1; foreach my $k (@keys) { delete $hash->{$k} unless $original_keys{$k}; } } else { Internals::SvREADONLY %$hash, 1; } return $hash; } sub unlock_ref_keys { my $hash = shift; Internals::SvREADONLY %$hash, 0; return $hash; } sub lock_keys (\%;@) { lock_ref_keys(@_) } sub unlock_keys (\%) { unlock_ref_keys(@_) } sub lock_ref_keys_plus { my ($hash,@keys)=@_; my @delete; Internals::hv_clear_placeholders(%$hash); foreach my $key (@keys) { unless (exists($hash->{$key})) { $hash->{$key}=undef; push @delete,$key; } } Internals::SvREADONLY(%$hash,1); delete @{$hash}{@delete}; return $hash } sub lock_keys_plus(\%;@) { lock_ref_keys_plus(@_) } sub lock_ref_value { my($hash, $key) = @_; # I'm doubtful about this warning, as it seems not to be true. # Marking a value in the hash as RO is useful, regardless # of the status of the hash itself. carp "Cannot usefully lock values in an unlocked hash" if !Internals::SvREADONLY(%$hash) && warnings::enabled; Internals::SvREADONLY $hash->{$key}, 1; return $hash } sub unlock_ref_value { my($hash, $key) = @_; Internals::SvREADONLY $hash->{$key}, 0; return $hash } sub lock_value (\%$) { lock_ref_value(@_) } sub unlock_value (\%$) { unlock_ref_value(@_) } sub lock_hashref { my $hash = shift; lock_ref_keys($hash); foreach my $value (values %$hash) { Internals::SvREADONLY($value,1); } return $hash; } sub unlock_hashref { my $hash = shift; foreach my $value (values %$hash) { Internals::SvREADONLY($value, 0); } unlock_ref_keys($hash); return $hash; } sub lock_hash (\%) { lock_hashref(@_) } sub unlock_hash (\%) { unlock_hashref(@_) } sub lock_hashref_recurse { my $hash = shift; lock_ref_keys($hash); foreach my $value (values %$hash) { if (reftype($value) eq 'HASH') { lock_hashref_recurse($value); } Internals::SvREADONLY($value,1); } return $hash } sub unlock_hashref_recurse { my $hash = shift; foreach my $value (values %$hash) { if (reftype($value) eq 'HASH') { unlock_hashref_recurse($value); } Internals::SvREADONLY($value,1); } unlock_ref_keys($hash); return $hash; } sub lock_hash_recurse (\%) { lock_hashref_recurse(@_) } sub unlock_hash_recurse (\%) { unlock_hashref_recurse(@_) } sub hashref_unlocked { my $hash=shift; return Internals::SvREADONLY($hash) } sub hash_unlocked(\%) { hashref_unlocked(@_) } sub legal_keys(\%) { legal_ref_keys(@_) } sub hidden_keys(\%){ hidden_ref_keys(@_) } sub hash_seed () { Internals::rehash_seed(); } 1;
/var/../usr/local/../lib/perl/5.10.1/Hash/Util.pm