File Coverage

blib/lib/Tie/CPHash.pm

Criterion	Covered	Total	%
statement	37	39	94.8
branch	13	14	92.8
condition			n/a
subroutine	14	14	100.0
pod	2	2	100.0
total	66	69	95.6

#---------------------------------------------------------------------
package Tie::CPHash;
#
# Copyright 1997-2012 Christopher J. Madsen
#
# Author: Christopher J. Madsen
# Created: 08 Nov 1997
#
# 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.
#
# ABSTRACT: Case preserving but case insensitive hash table
#---------------------------------------------------------------------

use 5.006;
use strict;
use warnings;

#=====================================================================
# Package Global Variables:

our $VERSION = '1.900'; # TRIAL RELEASE
# This file is part of Tie-CPHash 1.900 (October 4, 2014)

#=====================================================================
# Tied Methods:
#---------------------------------------------------------------------
# TIEHASH classname
#      The method invoked by the command `tie %hash, classname'.
#      Associates a new hash instance with the specified class.

sub TIEHASH
{
    my $self = bless {}, shift;

    $self->add(\@_) if @_;

    return $self;
} # 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:
#---------------------------------------------------------------------


sub add
{
    my $self = shift;
    my $list = (@_ == 1) ? shift : \@_;
    my $limit = $#$list;

    unless ($limit % 2) {
        require Carp;
        Carp::croak("Odd number of elements in CPHash add");
    }

    for (my $i = 0; $i < $limit; $i+=2 ) {
        $self->{lc $list->[$i]} = [ @$list[$i, $i+1] ];
    }

    return $self;
} # end add

# Aliases for Tie::IxHash users:
*Push    = \&add;
*Unshift = \&add;
#---------------------------------------------------------------------


sub key
{
    my $v = $_[0]->{lc $_[1]};
    ($v ? $v->[0] : undef);
}

#=====================================================================
# Package Return Value:

1;

__END__