ALT Linux Sisyphus - Package perl-Hash-Case

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 <any package from this distribution>'

 (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<Lower> and C<Upper> are tied native hashes:
these hashes have no need for hidden fields or other assisting
data structured.  A case C<Preserve> 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-E<gt>B<addHashData>(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-E<gt>B<addPairs>(PAIRS)

Specify an even length list of alternating key and value to be stored in
the hash.

=item $obj-E<gt>B<setHash>(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<addHashData()|Hash::Case/"Constructors">.  Wrapper hashes will use the hash you specify here
to store the data, and re-create the mapping hash.

=item B<tie>(HASH, TIE, [VALUES,] OPTIONS)

Tie the HASH with the TIE package which extends L<Hash::Case>.  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<http://perl.overmeer.net/hash-case/>

=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<http://www.perl.com/perl/misc/Artistic.html>

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<Hash::Case|Hash::Case>, 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-E<gt>B<addHashData>(HASH)

See L<Hash::Case/"Constructors">

=item $obj-E<gt>B<addPairs>(PAIRS)

See L<Hash::Case/"Constructors">

=item $obj-E<gt>B<setHash>(HASH)

See L<Hash::Case/"Constructors">

=item B<tie>(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<http://perl.overmeer.net/hash-case/>

=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<http://www.perl.com/perl/misc/Artistic.html>

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<Hash::Case|Hash::Case>, 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-E<gt>B<addHashData>(HASH)

See L<Hash::Case/"Constructors">

=item $obj-E<gt>B<addPairs>(PAIRS)

See L<Hash::Case/"Constructors">

=item $obj-E<gt>B<setHash>(HASH)

See L<Hash::Case/"Constructors">

=item B<tie>(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<http://perl.overmeer.net/hash-case/>

=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<http://www.perl.com/perl/misc/Artistic.html>

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<Hash::Case|Hash::Case>, 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-E<gt>B<addHashData>(HASH)

See L<Hash::Case/"Constructors">

=item $obj-E<gt>B<addPairs>(PAIRS)

See L<Hash::Case/"Constructors">

=item $obj-E<gt>B<setHash>(HASH)

See L<Hash::Case/"Constructors">

=item B<tie>(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<http://perl.overmeer.net/hash-case/>

=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<http://www.perl.com/perl/misc/Artistic.html>

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();