1package Tie::Hash; 2 3our $VERSION = '1.03'; 4 5=head1 NAME 6 7Tie::Hash, Tie::StdHash, Tie::ExtraHash - base class definitions for tied hashes 8 9=head1 SYNOPSIS 10 11 package NewHash; 12 require Tie::Hash; 13 14 @ISA = qw(Tie::Hash); 15 16 sub DELETE { ... } # Provides needed method 17 sub CLEAR { ... } # Overrides inherited method 18 19 20 package NewStdHash; 21 require Tie::Hash; 22 23 @ISA = qw(Tie::StdHash); 24 25 # All methods provided by default, define only those needing overrides 26 # Accessors access the storage in %{$_[0]}; 27 # TIEHASH should return a reference to the actual storage 28 sub DELETE { ... } 29 30 package NewExtraHash; 31 require Tie::Hash; 32 33 @ISA = qw(Tie::ExtraHash); 34 35 # All methods provided by default, define only those needing overrides 36 # Accessors access the storage in %{$_[0][0]}; 37 # TIEHASH should return an array reference with the first element being 38 # the reference to the actual storage 39 sub DELETE { 40 $_[0][1]->('del', $_[0][0], $_[1]); # Call the report writer 41 delete $_[0][0]->{$_[1]}; # $_[0]->SUPER::DELETE($_[1]) 42 } 43 44 45 package main; 46 47 tie %new_hash, 'NewHash'; 48 tie %new_std_hash, 'NewStdHash'; 49 tie %new_extra_hash, 'NewExtraHash', 50 sub {warn "Doing \U$_[1]\E of $_[2].\n"}; 51 52=head1 DESCRIPTION 53 54This module provides some skeletal methods for hash-tying classes. See 55L<perltie> for a list of the functions required in order to tie a hash 56to a package. The basic B<Tie::Hash> package provides a C<new> method, as well 57as methods C<TIEHASH>, C<EXISTS> and C<CLEAR>. The B<Tie::StdHash> and 58B<Tie::ExtraHash> packages 59provide most methods for hashes described in L<perltie> (the exceptions 60are C<UNTIE> and C<DESTROY>). They cause tied hashes to behave exactly like standard hashes, 61and allow for selective overwriting of methods. B<Tie::Hash> grandfathers the 62C<new> method: it is used if C<TIEHASH> is not defined 63in the case a class forgets to include a C<TIEHASH> method. 64 65For developers wishing to write their own tied hashes, the required methods 66are briefly defined below. See the L<perltie> section for more detailed 67descriptive, as well as example code: 68 69=over 4 70 71=item TIEHASH classname, LIST 72 73The method invoked by the command C<tie %hash, classname>. Associates a new 74hash instance with the specified class. C<LIST> would represent additional 75arguments (along the lines of L<AnyDBM_File> and compatriots) needed to 76complete the association. 77 78=item STORE this, key, value 79 80Store datum I<value> into I<key> for the tied hash I<this>. 81 82=item FETCH this, key 83 84Retrieve the datum in I<key> for the tied hash I<this>. 85 86=item FIRSTKEY this 87 88Return the first key in the hash. 89 90=item NEXTKEY this, lastkey 91 92Return the next key in the hash. 93 94=item EXISTS this, key 95 96Verify that I<key> exists with the tied hash I<this>. 97 98The B<Tie::Hash> implementation is a stub that simply croaks. 99 100=item DELETE this, key 101 102Delete the key I<key> from the tied hash I<this>. 103 104=item CLEAR this 105 106Clear all values from the tied hash I<this>. 107 108=item SCALAR this 109 110Returns what evaluating the hash in scalar context yields. 111 112B<Tie::Hash> does not implement this method (but B<Tie::StdHash> 113and B<Tie::ExtraHash> do). 114 115=back 116 117=head1 Inheriting from B<Tie::StdHash> 118 119The accessor methods assume that the actual storage for the data in the tied 120hash is in the hash referenced by C<tied(%tiedhash)>. Thus overwritten 121C<TIEHASH> method should return a hash reference, and the remaining methods 122should operate on the hash referenced by the first argument: 123 124 package ReportHash; 125 our @ISA = 'Tie::StdHash'; 126 127 sub TIEHASH { 128 my $storage = bless {}, shift; 129 warn "New ReportHash created, stored in $storage.\n"; 130 $storage 131 } 132 sub STORE { 133 warn "Storing data with key $_[1] at $_[0].\n"; 134 $_[0]{$_[1]} = $_[2] 135 } 136 137 138=head1 Inheriting from B<Tie::ExtraHash> 139 140The accessor methods assume that the actual storage for the data in the tied 141hash is in the hash referenced by C<(tied(%tiedhash))-E<gt>[0]>. Thus overwritten 142C<TIEHASH> method should return an array reference with the first 143element being a hash reference, and the remaining methods should operate on the 144hash C<< %{ $_[0]->[0] } >>: 145 146 package ReportHash; 147 our @ISA = 'Tie::ExtraHash'; 148 149 sub TIEHASH { 150 my $class = shift; 151 my $storage = bless [{}, @_], $class; 152 warn "New ReportHash created, stored in $storage.\n"; 153 $storage; 154 } 155 sub STORE { 156 warn "Storing data with key $_[1] at $_[0].\n"; 157 $_[0][0]{$_[1]} = $_[2] 158 } 159 160The default C<TIEHASH> method stores "extra" arguments to tie() starting 161from offset 1 in the array referenced by C<tied(%tiedhash)>; this is the 162same storage algorithm as in TIEHASH subroutine above. Hence, a typical 163package inheriting from B<Tie::ExtraHash> does not need to overwrite this 164method. 165 166=head1 C<SCALAR>, C<UNTIE> and C<DESTROY> 167 168The methods C<UNTIE> and C<DESTROY> are not defined in B<Tie::Hash>, 169B<Tie::StdHash>, or B<Tie::ExtraHash>. Tied hashes do not require 170presence of these methods, but if defined, the methods will be called in 171proper time, see L<perltie>. 172 173C<SCALAR> is only defined in B<Tie::StdHash> and B<Tie::ExtraHash>. 174 175If needed, these methods should be defined by the package inheriting from 176B<Tie::Hash>, B<Tie::StdHash>, or B<Tie::ExtraHash>. See L<perltie/"SCALAR"> 177to find out what happens when C<SCALAR> does not exist. 178 179=head1 MORE INFORMATION 180 181The packages relating to various DBM-related implementations (F<DB_File>, 182F<NDBM_File>, etc.) show examples of general tied hashes, as does the 183L<Config> module. While these do not utilize B<Tie::Hash>, they serve as 184good working examples. 185 186=cut 187 188use Carp; 189use warnings::register; 190 191sub new { 192 my $pkg = shift; 193 $pkg->TIEHASH(@_); 194} 195 196# Grandfather "new" 197 198sub TIEHASH { 199 my $pkg = shift; 200 if (defined &{"${pkg}::new"}) { 201 warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing"); 202 $pkg->new(@_); 203 } 204 else { 205 croak "$pkg doesn't define a TIEHASH method"; 206 } 207} 208 209sub EXISTS { 210 my $pkg = ref $_[0]; 211 croak "$pkg doesn't define an EXISTS method"; 212} 213 214sub CLEAR { 215 my $self = shift; 216 my $key = $self->FIRSTKEY(@_); 217 my @keys; 218 219 while (defined $key) { 220 push @keys, $key; 221 $key = $self->NEXTKEY(@_, $key); 222 } 223 foreach $key (@keys) { 224 $self->DELETE(@_, $key); 225 } 226} 227 228# The Tie::StdHash package implements standard perl hash behaviour. 229# It exists to act as a base class for classes which only wish to 230# alter some parts of their behaviour. 231 232package Tie::StdHash; 233# @ISA = qw(Tie::Hash); # would inherit new() only 234 235sub TIEHASH { bless {}, $_[0] } 236sub STORE { $_[0]->{$_[1]} = $_[2] } 237sub FETCH { $_[0]->{$_[1]} } 238sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} } 239sub NEXTKEY { each %{$_[0]} } 240sub EXISTS { exists $_[0]->{$_[1]} } 241sub DELETE { delete $_[0]->{$_[1]} } 242sub CLEAR { %{$_[0]} = () } 243sub SCALAR { scalar %{$_[0]} } 244 245package Tie::ExtraHash; 246 247sub TIEHASH { my $p = shift; bless [{}, @_], $p } 248sub STORE { $_[0][0]{$_[1]} = $_[2] } 249sub FETCH { $_[0][0]{$_[1]} } 250sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} } 251sub NEXTKEY { each %{$_[0][0]} } 252sub EXISTS { exists $_[0][0]->{$_[1]} } 253sub DELETE { delete $_[0][0]->{$_[1]} } 254sub CLEAR { %{$_[0][0]} = () } 255sub SCALAR { scalar %{$_[0][0]} } 256 2571; 258