The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl
use strict;
use warnings;

use Test::More;
use Test::Exception;
use Hashids;
use Math::BigInt;

plan tests => 10;

my $salt = "this is my salt";

subtest 'basics' => sub {
    plan tests => 8;

    can_ok( Hashids => "new" );
    my $hashids = Hashids->new();
    isa_ok( $hashids, 'Hashids' );

    is( $hashids->salt, '', 'no salt' );

    $hashids = Hashids->new( salt => $salt );
    is( $hashids->salt, $salt, 'low salt' );

    $hashids = $hashids->new($salt);
    is( $hashids->salt, $salt, 'single-arg constructor' );

    subtest 'hash length' => sub {
        plan tests => 3;

        is( $hashids->minHashLength, 0, 'default minHashLength' );

        my $minHashLength = 8;
        $hashids = Hashids->new( minHashLength => $minHashLength );
        is( $hashids->minHashLength, $minHashLength, 'set minHashLength' );

        $minHashLength = 'top lol';
        throws_ok {
            Hashids->new( minHashLength => $minHashLength );
        }
        qr/not a number/, 'invalid minHashLength';
    };

    subtest 'alphabet' => sub {
        plan tests => 5;

        is( $hashids->alphabet,
            join( '' => ( 'a' .. 'z', 'A' .. 'Z', 1 .. 9, 0 ) ),
            'default alphabet'
        );

        my $alphabet = join '' => ( 'a' .. 'z' );
        $hashids = Hashids->new( alphabet => $alphabet );
        is( $hashids->alphabet, $alphabet, 'custom alphabet' );

        $alphabet = "abc";
        throws_ok {
            Hashids->new( alphabet => $alphabet );
        }
        qr/must contain at least 16/, 'at least 16 chars';

        $alphabet = "gjklmnopqrvwxyzABDEGJKLMNOPQRVWXYZ1234567890g";
        throws_ok {
            Hashids->new( alphabet => $alphabet );
        }
        qr/must contain unique/, 'must have unique chars';

        $alphabet = "ab cd";
        throws_ok {
            Hashids->new( alphabet => $alphabet );
        }
        qr/must not have spaces/, 'no spaces allowed';

    };

    subtest 'chars, seps, and guards' => sub {
        plan tests => 3;

        ok( $hashids->chars,  'has chars' );
        ok( $hashids->seps,   'has seps' );
        ok( $hashids->guards, 'has guards' );
    };
};

subtest 'simple encode/decode' => sub {
    plan tests => 6;

    my $hashids = Hashids->new( salt => $salt );

    is( $hashids->encode(),               '', 'no encode' );
    is( $hashids->encode('up the wazoo'), '', 'bad encode' );

    my $plaintext = 123;
    my $encoded   = 'YDx';
    is( $hashids->encode($plaintext), $encoded,   'encode 1' );
    is( $hashids->decode($encoded),   $plaintext, 'decode 1' );

    $plaintext = 123456;
    $encoded   = '4DLz6';
    is( $hashids->encode($plaintext), $encoded,   'encode 2' );
    is( $hashids->decode($encoded),   $plaintext, 'decode 2' );

};

subtest 'encode with minHashLength' => sub {
    plan tests => 4;

    my $hashids = Hashids->new( salt => $salt, minHashLength => 15 );

    my $plaintext = 123;
    my $encoded   = 'V34xpAYDx0mQNvl';
    is( $hashids->encode($plaintext), $encoded,   'encode minHashLength' );
    is( $hashids->decode($encoded),   $plaintext, 'decode minHashLength' );

    $hashids = Hashids->new( salt => '', minHashLength => 12 );
    $plaintext = [ 123, 456, 789 ];
    $encoded = 'peEl3fkRIo3d';
    is( $hashids->encode(@$plaintext), $encoded, 'encode minHashLength(12)' );
    is_deeply( scalar $hashids->decode($encoded),
        $plaintext, 'decode minHashLength(12)' );
};

subtest 'list encode/decode' => sub {
    plan tests => 7;

    my $hashids = Hashids->new( salt => $salt );

    can_ok( $hashids, qw/encode decode/ );

    my @plaintexts = ( 1, 2, 3 );
    my $encoded = 'laHquq';
    is( $hashids->encode(@plaintexts), $encoded, 'encode list 1' );
    is_deeply( scalar $hashids->decode($encoded),
        \@plaintexts, 'decode list 1' );

    @plaintexts = ( 123, 456, 789 );
    $encoded = 'Z8gi1DIx6';
    is( $hashids->encode(@plaintexts), $encoded, 'encode list 2' );
    is_deeply( scalar $hashids->decode($encoded),
        \@plaintexts, 'decode list 2' );

    subtest 'decode return as list' => sub {
        plan tests => 2;

        my @single = $hashids->decode('YDx');
        is_deeply( \@single, [123], 'decode as list (single value)' );

        my @result = $hashids->decode($encoded);
        is_deeply( \@result, \@plaintexts, 'decode as list (multi)' );
    };

    subtest 'list encode/decode with minHashLength' => sub {
        plan tests => 2;

        $hashids = Hashids->new( salt => $salt, minHashLength => 16 );
        $encoded = 'j1DAZ8gi1DIx6Glx';

        is( $hashids->encode(@plaintexts),
            $encoded, 'encode list with minHashLength' );

        my @result = $hashids->decode($encoded);
        is_deeply( \@result, \@plaintexts, 'decode as list (minHashLength)' );
    };
};

