home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl501m.zip / lib / TieHash.pm < prev    next >
Text File  |  1995-07-03  |  1KB  |  59 lines
  1. package TieHash;
  2. use Carp;
  3.  
  4. sub new {
  5.     my $pack = shift;
  6.     $pack->TIEHASH(@_);
  7. }
  8.  
  9. # Grandfather "new"
  10.  
  11. sub TIEHASH {
  12.     my $pack = shift;
  13.     if (defined &{"$pack\::new"}) {
  14.     carp "WARNING: calling $pack\->new since $pack\->TIEHASH is missing"
  15.         if $^W;
  16.     $pack->new(@_);
  17.     }
  18.     else {
  19.     croak "$pack doesn't define a TIEHASH method";
  20.     }
  21. }
  22.  
  23. sub EXISTS {
  24.     my $pack = ref $_[0];
  25.     croak "$pack doesn't define an EXISTS method";
  26. }
  27.  
  28. sub CLEAR {
  29.     my $self = shift;
  30.     my $key = $self->FIRSTKEY(@_);
  31.     my @keys;
  32.  
  33.     while (defined $key) {
  34.     push @keys, $key;
  35.     $key = $self->NEXTKEY(@_, $key);
  36.     }
  37.     foreach $key (@keys) {
  38.     $self->DELETE(@_, $key);
  39.     }
  40. }
  41.  
  42. # The TieHash::Std package implements standard perl hash behaviour.
  43. # It exists to act as a base class for classes which only wish to
  44. # alter some parts of their behaviour.
  45.  
  46. package TieHash::Std;
  47. @ISA = qw(TieHash);
  48.  
  49. sub TIEHASH  { bless {}, $_[0] }
  50. sub STORE    { $_[0]->{$_[1]} = $_[2] }
  51. sub FETCH    { $_[0]->{$_[1]} }
  52. sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
  53. sub NEXTKEY  { each %{$_[0]} }
  54. sub EXISTS   { exists $_[0]->{$_[1]} }
  55. sub DELETE   { delete $_[0]->{$_[1]} }
  56. sub CLEAR    { %{$_[0]} = () }
  57.  
  58. 1;
  59.