lib/Tie/RefHash.pm

   1 #
   2 # Tie/RefHash.pm - use references as hash keys
   3 #
   4 # Documentation at the __END__
   5 #
   6
   7 require 5.004;
   8 package Tie::RefHash;
   9 use Tie::Hash;
  10 @ISA = qw(Tie::Hash);
  11 use strict;
  12
  13 sub TIEHASH {
  14   my $c = shift;
  15   my $s = [];
  16   bless $s, $c;
  17   while (@_) {
  18     $s->STORE(shift, shift);
  19   }
  20   return $s;
  21 }
  22
  23 sub FETCH {
  24   my($s, $k) = @_;
  25   (ref $k) ? $s->[0]{"$k"}[1] : $s->[1]{$k};
  26 }
  27
  28 sub STORE {
  29   my($s, $k, $v) = @_;
  30   if (ref $k) {
  31     $s->[0]{"$k"} = [$k, $v];
  32   }
  33   else {
  34     $s->[1]{$k} = $v;
  35   }
  36   $v;
  37 }
  38
  39 sub DELETE {
  40   my($s, $k) = @_;
  41   (ref $k) ? delete($s->[0]{"$k"}) : delete($s->[1]{$k});
  42 }
  43
  44 sub EXISTS {
  45   my($s, $k) = @_;
  46   (ref $k) ? exists($s->[0]{"$k"}) : exists($s->[1]{$k});
  47 }
  48
  49 sub FIRSTKEY {
  50   my $s = shift;
  51   my $a = scalar(keys %{$s->[0]}) + scalar(keys %{$s->[1]});
  52   $s->[2] = 0;
  53   $s->NEXTKEY;
  54 }
  55
  56 sub NEXTKEY {
  57   my $s = shift;
  58   my ($k, $v);
  59   if (!$s->[2]) {
  60     if (($k, $v) = each %{$s->[0]}) {
  61       return $s->[0]{"$k"}[0];
  62     }
  63     else {
  64       $s->[2] = 1;
  65     }
  66   }
  67   return each %{$s->[1]};
  68 }
  69
  70 sub CLEAR {
  71   my $s = shift;
  72   $s->[2] = 0;
  73   %{$s->[0]} = ();
  74   %{$s->[1]} = ();
  75 }
  76
  77 1;
  78
  79 __END__
  80
  81 =head1 NAME
  82
  83 Tie::RefHash - use references as hash keys
  84
  85
  86 =head1 SYNOPSIS
  87
  88     require 5.004;
  89     use Tie::RefHash;
  90     tie HASHVARIABLE, 'Tie::RefHash', LIST;
  91
  92     untie HASHVARIABLE;
  93
  94
  95 =head1 DESCRIPTION
  96
  97 This module provides the ability to use references as hash keys if
  98 you first C<tie> the hash variable to this module.
  99
 100 It is implemented using the standard perl TIEHASH interface.  Please
 101 see the C<tie> entry in perlfunc(1) and perltie(1) for more information.
 102
 103
 104 =head1 EXAMPLE
 105
 106     use Tie::RefHash;
 107     tie %h, 'Tie::RefHash';
 108     $a = [];
 109     $b = {};
 110     $c = \*main;
 111     $d = \"gunk";
 112     $e = sub { 'foo' };
 113     %h = ($a => 1, $b => 2, $c => 3, $d => 4, $e => 5);
 114     $a->[0] = 'foo';
 115     $b->{foo} = 'bar';
 116     for (keys %h) {
 117        print ref($_), "\n";
 118     }
 119
 120
 121 =head1 AUTHOR
 122
 123 Gurusamy Sarathy        gsar@umich.edu
 124
 125
 126 =head1 VERSION
 127
 128 Version 1.2    15 Dec 1996
 129
 130
 131 =head1 SEE ALSO
 132
 133 perl(1), perlfunc(1), perltie(1)
 134
 135
 136 =cut