subtest 'work with counting numbers only' => sub {
    my $hashids = Hashids->new();

    plan tests => 4;

    is( $hashids->encode(12.3), '', 'not an integer' );
    is( $hashids->encode(-1),   '', 'not a positive integer' );
    is( $hashids->encode( 123, 45.6 ), '', 'no integer in list' );
    is( $hashids->encode( -1, -2, 3 ), '', 'negative integers in list' );
};

subtest 'encode hex strings' => sub {
    plan tests => 4;

    my $hashids = Hashids->new( salt => $salt );

    my $plaintext = 'deadbeef';
    my $encoded   = 'kRNrpKlJ';
    is( $hashids->encode_hex($plaintext), $encoded,   'encode hex string' );
    is( $hashids->decode_hex($encoded),   $plaintext, 'decode hex string' );

    is( $hashids->encode_hex('invalid'), '', 'invalid encode hex string' );
    is( $hashids->decode_hex('invalid'), '', 'invalid decode hex string' );
};

subtest 'work with custom alphabets' => sub {
    plan tests => 4;

    # also tests for regex meta chars and alphabets with mostly seps
    my $alphabet = 'cfhistuCFHISTU+-*/';
    my $hashids = Hashids->new( salt => $salt, alphabet => $alphabet );

    my @plaintext = ( 1, 2, 3 );
    my $encoded = '+-H/u/+';
    is( $hashids->encode(@plaintext), $encoded, 'encode with mostly seps' );

    my @result = $hashids->decode($encoded);
    is_deeply( \@result, \@plaintext, 'decode with mostly seps' );

    # test for alphabet with no seps
    $alphabet = 'abdegjklmnop+-*/';
    $hashids = Hashids->new( salt => $salt, alphabet => $alphabet );

    $encoded = 'olb*do';
    is( $hashids->encode(@plaintext), $encoded, 'encode with no seps' );
    @result = $hashids->decode($encoded);
    is_deeply( \@result, \@plaintext, 'decode with no seps' );
};

subtest 'v0.3.0 hashids.js API compatibility' => sub {
    plan tests => 6;

    my $hashids = Hashids->new( salt => $salt );

    is( $hashids->encrypt(),               '', 'no encrypt' );
    is( $hashids->encrypt('up the wazoo'), '', 'bad encrypt' );

    my $plaintext = 123;
    my $encrypted = 'YDx';
    is( $hashids->encrypt($plaintext), $encrypted, 'encrypt 1' );
    is( $hashids->decrypt($encrypted), $plaintext, 'decrypt 1' );

    my @plaintexts = ( 1, 2, 3 );
    $encrypted = 'laHquq';
    is( $hashids->encrypt(@plaintexts), $encrypted, 'encrypt 2' );
    my @result = $hashids->decrypt($encrypted);
    is_deeply( \@result, \@plaintexts, 'decrypt 2' );
};

subtest 'test encode/decode series comparison' => sub {
    plan tests => 1002;

    my $hashids = Hashids->new('fdfs42842f');

    foreach ( 0 .. 1000 ) {
        my $new = $hashids->encode($_);
        is( $hashids->decode($new), $_, "encode/decode val $_" );
    }

    # test array of hashes that start with zero
    my @arr     = ( 99, 111, 599, 811, 955 );
    my $encoded = $hashids->encode(@arr);
    my @decoded = $hashids->decode($encoded);

    is_deeply( \@decoded, \@arr, 'known array series' );
};

subtest 'BigInt and 2^53+1 support' => sub {

    # bignum keys are strings so that 32-bit perls can read them
    my %bignums = (
        '9_007_199_254_740_992'     => 'mNWyy8yjQYE',
        '9_007_199_254_740_993'     => 'n6WOO7OkrgY',
        '18_014_398_509_481_984'    => '7KpVVxJ6pOy',
        '18_014_398_509_481_985'    => '8LMKKyYqMOg',
        '1_152_921_504_606_846_976' => 'YkZM1Vrj77o0'
    );

    plan tests => scalar( keys %bignums ) * 2 + 1;

    my $hashids = Hashids->new;
    for my $bignum ( keys %bignums ) {
        my $bigint = Math::BigInt->new($bignum);
        is( $hashids->encode( $bigint->bstr ),
            $bignums{$bignum}, "encode bignum $bignum" );
        is( $hashids->decode( $bignums{$bignum} ),
            $bigint, "decode bignum $bignum" );
    }

    subtest 'BigInt bounds' => sub {
        my %big6 = (
            '666_666_666_666'         => 'Lg8j28K8w',
            '6_666_666_666_666'       => 'L2jqVjD3v',
            '66_666_666_666_666'      => 'L7q3Gkq5Mw',
            '666_666_666_666_666'     => 'L982g6zWEQv',
            '6_666_666_666_666_666'   => 'LA4V2Z0BAQw',
            '66_666_666_666_666_666'  => 'LglKVmY922Mv',
            '666_666_666_666_666_666' => 'LVwzmqgWko3w',
        );

        plan tests => scalar( keys %big6 ) * 2;

        for my $bignum ( keys %big6 ) {
            my $bigint = Math::BigInt->new($bignum);
            is( $hashids->encode( $bigint->bstr ),
                $big6{$bignum}, "encode bignum $bignum" );
            is( $hashids->decode( $big6{$bignum} ),
                $bigint, "decode bignum $bignum" );
        }
    };
};