Hash-Case-1.02/0000755000175000001440000000000011726337115012414 5ustar markovusersHash-Case-1.02/Makefile.PL0000644000175000001440000000121111726337114014360 0ustar markovusersuse ExtUtils::MakeMaker; use 5.008; WriteMakefile ( NAME => 'Hash::Case' , VERSION => '1.02' , PREREQ_PM => { Test::More => 0.47 , Log::Report => 0.26 } , AUTHOR => 'Mark Overmeer' , ABSTRACT => 'Play trics with hash keys' , LICENSE => 'perl' ); sub MY::postamble { <<'__POSTAMBLE' } # for DIST RAWDIR = ../public_html/hash-case/raw DISTDIR = ../public_html/hash-case/source LICENSE = artistic # for POD FIRST_YEAR = 2002-2003,2007 EMAIL = perl@overmeer.net WEBSITE = http://perl.overmeer.net/hash-case/ SKIP_LINKS = XML::LibXML __POSTAMBLE Hash-Case-1.02/t/0000755000175000001440000000000011726337115012657 5ustar markovusersHash-Case-1.02/t/30pres1.t0000644000175000001440000000275511726337061014252 0ustar markovusers#!/usr/bin/perl -w # Test case-preserving hash, where the last appearance is kept. use strict; use Test::More; use lib qw/. t/; BEGIN {plan tests => 37} use Hash::Case::Preserve; my %h; tie %h, 'Hash::Case::Preserve', keep => 'LAST'; cmp_ok(keys %h, '==', 0); $h{ABC} = 3; cmp_ok($h{ABC}, '==', 3); cmp_ok($h{abc}, '==', 3); cmp_ok($h{AbC}, '==', 3); cmp_ok(keys %h, '==', 1); my @h = keys %h; cmp_ok(@h, '==', 1); is($h[0], 'ABC'); # last STORE $h{abc} = 6; cmp_ok(keys %h, '==', 1); cmp_ok($h{ABC}, '==', 6); is((keys %h)[0], 'abc'); $h{ABC} = 3; cmp_ok(keys %h, '==', 1); cmp_ok($h{ABC}, '==', 3); is((keys %h)[0], 'ABC'); $h{dEf} = 4; cmp_ok($h{def}, '==', 4); cmp_ok($h{dEf}, '==', 4); cmp_ok(keys %h, '==', 2); my (@k, @v); while(my ($k, $v) = each %h) { push @k, $k; push @v, $v; } cmp_ok(@k, '==', 2); @k = sort @k; is($k[0], 'ABC'); is($k[1], 'dEf'); cmp_ok(@v, '==', 2); @v = sort {$a <=> $b} @v; cmp_ok($v[0], '==', 3); cmp_ok($v[1], '==', 4); ok(exists $h{ABC}); cmp_ok(delete $h{ABC}, '==', 3); cmp_ok(keys %h, '==', 1); %h = (); cmp_ok(keys %h, '==', 0); ok(tied %h); my %a; tie %a, 'Hash::Case::Preserve', [ AbC => 3, dEf => 4 ], keep => 'LAST'; ok(tied %a); cmp_ok(keys %a, '==', 2); ok(defined $a{abc}); cmp_ok($a{ABC}, '==', 3); cmp_ok($a{DeF}, '==', 4); my %b; tie %b, 'Hash::Case::Preserve', { AbC => 3, dEf => 4 }, keep => 'LAST'; ok(tied %b); cmp_ok(keys %b, '==', 2); ok(defined $b{abc}); cmp_ok($b{ABC}, '==', 3); cmp_ok($b{DeF}, '==', 4); Hash-Case-1.02/t/31pres2.t0000644000175000001440000000273411726337061014251 0ustar markovusers#!/usr/bin/perl -w # Test case-preserving hash, where the first appearance is kept. use strict; use Test::More; use lib qw/. t/; BEGIN {plan tests => 37} use Hash::Case::Preserve; my %h; tie %h, 'Hash::Case::Preserve', keep => 'FIRST'; cmp_ok(keys %h, '==', 0); $h{ABC} = 3; cmp_ok($h{ABC}, '==', 3); cmp_ok($h{abc}, '==', 3); cmp_ok($h{AbC}, '==', 3); cmp_ok(keys %h, '==', 1); my @h = keys %h; ok(@h==1); is($h[0], 'ABC'); # first STORE $h{abc} = 6; cmp_ok(keys %h, '==', 1); cmp_ok($h{ABC}, '==', 6); is((keys %h)[0], 'ABC'); $h{ABC} = 3; cmp_ok(keys %h, '==', 1); cmp_ok($h{ABC}, '==', 3); is((keys %h)[0], 'ABC'); $h{dEf} = 4; cmp_ok($h{def}, '==', 4); cmp_ok($h{dEf}, '==', 4); cmp_ok(keys %h, '==', 2); my (@k, @v); while(my ($k, $v) = each %h) { push @k, $k; push @v, $v; } cmp_ok(@k, '==', 2); @k = sort @k; is($k[0], 'ABC'); is($k[1], 'dEf'); ok(@v==2); @v = sort {$a <=> $b} @v; cmp_ok($v[0], '==', 3); cmp_ok($v[1], '==', 4); ok(exists $h{ABC}); cmp_ok(delete $h{ABC}, '==', 3); cmp_ok(keys %h, '==', 1); %h = (); cmp_ok(keys %h, '==', 0); ok(tied %h); my %a; tie %a, 'Hash::Case::Preserve', [ AbC => 3, dEf => 4 ], keep => 'FIRST'; ok(tied %a); cmp_ok(keys %a, '==', 2); ok(defined $a{abc}); cmp_ok($a{ABC}, '==', 3); cmp_ok($a{DeF}, '==', 4); my %b; tie %b, 'Hash::Case::Preserve', { AbC => 3, dEf => 4 }, keep => 'FIRST'; ok(tied %b); cmp_ok(keys %b, '==', 2); ok(defined $b{abc}); cmp_ok($b{ABC}, '==', 3); cmp_ok($b{DeF}, '==', 4); Hash-Case-1.02/t/10lower.t0000644000175000001440000000226111726337061014336 0ustar markovusers#!/usr/bin/perl -w # Test lower cased hash use strict; use Test::More; use lib qw/. t/; BEGIN {plan tests => 31} use Hash::Case::Lower; my %h; tie %h, 'Hash::Case::Lower'; cmp_ok(keys %h, '==', 0); $h{abc} = 3; cmp_ok($h{abc}, '==', 3); cmp_ok($h{ABC}, '==', 3); cmp_ok($h{AbC}, '==', 3); cmp_ok(keys %h, '==', 1); my @h = keys %h; cmp_ok(@h, '==', 1); is($h[0], 'abc'); $h{dEf} = 4; cmp_ok($h{def}, '==', 4); cmp_ok($h{dEf}, '==', 4); cmp_ok(keys %h, '==', 2); my (@k, @v); while(my ($k, $v) = each %h) { push @k, $k; push @v, $v; } cmp_ok(@k, '==', 2); @k = sort @k; is($k[0], 'abc'); is($k[1], 'def'); ok(@v==2); @v = sort {$a <=> $b} @v; cmp_ok($v[0], '==', 3); cmp_ok($v[1], '==', 4); ok(exists $h{ABC}); cmp_ok(delete $h{ABC}, '==', 3); cmp_ok(keys %h, '==', 1); %h = (); cmp_ok(keys %h, '==', 0); ok(tied %h); my %a; tie %a, 'Hash::Case::Lower', [ AbC => 3, dEf => 4 ]; ok(tied %a); cmp_ok(keys %a, '==', 2); ok(defined $a{abc}); cmp_ok($a{ABC}, '==', 3); cmp_ok($a{DeF}, '==', 4); my %b; tie %b, 'Hash::Case::Lower', { AbC => 3, dEf => 4 }; ok(tied %b); cmp_ok(keys %b, '==', 2); ok(defined $b{abc}); cmp_ok($b{ABC}, '==', 3); cmp_ok($b{DeF}, '==', 4); Hash-Case-1.02/t/20upper.t0000644000175000001440000000273611726337061014351 0ustar markovusers#!/usr/bin/perl -w # Test upper cased hash use strict; use Test::More; use lib qw/. t/; BEGIN {plan tests => 35} use Hash::Case::Upper; my %h; tie %h, 'Hash::Case::Upper'; cmp_ok(keys %h, '==', 0); $h{ABC} = 3; cmp_ok($h{ABC}, '==', 3); cmp_ok($h{abc}, '==', 3); cmp_ok($h{AbC}, '==', 3); cmp_ok(keys %h, '==', 1); my @h = keys %h; cmp_ok(@h, '==', 1); is($h[0], 'ABC'); $h{dEf} = 4; cmp_ok($h{def}, '==', 4); cmp_ok($h{dEf}, '==', 4); cmp_ok(keys %h, '==', 2); my (@k, @v); while(my ($k, $v) = each %h) { push @k, $k; push @v, $v; } cmp_ok(@k, '==', 2); @k = sort @k; is($k[0], 'ABC'); is($k[1], 'DEF'); cmp_ok(@v, '==', 2); @v = sort {$a <=> $b} @v; cmp_ok($v[0], '==', 3); cmp_ok($v[1], '==', 4); ok(exists $h{ABC}); cmp_ok(delete $h{ABC}, '==', 3); cmp_ok(keys %h, '==', 1); %h = (); cmp_ok(keys %h, '==', 0); ok(tied %h); my %a; tie %a, 'Hash::Case::Upper', [ AbC => 3, dEf => 4 ]; ok(tied %a); cmp_ok(keys %a, '==', 2); ok(defined $a{abc}); cmp_ok($a{ABC}, '==', 3); cmp_ok($a{DeF}, '==', 4); my %b; tie %b, 'Hash::Case::Upper', { AbC => 3, dEf => 4 }; ok(tied %b); cmp_ok(keys %b, '==', 2); ok(defined $b{abc}); cmp_ok($b{ABC}, '==', 3); cmp_ok($b{DeF}, '==', 4); ### test boolean context (bug reported by Dmitry Bolshakoff) tie my %c, 'Hash::Case::Upper'; is((%c ? 'yes' : 'no'), 'no', 'empty'); is((!%c ? 'yes' : 'no'), 'yes', 'empty'); $c{111} = 222; is((%c ? 'yes' : 'no'), 'yes', 'not empty'); is((!%c ? 'yes' : 'no'), 'no', 'not empty'); Hash-Case-1.02/t/99pod.t0000644000175000001440000000041211726337061014005 0ustar markovusers#!/usr/bin/perl use warnings; use strict; use Test::More; BEGIN { eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; plan skip_all => "devel home uses OODoc" if $ENV{MARKOV_DEVEL}; } all_pod_files_ok(); Hash-Case-1.02/ChangeLog0000644000175000001440000000343511726337114014172 0ustar markovusers==== version history of Hash::Case All change made by Mark Overmeer. version 1.02: Fri Mar 9 09:24:30 CET 2012 Fixes: - typo in docs. rt.cpan.org#75630 [Florian Schlich] - remove unused nested Makefile.PL rt.cpan.org#75630 [Florian Schlich] version 1.01: Mon Feb 15 10:21:42 CET 2010 Fixes: - do not use /bin/pwd in t/pod.t Improvements: - use Log::Report for error handling. version 1.006: Thu Jun 19 08:40:46 CEST 2008 - perl5.005 does not understand "use 5.6.0" and tie bug in 5.6.2. So require 5.008 [cpantesters] version 1.005: Wed Jun 18 09:02:28 CEST 2008 - require perl 5.6.0 [cpantesters] - minor distribution clean-ups version 1.004: Fri Jun 8 15:37:31 CEST 2007 - fixed 2 typo's in POD (Thanks to CPANTS) - add t/pod.t - use oodist to create docs. version 1.003: Mon Oct 27 07:58:44 CET 2003 - Added methods addPairs() and addHashData() to initialize a hash with values. - Use Test::More i.s.o. Test - Move pm files to a new lib/ directory - Copyrights also in 2003 version 1.002: Fri Aug 2 16:48:23 CEST 2002 - Changed my e-mail address to mark@overmeer.net - Added Hash::Case::init() as dummy. - Some configuration problems fixed. - An array passed as initializer for the hash was cleaned in the process, which is not nice, of course. Reported by [Jenda Krynicky] version 1.001: Sat Jun 15 13:29:55 CEST 2002 This code is fully tested, and too simple to be true, so I release it without hesitation as stable. - Initial implementation of Hash::Case - Initial implementation of Hash::Case::Lower, tests in t/10lower.t - Initial implementation of Hash::Case::Upper, tests in t/20upper.t - Initial implementation of Hash::Case::Preserve, tests in t/30pres1.t - Initial implementation of Hash::Case::Preserve, tests in t/31pres2.t Hash-Case-1.02/META.yml0000644000175000001440000000104211726337115013662 0ustar markovusers--- #YAML:1.0 name: Hash-Case version: 1.02 abstract: Play trics with hash keys author: - Mark Overmeer license: perl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Log::Report: 0.26 Test::More: 0.47 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.56 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Hash-Case-1.02/lib/0000755000175000001440000000000011726337115013162 5ustar markovusersHash-Case-1.02/lib/Hash/0000755000175000001440000000000011726337115014045 5ustar markovusersHash-Case-1.02/lib/Hash/Case.pod0000644000175000001440000000574111726337114015432 0ustar markovusers=head1 NAME Hash::Case - base class for hashes with key-casing requirements =head1 INHERITANCE Hash::Case is a Tie::StdHash Hash::Case is extended by Hash::Case::Lower Hash::Case::Preserve Hash::Case::Upper =head1 SYNOPSIS use Hash::Case::Lower; tie my(%lchash), 'Hash::Case::Lower'; $lchash{StraNGeKeY} = 3; print keys %lchash; # strangekey =head1 DESCRIPTION Hash::Case is the base class for various classes which tie special treatment for the casing of keys. Be aware of the differences in implementation: C and C are tied native hashes: these hashes have no need for hidden fields or other assisting data structured. A case C hash will actually create three hashes. The following strategies are implemented: =over 4 =item * Hash::Case::Lower (native hash) Keys are always considered lower case. The internals of this module translate any incoming key to lower case before it is used. =item * Hash::Case::Upper (native hash) Like the ::Lower, but then all keys are always translated into upper case. This module can be of use for some databases, which do translate everything to capitals as well. To avoid confusion, you may want to have you own internal Perl hash do this as well. =item * Hash::Case::Preserve The actual casing is ignored, but not forgotten. =back =head1 METHODS =head2 Constructors =over 4 =item $obj-EB(HASH) Add the data of a hash (passed as reference) to the created tied hash. The existing values in the hash remain, the keys are adapted to the needs of the the casing. =item $obj-EB(PAIRS) Specify an even length list of alternating key and value to be stored in the hash. =item $obj-EB(HASH) The functionality differs for native and wrapper hashes. For native hashes, this is the same as first clearing the hash, and then a call to L. Wrapper hashes will use the hash you specify here to store the data, and re-create the mapping hash. =item B(HASH, TIE, [VALUES,] OPTIONS) Tie the HASH with the TIE package which extends L. The OPTIONS differ per implementation: read the manual page for the package you actually use. The VALUES is a reference to an array containing key-value pairs, or a reference to a hash: they fill the initial hash. example: my %x; tie %x, 'Hash::Case::Lower'; $x{Upper} = 3; print keys %x; # 'upper' my @y = (ABC => 3, DeF => 4); tie %x, 'Hash::Case::Lower', \@y; print keys %x; # 'abc' 'def' my %z = (ABC => 3, DeF => 4); tie %x, 'Hash::Case::Lower', \%z; =back =head1 SEE ALSO This module is part of Hash-Case distribution version 1.02, built on March 09, 2012. Website: F =head1 LICENSE Copyrights 2002-2003,2007-2012 by Mark Overmeer. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Hash-Case-1.02/lib/Hash/Case.pm0000644000175000001440000000321111726337114015252 0ustar markovusers# Copyrights 2002-2003,2007-2012 by Mark Overmeer. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.00. use warnings; use strict; package Hash::Case; use vars '$VERSION'; $VERSION = '1.02'; use Tie::Hash; # contains Tie::StdHash use base 'Tie::StdHash'; use Log::Report 'hash-case'; sub TIEHASH(@) { my $class = shift; my $to = @_ % 2 ? shift : undef; my %opts = (@_, add => $to); (bless {}, $class)->init( \%opts ); } # Used for case-insensitive hashes which do not need more than # one hash. sub native_init($) { my ($self, $args) = @_; my $add = delete $args->{add}; if(!$add) { ; } elsif(ref $add eq 'ARRAY') { $self->addPairs(@$add) } elsif(ref $add eq 'HASH') { $self->addHashData($add) } else { error "cannot initialize the native hash this way" } $self; } # Used for case-insensitive hashes which are implemented around # an existing hash. sub wrapper_init($) { my ($self, $args) = @_; my $add = delete $args->{add}; if(!$add) { ; } elsif(ref $add eq 'ARRAY') { $self->addPairs(@$add) } elsif(ref $add eq 'HASH') { $self->setHash($add) } else { error "cannot initialize a wrapping hash this way" } $self; } sub addPairs(@) { my $self = shift; $self->STORE(shift, shift) while @_; $self; } sub addHashData($) { my ($self, $data) = @_; while(my ($k, $v) = each %$data) { $self->STORE($k, $v) } $self; } sub setHash($) { my ($self, $hash) = @_; # the native implementation is the default. %$self = %$hash; $self; } 1; Hash-Case-1.02/lib/Hash/Case/0000755000175000001440000000000011726337115014720 5ustar markovusersHash-Case-1.02/lib/Hash/Case/Lower.pm0000644000175000001440000000127211726337114016347 0ustar markovusers# Copyrights 2002-2003,2007-2012 by Mark Overmeer. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.00. use strict; use warnings; package Hash::Case::Lower; use vars '$VERSION'; $VERSION = '1.02'; use base 'Hash::Case'; use Log::Report 'hash-case'; sub init($) { my ($self, $args) = @_; $self->SUPER::native_init($args); error __x"no options possible for {pkg}", pkg => __PACKAGE__ if keys %$args; $self; } sub FETCH($) { $_[0]->{lc $_[1]} } sub STORE($$) { $_[0]->{lc $_[1]} = $_[2] } sub EXISTS($) { exists $_[0]->{lc $_[1]} } sub DELETE($) { delete $_[0]->{lc $_[1]} } 1; Hash-Case-1.02/lib/Hash/Case/Upper.pm0000644000175000001440000000127311726337114016353 0ustar markovusers# Copyrights 2002-2003,2007-2012 by Mark Overmeer. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.00. use strict; use warnings; package Hash::Case::Upper; use vars '$VERSION'; $VERSION = '1.02'; use base 'Hash::Case'; use Log::Report 'hash-case'; sub init($) { my ($self, $args) = @_; $self->SUPER::native_init($args); error __x"no options available for {pkg}", pkg => __PACKAGE__ if keys %$args; $self; } sub FETCH($) { $_[0]->{uc $_[1]} } sub STORE($$) { $_[0]->{uc $_[1]} = $_[2] } sub EXISTS($) { exists $_[0]->{uc $_[1]} } sub DELETE($) { delete $_[0]->{uc $_[1]} } 1; Hash-Case-1.02/lib/Hash/Case/Preserve.pod0000644000175000001440000000364611726337114017227 0ustar markovusers=head1 NAME Hash::Case::Preserve - hash with enforced lower cased keys =head1 INHERITANCE Hash::Case::Preserve is a Hash::Case is a Tie::StdHash =head1 SYNOPSIS use Hash::Case::Preserve; tie my(%cphash), 'Hash::Case::Preserve'; $cphash{StraNGeKeY} = 3; print keys %cphash; # StraNGeKeY print $cphash{strangekey}; # 3 print $cphash{STRANGEKEY}; # 3 =head1 DESCRIPTION Hash::Case::Preserve extends L, which lets you play various trics with hash keys. This extension implements a fake hash which is case-insentive. The keys are administered in the casing as they were used: case-insensitive but case-preserving. =head1 METHODS =head2 Constructors =over 4 =item $obj-EB(HASH) See L =item $obj-EB(PAIRS) See L =item $obj-EB(HASH) See L =item B(HASH, 'Hash::Case::Preserve', [VALUES,] OPTIONS) Define HASH to be case insensitive, but case preserving. The hash is initialized with the VALUES, specified as ref-array (passing a list of key-value pairs) or ref-hash. OPTIONS is a list of key/value pairs, which specify how the hash must handle preservation. Current options: -Option--Default keep 'LAST' =over 2 =item keep => 'FIRST' | 'LAST' Which casing is the preferred casing? The FIRST appearance or the LAST. Only stores will affect the casing, deletes will undo the definition. Defaults to LAST, which is slightly faster. =back =back =head1 SEE ALSO This module is part of Hash-Case distribution version 1.02, built on March 09, 2012. Website: F =head1 LICENSE Copyrights 2002-2003,2007-2012 by Mark Overmeer. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Hash-Case-1.02/lib/Hash/Case/Upper.pod0000644000175000001440000000261211726337114016517 0ustar markovusers=head1 NAME Hash::Case::Upper - native hash with enforced lower cased keys =head1 INHERITANCE Hash::Case::Upper is a Hash::Case is a Tie::StdHash =head1 SYNOPSIS use Hash::Case::Upper; tie my(%uchash), 'Hash::Case::Upper'; $uchash{StraNGeKeY} = 3; print keys %uchash; # STRANGEKEY =head1 DESCRIPTION Hash::Case::Upper extends L, which lets you play various trics with hash keys. In this implementation, the fake hash is case insensitive and the keys stored in upper-case. =head1 METHODS =head2 Constructors =over 4 =item $obj-EB(HASH) See L =item $obj-EB(PAIRS) See L =item $obj-EB(HASH) See L =item B(HASH, 'Hash::Case::Upper', [VALUES,] OPTIONS) Define HASH to have only upper cased keys. The hash is initialized with the VALUES, specified as ref-array or ref-hash. Currently, there are no OPTIONS defined. =back =head1 SEE ALSO This module is part of Hash-Case distribution version 1.02, built on March 09, 2012. Website: F =head1 LICENSE Copyrights 2002-2003,2007-2012 by Mark Overmeer. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Hash-Case-1.02/lib/Hash/Case/Lower.pod0000644000175000001440000000263111726337114016515 0ustar markovusers=head1 NAME Hash::Case::Lower - hash with enforced lower cased keys =head1 INHERITANCE Hash::Case::Lower is a Hash::Case is a Tie::StdHash =head1 SYNOPSIS use Hash::Case::Lower; tie my(%lchash), 'Hash::Case::Lower'; $lchash{StraNGeKeY} = 3; print keys %lchash; # strangekey =head1 DESCRIPTION Hash::Case::Lower extends L, which lets you play various trics with hash keys. In this implementation, the fake hash is case insensitive and the keys stored in lower-case. =head1 METHODS =head2 Constructors =over 4 =item $obj-EB(HASH) See L =item $obj-EB(PAIRS) See L =item $obj-EB(HASH) See L =item B(HASH, 'Hash::Case::Lower', [VALUES,] OPTIONS) Define HASH to have only lower cased keys. The hash is initialized with the VALUES, specified as ref-array (with key value pairs) or ref-hash. Currently, there are no OPTIONS defined. =back =head1 SEE ALSO This module is part of Hash-Case distribution version 1.02, built on March 09, 2012. Website: F =head1 LICENSE Copyrights 2002-2003,2007-2012 by Mark Overmeer. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F Hash-Case-1.02/lib/Hash/Case/Preserve.pm0000644000175000001440000000325411726337114017054 0ustar markovusers# Copyrights 2002-2003,2007-2012 by Mark Overmeer. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.00. use strict; use warnings; package Hash::Case::Preserve; use vars '$VERSION'; $VERSION = '1.02'; use base 'Hash::Case'; use Log::Report 'hash-case'; sub init($) { my ($self, $args) = @_; $self->{HCP_data} = {}; $self->{HCP_keys} = {}; my $keep = $args->{keep} || 'LAST'; if($keep eq 'LAST') { $self->{HCP_update} = 1 } elsif($keep eq 'FIRST') { $self->{HCP_update} = 0 } else { error "use 'FIRST' or 'LAST' with the option keep"; } $self->SUPER::native_init($args); } # Maintain two hashes within this object: one to store the values, and # one to preserve the casing. The main object also stores the options. # The data is kept under lower cased keys. sub FETCH($) { $_[0]->{HCP_data}{lc $_[1]} } sub STORE($$) { my ($self, $key, $value) = @_; my $lckey = lc $key; $self->{HCP_keys}{$lckey} = $key if $self->{HCP_update} || !exists $self->{HCP_keys}{$lckey}; $self->{HCP_data}{$lckey} = $value; } sub FIRSTKEY { my $self = shift; my $a = scalar keys %{$self->{HCP_keys}}; $self->NEXTKEY; } sub NEXTKEY($) { my $self = shift; if(my ($k, $v) = each %{$self->{HCP_keys}}) { return wantarray ? ($v, $self->{HCP_data}{$k}) : $v; } else { return () } } sub EXISTS($) { exists $_[0]->{HCP_data}{lc $_[1]} } sub DELETE($) { my $lckey = lc $_[1]; delete $_[0]->{HCP_keys}{$lckey}; delete $_[0]->{HCP_data}{$lckey}; } sub CLEAR() { %{$_[0]->{HCP_data}} = (); %{$_[0]->{HCP_keys}} = (); } 1; Hash-Case-1.02/MANIFEST0000644000175000001440000000054511726337115013551 0ustar markovusersChangeLog MANIFEST Makefile.PL README lib/Hash/Case.pm lib/Hash/Case.pod lib/Hash/Case/Lower.pm lib/Hash/Case/Lower.pod lib/Hash/Case/Preserve.pm lib/Hash/Case/Preserve.pod lib/Hash/Case/Upper.pm lib/Hash/Case/Upper.pod t/10lower.t t/20upper.t t/30pres1.t t/31pres2.t t/99pod.t META.yml Module meta-data (added by MakeMaker) Hash-Case-1.02/README0000644000175000001440000000141611726337061013276 0ustar markovusers=== README for Hash-Case version 1.01 = Generated on Fri Mar 9 09:24:17 2012 by OODoc 2.00 There are various ways to install this module: (1) if you have a command-line, you can do: perl -MCPAN -e 'install ' (2) if you use Windows, have a look at http://ppm.activestate.com/ (3) if you have downloaded this module manually (as root/administrator) gzip -d Hash-Case-1.01.tar.gz tar -xf Hash-Case-1.01.tar cd Hash-Case-1.01 perl Makefile.PL make # optional make test # optional make install For usage, see the included manual-pages or http://search.cpan.org/dist/Hash-Case-1.01/ Please report problems to http://rt.cpan.org/Dist/Display.html?Queue=Hash-Case