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