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