home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl502b.zip / lib / TieHash.pm < prev    next >
Text File  |  1995-12-28  |  4KB  |  158 lines
  1. package TieHash;
  2.  
  3. =head1 NAME
  4.  
  5. TieHash, TieHash::Std - base class definitions for tied hashes
  6.  
  7. =head1 SYNOPSIS
  8.  
  9.     package NewHash;
  10.     require TieHash;
  11.     
  12.     @ISA = (TieHash);
  13.     
  14.     sub DELETE { ... }        # Provides needed method
  15.     sub CLEAR { ... }        # Overrides inherited method
  16.     
  17.     
  18.     package NewStdHash;
  19.     require TieHash;
  20.     
  21.     @ISA = (TieHash::Std);
  22.     
  23.     # All methods provided by default, define only those needing overrides
  24.     sub DELETE { ... }
  25.     
  26.     
  27.     package main;
  28.     
  29.     tie %new_hash, NewHash;
  30.     tie %new_std_hash, NewStdHash;
  31.  
  32. =head1 DESCRIPTION
  33.  
  34. This module provides some skeletal methods for hash-tying classes. See
  35. L<perlfunc/tie> for a list of the functions required in order to tie a hash
  36. to a package. The basic B<TieHash> package provides a C<new> method, as well
  37. as methods C<TIEHASH>, C<EXISTS> and C<CLEAR>. The B<TieHash::Std> package
  38. provides most methods required for hashes in L<perlfunc/tie>. It inherits from
  39. B<TieHash>, and causes tied hashes to behave exactly like standard hashes,
  40. allowing for selective overloading of methods. The B<new> method is provided
  41. as grandfathering in the case a class forgets to include a B<TIEHASH> method.
  42.  
  43. For developers wishing to write their own tied hashes, the required methods
  44. are:
  45.  
  46. =item TIEHASH classname, LIST
  47.  
  48. The method invoked by the command C<tie %hash, class>. Associates a new
  49. hash instance with the specified class. C<LIST> would represent additional
  50. arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
  51. complete the association.
  52.  
  53. =item STORE this, key, value
  54.  
  55. Store datum I<value> into I<key> for the tied hash I<this>.
  56.  
  57. =item FETCH this, key
  58.  
  59. Retrieve the datum in I<key> for the tied hash I<this>.
  60.  
  61. =item FIRSTKEY this
  62.  
  63. Return the (key, value) pair for the first key in the hash.
  64.  
  65. =item NEXTKEY this, lastkey
  66.  
  67. Return the next (key, value) pair for the hash.
  68.  
  69. =item EXISTS this, key
  70.  
  71. Verify that I<key> exists with the tied hash I<this>.
  72.  
  73. =item DELETE this, key
  74.  
  75. Delete the key I<key> from the tied hash I<this>.
  76.  
  77. =item CLEAR this
  78.  
  79. Clear all values from the tied hash I<this>.
  80.  
  81. =back
  82.  
  83. =head1 CAVEATS
  84.  
  85. The L<perlfunc/tie> documentation includes a method called C<DESTROY> as
  86. a necessary method for tied hashes. Neither B<TieHash> nor B<TieHash::Std>
  87. define a default for this method.
  88.  
  89. The C<CLEAR> method provided by these two packages is not listed in the
  90. L<perlfunc/tie> section.
  91.  
  92. =head1 MORE INFORMATION
  93.  
  94. The packages relating to various DBM-related implemetations (F<DB_File>,
  95. F<NDBM_File>, etc.) show examples of general tied hashes, as does the
  96. L<Config> module. While these do not utilize B<TieHash>, they serve as
  97. good working examples.
  98.  
  99. =cut
  100.     
  101. use Carp;
  102.  
  103. sub new {
  104.     my $pkg = shift;
  105.     $pkg->TIEHASH(@_);
  106. }
  107.  
  108. # Grandfather "new"
  109.  
  110. sub TIEHASH {
  111.     my $pkg = shift;
  112.     if (defined &{"{$pkg}::new"}) {
  113.     carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing"
  114.         if $^W;
  115.     $pkg->new(@_);
  116.     }
  117.     else {
  118.     croak "$pkg doesn't define a TIEHASH method";
  119.     }
  120. }
  121.  
  122. sub EXISTS {
  123.     my $pkg = ref $_[0];
  124.     croak "$pkg doesn't define an EXISTS method";
  125. }
  126.  
  127. sub CLEAR {
  128.     my $self = shift;
  129.     my $key = $self->FIRSTKEY(@_);
  130.     my @keys;
  131.  
  132.     while (defined $key) {
  133.     push @keys, $key;
  134.     $key = $self->NEXTKEY(@_, $key);
  135.     }
  136.     foreach $key (@keys) {
  137.     $self->DELETE(@_, $key);
  138.     }
  139. }
  140.  
  141. # The TieHash::Std package implements standard perl hash behaviour.
  142. # It exists to act as a base class for classes which only wish to
  143. # alter some parts of their behaviour.
  144.  
  145. package TieHash::Std;
  146. @ISA = qw(TieHash);
  147.  
  148. sub TIEHASH  { bless {}, $_[0] }
  149. sub STORE    { $_[0]->{$_[1]} = $_[2] }
  150. sub FETCH    { $_[0]->{$_[1]} }
  151. sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
  152. sub NEXTKEY  { each %{$_[0]} }
  153. sub EXISTS   { exists $_[0]->{$_[1]} }
  154. sub DELETE   { delete $_[0]->{$_[1]} }
  155. sub CLEAR    { %{$_[0]} = () }
  156.  
  157. 1;
  158.