X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FTie%2FHash.pm;h=1ca8887e7e3ceaba25cf7539d9b5e2c9fb6d4c85;hb=ae8d64f5604623dd5fe5ff5a56e530ae81ba071b;hp=20b677797807340aae48eb565a0e91fd09faed2d;hpb=c954a603b8f02c172ffe0fd3503b4d7ca983ad99;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Tie/Hash.pm b/lib/Tie/Hash.pm index 20b6777..1ca8887 100644 --- a/lib/Tie/Hash.pm +++ b/lib/Tie/Hash.pm @@ -1,50 +1,72 @@ package Tie::Hash; +our $VERSION = '1.03'; + =head1 NAME -Tie::Hash, Tie::StdHash - base class definitions for tied hashes +Tie::Hash, Tie::StdHash, Tie::ExtraHash - base class definitions for tied hashes =head1 SYNOPSIS package NewHash; require Tie::Hash; - - @ISA = (Tie::Hash); - + + @ISA = qw(Tie::Hash); + sub DELETE { ... } # Provides needed method sub CLEAR { ... } # Overrides inherited method - - + + package NewStdHash; require Tie::Hash; - - @ISA = (Tie::StdHash); - + + @ISA = qw(Tie::StdHash); + # All methods provided by default, define only those needing overrides + # Accessors access the storage in %{$_[0]}; + # TIEHASH should return a reference to the actual storage sub DELETE { ... } - - + + package NewExtraHash; + require Tie::Hash; + + @ISA = qw(Tie::ExtraHash); + + # All methods provided by default, define only those needing overrides + # Accessors access the storage in %{$_[0][0]}; + # TIEHASH should return an array reference with the first element being + # the reference to the actual storage + sub DELETE { + $_[0][1]->('del', $_[0][0], $_[1]); # Call the report writer + delete $_[0][0]->{$_[1]}; # $_[0]->SUPER::DELETE($_[1]) + } + + package main; - + tie %new_hash, 'NewHash'; tie %new_std_hash, 'NewStdHash'; + tie %new_extra_hash, 'NewExtraHash', + sub {warn "Doing \U$_[1]\E of $_[2].\n"}; =head1 DESCRIPTION This module provides some skeletal methods for hash-tying classes. See L for a list of the functions required in order to tie a hash to a package. The basic B package provides a C method, as well -as methods C, C and C. The B package -provides most methods required for hashes in L. It inherits from -B, and causes tied hashes to behave exactly like standard hashes, -allowing for selective overloading of methods. The C method is provided -as grandfathering in the case a class forgets to include a C method. +as methods C, C and C. The B and +B packages +provide most methods for hashes described in L (the exceptions +are C and C). They cause tied hashes to behave exactly like standard hashes, +and allow for selective overwriting of methods. B grandfathers the +C method: it is used if C is not defined +in the case a class forgets to include a C method. For developers wishing to write their own tied hashes, the required methods are briefly defined below. See the L section for more detailed descriptive, as well as example code: -=over +=over 4 =item TIEHASH classname, LIST @@ -63,16 +85,18 @@ Retrieve the datum in I for the tied hash I. =item FIRSTKEY this -Return the (key, value) pair for the first key in the hash. +Return the first key in the hash. =item NEXTKEY this, lastkey -Return the next (key, value) pair for the hash. +Return the next key in the hash. =item EXISTS this, key Verify that I exists with the tied hash I. +The B implementation is a stub that simply croaks. + =item DELETE this, key Delete the key I from the tied hash I. @@ -81,25 +105,88 @@ Delete the key I from the tied hash I. Clear all values from the tied hash I. +=item SCALAR this + +Returns what evaluating the hash in scalar context yields. + +B does not implement this method (but B +and B do). + =back -=head1 CAVEATS +=head1 Inheriting from B + +The accessor methods assume that the actual storage for the data in the tied +hash is in the hash referenced by C. Thus overwritten +C method should return a hash reference, and the remaining methods +should operate on the hash referenced by the first argument: + + package ReportHash; + our @ISA = 'Tie::StdHash'; + + sub TIEHASH { + my $storage = bless {}, shift; + warn "New ReportHash created, stored in $storage.\n"; + $storage + } + sub STORE { + warn "Storing data with key $_[1] at $_[0].\n"; + $_[0]{$_[1]} = $_[2] + } + + +=head1 Inheriting from B -The L documentation includes a method called C as -a necessary method for tied hashes. Neither B nor B -define a default for this method. This is a standard for class packages, -but may be omitted in favor of a simple default. +The accessor methods assume that the actual storage for the data in the tied +hash is in the hash referenced by C<(tied(%tiedhash))-E[0]>. Thus overwritten +C method should return an array reference with the first +element being a hash reference, and the remaining methods should operate on the +hash C<< %{ $_[0]->[0] } >>: + + package ReportHash; + our @ISA = 'Tie::ExtraHash'; + + sub TIEHASH { + my $class = shift; + my $storage = bless [{}, @_], $class; + warn "New ReportHash created, stored in $storage.\n"; + $storage; + } + sub STORE { + warn "Storing data with key $_[1] at $_[0].\n"; + $_[0][0]{$_[1]} = $_[2] + } + +The default C method stores "extra" arguments to tie() starting +from offset 1 in the array referenced by C; this is the +same storage algorithm as in TIEHASH subroutine above. Hence, a typical +package inheriting from B does not need to overwrite this +method. + +=head1 C, C and C + +The methods C and C are not defined in B, +B, or B. Tied hashes do not require +presence of these methods, but if defined, the methods will be called in +proper time, see L. + +C is only defined in B and B. + +If needed, these methods should be defined by the package inheriting from +B, B, or B. See L +to find out what happens when C does not exist. =head1 MORE INFORMATION -The packages relating to various DBM-related implemetations (F, +The packages relating to various DBM-related implementations (F, F, etc.) show examples of general tied hashes, as does the L module. While these do not utilize B, they serve as good working examples. =cut - + use Carp; +use warnings::register; sub new { my $pkg = shift; @@ -110,9 +197,8 @@ sub new { sub TIEHASH { my $pkg = shift; - if (defined &{"{$pkg}::new"}) { - carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing" - if $^W; + if (defined &{"${pkg}::new"}) { + warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing"); $pkg->new(@_); } else { @@ -144,7 +230,7 @@ sub CLEAR { # alter some parts of their behaviour. package Tie::StdHash; -@ISA = qw(Tie::Hash); +# @ISA = qw(Tie::Hash); # would inherit new() only sub TIEHASH { bless {}, $_[0] } sub STORE { $_[0]->{$_[1]} = $_[2] } @@ -154,5 +240,18 @@ sub NEXTKEY { each %{$_[0]} } sub EXISTS { exists $_[0]->{$_[1]} } sub DELETE { delete $_[0]->{$_[1]} } sub CLEAR { %{$_[0]} = () } +sub SCALAR { scalar %{$_[0]} } + +package Tie::ExtraHash; + +sub TIEHASH { my $p = shift; bless [{}, @_], $p } +sub STORE { $_[0][0]{$_[1]} = $_[2] } +sub FETCH { $_[0][0]{$_[1]} } +sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} } +sub NEXTKEY { each %{$_[0][0]} } +sub EXISTS { exists $_[0][0]->{$_[1]} } +sub DELETE { delete $_[0][0]->{$_[1]} } +sub CLEAR { %{$_[0][0]} = () } +sub SCALAR { scalar %{$_[0][0]} } 1;