home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / Tie / Hash.pm < prev    next >
Encoding:
Perl POD Document  |  2009-06-26  |  1.7 KB  |  75 lines
  1. package Tie::Hash;
  2.  
  3. our $VERSION = '1.02';
  4.  
  5. use Carp;
  6. use warnings::register;
  7.  
  8. sub new {
  9.     my $pkg = shift;
  10.     $pkg->TIEHASH(@_);
  11. }
  12.  
  13. # Grandfather "new"
  14.  
  15. sub TIEHASH {
  16.     my $pkg = shift;
  17.     if (defined &{"${pkg}::new"}) {
  18.     warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing");
  19.     $pkg->new(@_);
  20.     }
  21.     else {
  22.     croak "$pkg doesn't define a TIEHASH method";
  23.     }
  24. }
  25.  
  26. sub EXISTS {
  27.     my $pkg = ref $_[0];
  28.     croak "$pkg doesn't define an EXISTS method";
  29. }
  30.  
  31. sub CLEAR {
  32.     my $self = shift;
  33.     my $key = $self->FIRSTKEY(@_);
  34.     my @keys;
  35.  
  36.     while (defined $key) {
  37.     push @keys, $key;
  38.     $key = $self->NEXTKEY(@_, $key);
  39.     }
  40.     foreach $key (@keys) {
  41.     $self->DELETE(@_, $key);
  42.     }
  43. }
  44.  
  45. # The Tie::StdHash package implements standard perl hash behaviour.
  46. # It exists to act as a base class for classes which only wish to
  47. # alter some parts of their behaviour.
  48.  
  49. package Tie::StdHash;
  50. # @ISA = qw(Tie::Hash);        # would inherit new() only
  51.  
  52. sub TIEHASH  { bless {}, $_[0] }
  53. sub STORE    { $_[0]->{$_[1]} = $_[2] }
  54. sub FETCH    { $_[0]->{$_[1]} }
  55. sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
  56. sub NEXTKEY  { each %{$_[0]} }
  57. sub EXISTS   { exists $_[0]->{$_[1]} }
  58. sub DELETE   { delete $_[0]->{$_[1]} }
  59. sub CLEAR    { %{$_[0]} = () }
  60. sub SCALAR   { scalar %{$_[0]} }
  61.  
  62. package Tie::ExtraHash;
  63.  
  64. sub TIEHASH  { my $p = shift; bless [{}, @_], $p }
  65. sub STORE    { $_[0][0]{$_[1]} = $_[2] }
  66. sub FETCH    { $_[0][0]{$_[1]} }
  67. sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} }
  68. sub NEXTKEY  { each %{$_[0][0]} }
  69. sub EXISTS   { exists $_[0][0]->{$_[1]} }
  70. sub DELETE   { delete $_[0][0]->{$_[1]} }
  71. sub CLEAR    { %{$_[0][0]} = () }
  72. sub SCALAR   { scalar %{$_[0][0]} }
  73.  
  74. 1;
  75.