diff options
| author | Manuel Traut <manut@mecka.net> | 2011-04-29 09:09:27 +0200 |
|---|---|---|
| committer | Manuel Traut <manut@mecka.net> | 2011-04-29 09:09:27 +0200 |
| commit | 5238ad5a0c4a9e1c8cd036f5de4055e39bd71297 (patch) | |
| tree | 4407c087b9fb5432b1dc11e70b52dacfa0b99feb /beagle/debian-rfs/usr/share/perl/5.10.1/Tie | |
| parent | 60ead65c41afba7e6aa4bbcf507a1d52f7a8fe9f (diff) | |
added debootstrap stuff
Signed-off-by: Manuel Traut <manut@mecka.net>
Diffstat (limited to 'beagle/debian-rfs/usr/share/perl/5.10.1/Tie')
| -rw-r--r-- | beagle/debian-rfs/usr/share/perl/5.10.1/Tie/Hash.pm | 74 |
1 files changed, 74 insertions, 0 deletions
diff --git a/beagle/debian-rfs/usr/share/perl/5.10.1/Tie/Hash.pm b/beagle/debian-rfs/usr/share/perl/5.10.1/Tie/Hash.pm new file mode 100644 index 0000000..e3e8a24 --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl/5.10.1/Tie/Hash.pm @@ -0,0 +1,74 @@ +package Tie::Hash; + +our $VERSION = '1.03'; + +use Carp; +use warnings::register; + +sub new { + my $pkg = shift; + $pkg->TIEHASH(@_); +} + +# Grandfather "new" + +sub TIEHASH { + my $pkg = shift; + if (defined &{"${pkg}::new"}) { + 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; |
