| Server IP : 49.231.201.246 / Your IP : 216.73.216.149 Web Server : Apache/2.4.18 (Ubuntu) System : Linux 246 4.4.0-210-generic #242-Ubuntu SMP Fri Apr 16 09:57:56 UTC 2021 x86_64 User : root ( 0) PHP Version : 7.0.33-0ubuntu0.16.04.16 Disable Function : exec,passthru,shell_exec,system,proc_open,popen,pcntl_exec MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : ON Directory : /usr/share/perl/5.22/Tie/ |
Upload File : |
package Tie::Hash;
our $VERSION = '1.05';
use Carp;
use warnings::register;
sub new {
my $pkg = shift;
$pkg->TIEHASH(@_);
}
# Grandfather "new"
sub TIEHASH {
my $pkg = shift;
my $pkg_new = $pkg -> can ('new');
if ($pkg_new and $pkg ne __PACKAGE__) {
my $my_new = __PACKAGE__ -> can ('new');
if ($pkg_new == $my_new) {
#
# Prevent recursion
#
croak "$pkg must define either a TIEHASH() or a new() method";
}
warnings::warnif ("WARNING: calling ${pkg}->new since " .
"${pkg}->TIEHASH is missing");
$pkg -> new (@_);
}
else {
croak "$pkg doesn't define a TIEHASH method";
}
}
sub EXISTS {
my $pkg = ref $_[0];
croak "$pkg doesn't define an EXISTS method";
}
sub CLEAR {
my $self = shift;
my $key = $self->FIRSTKEY(@_);
my @keys;
while (defined $key) {
push @keys, $key;
$key = $self->NEXTKEY(@_, $key);
}
foreach $key (@keys) {
$self->DELETE(@_, $key);
}
}
# The Tie::StdHash package implements standard perl hash behaviour.
# It exists to act as a base class for classes which only wish to
# alter some parts of their behaviour.
package Tie::StdHash;
# @ISA = qw(Tie::Hash); # would inherit new() only
sub TIEHASH { bless {}, $_[0] }
sub STORE { $_[0]->{$_[1]} = $_[2] }
sub FETCH { $_[0]->{$_[1]} }
sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
sub NEXTKEY { each %{$_[0]} }
sub EXISTS { exists $_[0]->{$_[1]} }
sub DELETE { delete $_[0]->{$_[1]} }
sub CLEAR { %{$_[0]} = () }
sub SCALAR { scalar %{$_[0]} }
package Tie::ExtraHash;
sub TIEHASH { my $p = shift; bless [{}, @_], $p }
sub STORE { $_[0][0]{$_[1]} = $_[2] }
sub FETCH { $_[0][0]{$_[1]} }
sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} }
sub NEXTKEY { each %{$_[0][0]} }
sub EXISTS { exists $_[0][0]->{$_[1]} }
sub DELETE { delete $_[0][0]->{$_[1]} }
sub CLEAR { %{$_[0][0]} = () }
sub SCALAR { scalar %{$_[0][0]} }
1;