Hash-Case-1.02/000075500000000000000000000000001203660661600131745ustar00rootroot00000000000000Hash-Case-1.02/ChangeLog000064400000000000000000000034351203660661600147530ustar00rootroot00000000000000==== 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/MANIFEST000064400000000000000000000005451203660661600143310ustar00rootroot00000000000000ChangeLog 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/META.yml000064400000000000000000000010421203660661600144420ustar00rootroot00000000000000--- #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/Makefile.PL000064400000000000000000000012111203660661600151410ustar00rootroot00000000000000use 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/README000064400000000000000000000014161203660661600140560ustar00rootroot00000000000000=== 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 Hash-Case-1.02/lib/000075500000000000000000000000001203660661600137425ustar00rootroot00000000000000Hash-Case-1.02/lib/Hash/000075500000000000000000000000001203660661600146255ustar00rootroot00000000000000Hash-Case-1.02/lib/Hash/Case.pm000064400000000000000000000032111203660661600160330ustar00rootroot00000000000000# 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.pod000064400000000000000000000057411203660661600162130ustar00rootroot00000000000000=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/000075500000000000000000000000001203660661600155005ustar00rootroot00000000000000Hash-Case-1.02/lib/Hash/Case/Lower.pm000064400000000000000000000012721203660661600171300ustar00rootroot00000000000000# 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/Lower.pod000064400000000000000000000026311203660661600172760ustar00rootroot00000000000000=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.pm000064400000000000000000000032541203660661600176350ustar00rootroot00000000000000# 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/lib/Hash/Case/Preserve.pod000064400000000000000000000036461203660661600200100ustar00rootroot00000000000000=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.pm000064400000000000000000000012731203660661600171340ustar00rootroot00000000000000# 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/Upper.pod000064400000000000000000000026121203660661600173000ustar00rootroot00000000000000=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/t/000075500000000000000000000000001203660661600134375ustar00rootroot00000000000000Hash-Case-1.02/t/10lower.t000064400000000000000000000022611203660661600151160ustar00rootroot00000000000000#!/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.t000064400000000000000000000027361203660661600151310ustar00rootroot00000000000000#!/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/30pres1.t000064400000000000000000000027551203660661600150320ustar00rootroot00000000000000#!/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.t000064400000000000000000000027341203660661600150310ustar00rootroot00000000000000#!/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/99pod.t000064400000000000000000000004121203660661600145650ustar00rootroot00000000000000#!/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();