Source code of Windows XP (NT5)
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

158 lines
3.9 KiB

  1. package Tie::Hash;
  2. =head1 NAME
  3. Tie::Hash, Tie::StdHash - base class definitions for tied hashes
  4. =head1 SYNOPSIS
  5. package NewHash;
  6. require Tie::Hash;
  7. @ISA = (Tie::Hash);
  8. sub DELETE { ... } # Provides needed method
  9. sub CLEAR { ... } # Overrides inherited method
  10. package NewStdHash;
  11. require Tie::Hash;
  12. @ISA = (Tie::StdHash);
  13. # All methods provided by default, define only those needing overrides
  14. sub DELETE { ... }
  15. package main;
  16. tie %new_hash, 'NewHash';
  17. tie %new_std_hash, 'NewStdHash';
  18. =head1 DESCRIPTION
  19. This module provides some skeletal methods for hash-tying classes. See
  20. L<perltie> for a list of the functions required in order to tie a hash
  21. to a package. The basic B<Tie::Hash> package provides a C<new> method, as well
  22. as methods C<TIEHASH>, C<EXISTS> and C<CLEAR>. The B<Tie::StdHash> package
  23. provides most methods required for hashes in L<perltie>. It inherits from
  24. B<Tie::Hash>, and causes tied hashes to behave exactly like standard hashes,
  25. allowing for selective overloading of methods. The C<new> method is provided
  26. as grandfathering in the case a class forgets to include a C<TIEHASH> method.
  27. For developers wishing to write their own tied hashes, the required methods
  28. are briefly defined below. See the L<perltie> section for more detailed
  29. descriptive, as well as example code:
  30. =over
  31. =item TIEHASH classname, LIST
  32. The method invoked by the command C<tie %hash, classname>. Associates a new
  33. hash instance with the specified class. C<LIST> would represent additional
  34. arguments (along the lines of L<AnyDBM_File> and compatriots) needed to
  35. complete the association.
  36. =item STORE this, key, value
  37. Store datum I<value> into I<key> for the tied hash I<this>.
  38. =item FETCH this, key
  39. Retrieve the datum in I<key> for the tied hash I<this>.
  40. =item FIRSTKEY this
  41. Return the (key, value) pair for the first key in the hash.
  42. =item NEXTKEY this, lastkey
  43. Return the next key for the hash.
  44. =item EXISTS this, key
  45. Verify that I<key> exists with the tied hash I<this>.
  46. =item DELETE this, key
  47. Delete the key I<key> from the tied hash I<this>.
  48. =item CLEAR this
  49. Clear all values from the tied hash I<this>.
  50. =back
  51. =head1 CAVEATS
  52. The L<perltie> documentation includes a method called C<DESTROY> as
  53. a necessary method for tied hashes. Neither B<Tie::Hash> nor B<Tie::StdHash>
  54. define a default for this method. This is a standard for class packages,
  55. but may be omitted in favor of a simple default.
  56. =head1 MORE INFORMATION
  57. The packages relating to various DBM-related implementations (F<DB_File>,
  58. F<NDBM_File>, etc.) show examples of general tied hashes, as does the
  59. L<Config> module. While these do not utilize B<Tie::Hash>, they serve as
  60. good working examples.
  61. =cut
  62. use Carp;
  63. sub new {
  64. my $pkg = shift;
  65. $pkg->TIEHASH(@_);
  66. }
  67. # Grandfather "new"
  68. sub TIEHASH {
  69. my $pkg = shift;
  70. if (defined &{"${pkg}::new"}) {
  71. carp "WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing"
  72. if $^W;
  73. $pkg->new(@_);
  74. }
  75. else {
  76. croak "$pkg doesn't define a TIEHASH method";
  77. }
  78. }
  79. sub EXISTS {
  80. my $pkg = ref $_[0];
  81. croak "$pkg doesn't define an EXISTS method";
  82. }
  83. sub CLEAR {
  84. my $self = shift;
  85. my $key = $self->FIRSTKEY(@_);
  86. my @keys;
  87. while (defined $key) {
  88. push @keys, $key;
  89. $key = $self->NEXTKEY(@_, $key);
  90. }
  91. foreach $key (@keys) {
  92. $self->DELETE(@_, $key);
  93. }
  94. }
  95. # The Tie::StdHash package implements standard perl hash behaviour.
  96. # It exists to act as a base class for classes which only wish to
  97. # alter some parts of their behaviour.
  98. package Tie::StdHash;
  99. @ISA = qw(Tie::Hash);
  100. sub TIEHASH { bless {}, $_[0] }
  101. sub STORE { $_[0]->{$_[1]} = $_[2] }
  102. sub FETCH { $_[0]->{$_[1]} }
  103. sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
  104. sub NEXTKEY { each %{$_[0]} }
  105. sub EXISTS { exists $_[0]->{$_[1]} }
  106. sub DELETE { delete $_[0]->{$_[1]} }
  107. sub CLEAR { %{$_[0]} = () }
  108. 1;