Current File : /home/opti/optisoftcom/.cpanm/work/1544535406.20768/Module-Build-0.4224/t/bundled/Tie/CPHash.pm
#---------------------------------------------------------------------
package Tie::CPHash;
#
# Copyright 1997 Christopher J. Madsen
#
# Author: Christopher J. Madsen <cjm@pobox.com>
# Created: 08 Nov 1997
# $Revision$ $Date$
#
# 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:
$VERSION = '1.02';
#=====================================================================
# 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
#---------------------------------------------------------------------
# SCALAR this
# Return bucket usage information for the hash (0 if empty).
sub SCALAR
{
scalar %{$_[0]};
} # end SCALAR
#---------------------------------------------------------------------
# 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> module 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<cjm@pobox.com>E<gt>
=cut
# Local Variables:
# tmtrack-file-task: "Tie::CPHash.pm"
# End:
Mini Shell