# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl CatHash.t'

#########################

# change 'tests => 1' to 'tests => last_test_to_print';

use strict;
use Benchmark qw(:all);
use Scalar::Util qw(looks_like_number);
no warnings 'uninitialized';

use Test::More tests => 41;

BEGIN { use_ok('DBI') };

# null and undefs -- segfaults?;
is (DBI::_concat_hash_sorted(undef, "=",   ":",   0, undef), undef);
is (DBI::_concat_hash_sorted({ },   "=",   ":",   0, undef), "");
eval { DBI::_concat_hash_sorted([], "=",   ":",   0, undef) };
like ($@ || "", qr/is not a hash reference/);
is (DBI::_concat_hash_sorted({ },   undef, ":",   0,     undef), "");
is (DBI::_concat_hash_sorted({ },   "=",   undef, 0,     undef), "");
is (DBI::_concat_hash_sorted({ },   "=",   ":",   undef, undef),"");

# simple cases
is (DBI::_concat_hash_sorted({ 1=>"a", 2=>"b" }, "=", ", ", undef, undef), "1='a', 2='b'");
# nul byte in key sep and pair sep
# (nul byte in hash not supported)
is DBI::_concat_hash_sorted({ 1=>"a", 2=>"b" }, "=\000=", ":\000:", undef, undef),
    "1=\000='a':\000:2=\000='b'", 'should work with nul bytes in kv_sep and pair_sep';
is DBI::_concat_hash_sorted({ 1=>"a\000a", 2=>"b" }, "=", ":", 1, undef),
    "1='a.a':2='b'", 'should work with nul bytes in hash value (neat)';
is DBI::_concat_hash_sorted({ 1=>"a\000a", 2=>"b" }, "=", ":", 0, undef),
    "1='a\000a':2='b'", 'should work with nul bytes in hash value (not neat)';

# Simple stress tests
# limit stress when performing automated testing
# eg http://www.nntp.perl.org/group/perl.cpan.testers/2009/06/msg4374116.html
my $stress = $ENV{AUTOMATED_TESTING} ? 1_000 : 10_000;
ok(DBI::_concat_hash_sorted({bob=>'two', fred=>'one' }, "="x$stress, ":", 1, undef));
ok(DBI::_concat_hash_sorted({bob=>'two', fred=>'one' }, "=", ":"x$stress, 1, undef));
ok(DBI::_concat_hash_sorted({map {$_=>undef} (1..1000)}, "="x$stress, ":", 1, undef));
ok(DBI::_concat_hash_sorted({map {$_=>undef} (1..1000)}, "=", ":"x$stress, 1, undef), 'test');
ok(DBI::_concat_hash_sorted({map {$_=>undef} (1..100)}, "="x$stress, ":"x$stress, 1, undef), 'test');

my $simple_hash = {
    bob=>"there",
    jack=>12,
    fred=>"there",
    norman=>"there",
    # sam =>undef
};

my $simple_numeric = {
    1=>"there",
    2=>"there",
    16 => 'yo',
    07 => "buddy",
    49 => undef,
};

my $simple_mixed = {
    bob=>"there",
    jack=>12,
    fred=>"there",
    sam =>undef,
    1=>"there",
    32=>"there",
    16 => 'yo',
    07 => "buddy",
    49 => undef,
};

my $simple_float = {
    1.12 =>"there",
    3.1415926 =>"there",
    32=>"there",
    1.6 => 'yo',
    0.78 => "buddy",
    49 => undef,
};

#eval {
#    DBI::_concat_hash_sorted($simple_hash, "=",,":",1,12);
#};
ok(1," Unknown sort order");
#like ($@, qr/Unknown sort order/, "Unknown sort order");



## Loopify and Add Neat


my %neats = (
    "Neat"=>0, 
    "Not Neat"=> 1
);
my %sort_types = (
    guess=>undef, 
    numeric => 1, 
    lexical=> 0
);
my %hashes = (
    Numeric=>$simple_numeric, 
    "Simple Hash" => $simple_hash, 
    "Mixed Hash" => $simple_mixed,
    "Float Hash" => $simple_float
);

for my $sort_type (keys %sort_types){
    for my $neat (keys %neats) {
        for my $hash (keys %hashes) {
            test_concat_hash($hash, $neat, $sort_type);
        }
    }
}

sub test_concat_hash {
    my ($hash, $neat, $sort_type) = @_;
    my @args = ($hashes{$hash}, "=", ":",$neats{$neat}, $sort_types{$sort_type});
    is (
        DBI::_concat_hash_sorted(@args),
        _concat_hash_sorted(@args),
        "$hash - $neat $sort_type"
    );
}

if (0) {
    eval {
        cmpthese(200_000, {
	    Perl => sub {_concat_hash_sorted($simple_hash, "=", ":",0,undef); },
	    C=> sub {DBI::_concat_hash_sorted($simple_hash, "=", ":",0,1);}
        });

        print "\n";
        cmpthese(200_000, {
  	    NotNeat => sub {DBI::_concat_hash_sorted(
                $simple_hash, "=", ":",1,undef);
            },
	    Neat    => sub {DBI::_concat_hash_sorted(
                $simple_hash, "=", ":",0,undef);
            }
        });
    };
}
#CatHash::_concat_hash_values({ }, ":-",,"::",1,1);


sub _concat_hash_sorted { 
    my ( $hash_ref, $kv_separator, $pair_separator, $use_neat, $num_sort ) = @_;
    # $num_sort: 0=lexical, 1=numeric, undef=try to guess
        
    return undef unless defined $hash_ref;
    die "hash is not a hash reference" unless ref $hash_ref eq 'HASH';
    my $keys = _get_sorted_hash_keys($hash_ref, $num_sort);
    my $string = '';
    for my $key (@$keys) {
        $string .= $pair_separator if length $string > 0;
        my $value = $hash_ref->{$key};
        if ($use_neat) {
            $value = DBI::neat($value, 0); 
        } 
        else {
            $value = (defined $value) ? "'$value'" : 'undef';
        }
        $string .= $key . $kv_separator . $value;
    }
    return $string;
}

sub _get_sorted_hash_keys {
    my ($hash_ref, $sort_type) = @_;
    if (not defined $sort_type) {
        my $sort_guess = 1;
        $sort_guess = (not looks_like_number($_)) ? 0 : $sort_guess
            for keys %$hash_ref;
        $sort_type = $sort_guess;
    }
    
    my @keys = keys %$hash_ref;
    no warnings 'numeric';
    my @sorted = ($sort_type)
        ? sort { $a <=> $b or $a cmp $b } @keys
        : sort    @keys;
    #warn "$sort_type = @sorted\n";
    return \@sorted;
}

1;