Added Tie::IxHash and Tie::CPHash to the default distribution to make the install slightly easier.

lib/Tie/CPHash.pm

@@ -0,0 +1,189 @@
+#---------------------------------------------------------------------
+package Tie::CPHash;
+#
+# Copyright 1997 Christopher J. Madsen
+#
+# Author: Christopher J. Madsen <chris_madsen@geocities.com>
+# Created: 08 Nov 1997
+# Version: 1.001 (25-Oct-1998)
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either the
+# GNU General Public License or the Artistic License for more details.
+#
+# Case preserving but case insensitive hash
+#---------------------------------------------------------------------
+
+require 5.000;
+use strict;
+use vars qw(@ISA $VERSION);
+
+@ISA = qw();
+
+#=====================================================================
+# Package Global Variables:
+
+BEGIN
+{
+    # Convert RCS revision number to d.ddd format:
+    $VERSION = sprintf('%d.%03d', '1.001 ' =~ /(\d+)\.(\d+)/);
+} # end BEGIN
+
+#=====================================================================
+# Tied Methods:
+#---------------------------------------------------------------------
+# TIEHASH classname
+#      The method invoked by the command `tie %hash, classname'.
+#      Associates a new hash instance with the specified class.
+
+sub TIEHASH
+{
+    bless {}, $_[0];
+} # end TIEHASH
+
+#---------------------------------------------------------------------
+# STORE this, key, value
+#      Store datum *value* into *key* for the tied hash *this*.
+
+sub STORE
+{
+    $_[0]->{lc $_[1]} = [ $_[1], $_[2] ];
+} # end STORE
+
+#---------------------------------------------------------------------
+# FETCH this, key
+#      Retrieve the datum in *key* for the tied hash *this*.
+
+sub FETCH
+{
+    my $v = $_[0]->{lc $_[1]};
+    ($v ? $v->[1] : undef);
+} # end FETCH
+
+#---------------------------------------------------------------------
+# FIRSTKEY this
+#      Return the (key, value) pair for the first key in the hash.
+
+sub FIRSTKEY
+{
+    my $a = scalar keys %{$_[0]};
+    &NEXTKEY;
+} # end FIRSTKEY
+
+#---------------------------------------------------------------------
+# NEXTKEY this, lastkey
+#      Return the next (key, value) pair for the hash.
+
+sub NEXTKEY
+{
+    my $v = (each %{$_[0]})[1];
+    ($v ? $v->[0] : undef );
+} # end NEXTKEY
+
+#---------------------------------------------------------------------
+# EXISTS this, key
+#     Verify that *key* exists with the tied hash *this*.
+
+sub EXISTS
+{
+    exists $_[0]->{lc $_[1]};
+} # end EXISTS
+
+#---------------------------------------------------------------------
+# DELETE this, key
+#     Delete the key *key* from the tied hash *this*.
+#     Returns the old value, or undef if it didn't exist.
+
+sub DELETE
+{
+    my $v = delete $_[0]->{lc $_[1]};
+    ($v ? $v->[1] : undef);
+} # end DELETE
+
+#---------------------------------------------------------------------
+# CLEAR this
+#     Clear all values from the tied hash *this*.
+
+sub CLEAR
+{
+    %{$_[0]} = ();
+} # end CLEAR
+
+#=====================================================================
+# Other Methods:
+#---------------------------------------------------------------------
+# Return the case of KEY.
+
+sub key
+{
+    my $v = $_[0]->{lc $_[1]};
+    ($v ? $v->[0] : undef);
+}
+
+#=====================================================================
+# Package Return Value:
+
+1;
+
+__END__
+
+=head1 NAME
+
+Tie::CPHash - Case preserving but case insensitive hash table
+
+=head1 SYNOPSIS
+
+    require Tie::CPHash;
+    tie %cphash, 'Tie::CPHash';
+
+    $cphash{'Hello World'} = 'Hi there!';
+    printf("The key `%s' was used to store `%s'.\n",
+           tied(%cphash)->key('HELLO WORLD'),
+           $cphash{'HELLO world'});
+
+=head1 DESCRIPTION
+
+The B<Tie::CPHash> provides a hash table that is case preserving but
+case insensitive.  This means that
+
+    $cphash{KEY}    $cphash{key}
+    $cphash{Key}    $cphash{keY}
+
+all refer to the same entry.  Also, the hash remembers which form of
+the key was last used to store the entry.  The C<keys> and C<each>
+functions will return the key that was used to set the value.
+
+An example should make this clear:
+
+    tie %h, 'Tie::CPHash';
+    $h{Hello} = 'World';
+    print $h{HELLO};            # Prints 'World'
+    print keys(%h);             # Prints 'Hello'
+    $h{HELLO} = 'WORLD';
+    print $h{hello};            # Prints 'WORLD'
+    print keys(%h);             # Prints 'HELLO'
+
+The additional C<key> method lets you fetch the case of a specific key:
+
+    # When run after the previous example, this prints 'HELLO':
+    print tied(%h)->key('Hello');
+
+(The C<tied> function returns the object that C<%h> is tied to.)
+
+If you need a case insensitive hash, but don't need to preserve case,
+just use C<$hash{lc $key}> instead of C<$hash{$key}>.  This has a lot
+less overhead than B<Tie::CPHash>.
+
+=head1 AUTHOR
+
+Christopher J. Madsen E<lt>F<chris_madsen@geocities.com>E<gt>
+
+=cut
+
+# Local Variables:
+# tmtrack-file-task: "Tie::CPHash.pm"
+# End: