package Hashids;

our $VERSION = "0.08";

use Carp;
use Moo;

has salt => ( is => 'ro', default => '' );
has minHashLength => (
    is  => 'ro',
    isa => sub {
        croak "$_[0] is not a number!" unless $_[0] =~ /^\d+$/;
    },
    default => 0
);
has alphabet => (
    is  => 'ro',
    isa => sub {
        croak "$_[0] must not have spaces"
            if $_[0] =~ /\s/;
        croak "$_[0] must contain at least 4 characters"
            unless length $_[0] >= 4;
        my %u;
        croak "$_[0] must contain unique characters"
            if grep { $u{$_}++ } split // => $_[0];
    },
    default => 'xcS4F6h89aUbideAI7tkynuopqrXCgTE5GBKHLMjfRsz'
);

has chars  => ( is => 'rwp', lazy => 1, init_arg => undef );
has seps   => ( is => 'rwp', lazy => 1, init_arg => undef );
has guards => ( is => 'rwp', lazy => 1, init_arg => undef );

sub BUILDARGS {
    my ( $class, @args ) = @_;
    unshift @args, 'salt' if @args % 2 == 1;

    +{@args};
}

sub BUILD {
    my $self = shift;

    my $alphabet = $self->alphabet;
    my @alphabet = split //, $alphabet;
    my $seps     = [];
    my $guards   = [];

    my @primes = ( 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43 );
    my @indices = ( 0, 4, 8, 12 );

    for my $prime (@primes) {
        if ( my $ch = $alphabet[ $prime - 1 ] ) {
            push @$seps, $ch;
            $alphabet =~ s/$ch//g;
        }
    }
    for my $index (@indices) {
        if ( my $sep = $seps->[$index] ) {
            push @$guards, $sep;
            splice @$seps, $index, 1;
        }
    }

    $self->_set_guards($guards);
    $self->_set_seps($seps);
    $self->_set_chars( $self->_consistentShuffle( $alphabet, $self->salt ) );
}

sub encrypt {
    my ( $self, @num ) = @_;

    return '' unless @num;
    map { return '' unless /^\d+$/ } @num;

    $self->_encode( \@num );
}

sub decrypt {
    my ( $self, $hash ) = @_;
    return unless $hash;
    $self->_decode($hash);
}

sub _encode {
    my ( $self, $num, $chars, $salt, $minHashLength ) = @_;

    $chars         ||= $self->chars;
    $salt          ||= $self->salt;
    $minHashLength ||= $self->minHashLength;

    my $res = '';
    my @seps = split //, $self->_consistentShuffle( $self->seps, $num );
    my $lotteryChar = '';

    for ( my $i = 0; $i != @$num; $i++ ) {
        my $number = $num->[$i];

        unless ($i) {
            my $lotterySalt = join '-', @$num;
            for ( my $j = 0; $j != @$num; $j++ ) {
                $lotterySalt .= '-' . ( $num->[$j] + 1 ) * 2;
            }

            ( $lotteryChar, undef ) = split //,
                $self->_consistentShuffle( $chars, $lotterySalt ), 2;
            $res .= $lotteryChar;

            $chars =~ s/$lotteryChar//g;
            $chars = $lotteryChar . $chars;
        }

        $chars = $self->_consistentShuffle( $chars,
            ( ord($lotteryChar) & 12345 ) . $salt );
        $res .= $self->_hash( $number, $chars );

        if ( ( $i + 1 ) < @$num ) {
            my $index = ( $number + $i ) % @seps;
            $res .= $seps[$index];
        }
    }

    if ( length($res) < $minHashLength ) {
        my $firstIndex = 0;
        for ( my $i = 0; $i != @$num; $i++ ) {
            $firstIndex += ( $i + 1 ) * $num->[$i];
        }

        my $guards     = $self->guards;
        my $guardIndex = $firstIndex % @$guards;
        my $guard      = $guards->[$guardIndex];

        $res = $guard . $res;
        if ( length($res) < $minHashLength ) {
            $guardIndex = ( $guardIndex + length($res) ) % @$guards;
            $guard      = $guards->[$guardIndex];

            $res .= $guard;
        }
    }

    while ( length($res) < $minHashLength ) {
        my @pad = map {ord} reverse split // => $chars, 2;
        my $padLeft  = $self->_encode( \@pad, $chars, $salt );
        my $padRight = $self->_encode( \@pad, $chars, "@pad" );

        $res = $padLeft . $res . $padRight;
        my $excess = length($res) - $minHashLength;

        if ( $excess > 0 ) {
            $res = substr( $res, $excess / 2, $minHashLength );
        }

        $chars = $self->_consistentShuffle( $chars, $salt . $res );
    }

    $res;
}

sub _decode {
    my ( $self, $hash ) = @_;

    return unless $hash;
    return unless defined wantarray;

    my $res = [];

    my $orig        = $hash;
    my $lotteryChar = '';
    my $splitIndex  = 0;

    my $chars  = $self->chars;
    my $guards = $self->guards;
    my $seps   = $self->seps;

    for my $guard (@$guards) {
        $hash =~ s/$guard/ /g;
    }
    my @hashSplit = split / /, $hash;
    if ( @hashSplit == 3 or @hashSplit == 2 ) {
        $splitIndex = 1;
    }
    $hash = $hashSplit[$splitIndex];
    for my $sep (@$seps) {
        $hash =~ s/$sep/ /g;
    }

    my @subHash = split / /, $hash;
    for ( my $i = 0; $i != @subHash; $i++ ) {
        if ( my $subHash = $subHash[$i] ) {
            unless ($i) {
                $lotteryChar = substr( $hash, 0, 1 );
                $subHash = substr( $subHash, 1 );
                $chars =~ s/$lotteryChar//;
                $chars = $lotteryChar . $chars;
            }

            if ( $chars and $lotteryChar ) {
                $chars = $self->_consistentShuffle( $chars,
                    ( ord($lotteryChar) & 12345 ) . $self->salt );
                push @$res, $self->_unhash( $subHash, $chars );
            }
        }
    }

    return unless $self->Hashids::encrypt(@$res) eq $orig;

    wantarray ? @$res : @$res == 1 ? $res->[0] : $res;
}

sub _consistentShuffle {
    my ( $self, $alphabet, $salt ) = @_;

    my $res = '';

    return $res unless $alphabet;

    if ( ref $alphabet eq 'ARRAY' ) {
        $alphabet = join '', @$alphabet;
    }
    if ( ref $salt eq 'ARRAY' ) {
        $salt = join '', @$salt;
    }

    my @alphabet = split //, $alphabet;
    my @salt     = split //, $salt;
    my @sort;

    push @salt, '' unless @salt;
    push @sort, ( ord || 0 ) for @salt;

    for ( my $i = 0; $i != @sort; $i++ ) {
        my $add = 1;
        for ( my $j = $i; $j != @sort + $i - 1; $j++ ) {
            my $next = ( $j + 1 ) % @sort;
            ($add)
                ? ( $sort[$i] += $sort[$next] + ( $j * $i ) )
                : ( $sort[$i] -= $sort[$next] );
            $add = !$add;
        }
        $sort[$i] = abs $sort[$i];
    }

    my $k = 0;
    while (@alphabet) {
        my $pos = $sort[$k];
        $pos %= @alphabet if $pos >= @alphabet;
        $res .= $alphabet[$pos];
        splice @alphabet, $pos, 1;

        $k = ++$k % @sort;
    }

    $res;
}

sub _hash {
    my ( $self, $num, $alphabet ) = @_;

    my $hash = '';
    my @alphabet = split //, $alphabet;

    do {
        $hash = $alphabet[ $num % @alphabet ] . $hash;
        $num  = int( $num / @alphabet );
    } while ($num);

    $hash;
}

sub _unhash {
    my ( $self, $hash, $alphabet ) = @_;

    my $num = 0;
    my $pos;

    my @hash = split //, $hash;
    for ( my $i = 0; $i < @hash; $i++ ) {
        $pos = index $alphabet, $hash[$i];
        $num += $pos * ( length($alphabet)**( @hash - $i - 1 ) );
    }

    $num;
}

1;
__END__

=encoding utf-8

=head1 NAME

Hashids - generate short hashes from numbers

=head1 SYNOPSIS

    use Hashids;
    my $hashids = Hashids->new('this is my salt');

    # encrypt a single number
    my $hash = $hashids->encrypt(123);          # 'a79'
    my $number = $hashids->decrypt('a79');      # 123

    # or a list
    $hash = $hashids->encrypt(1, 2, 3);         # 'eGtrS8'
    my @numbers = $hashids->decrypt('eGtrS8');  # (1, 2, 3)

    # also get results in an arrayref
    my $numbers = $hashids->decrypt('eGtrS8');  # [1, 2, 3]

=head1 DESCRIPTION

This is a port of the Hashids JavaScript library for Perl.

Hashids was designed for use in URL shortening, tracking stuff,
validating accounts or making pages private (through abstraction.)
Instead of showing items as C<1>, C<2>, or C<3>, you could show them as
C<b9iLXiAa>, C<EATedTBy>, and C<Aaco9cy5>.  Hashes depend on your salt
value.

This implementation follows the v0.1.4 release of hashids.js.  The
current version of hashids.js (v0.3.0) uses a new algorithm, so the
hashes produced by this Perl implementation will probably I<not> decrypt
correctly on the new JavaScript version.  I will be implementing the new
algorithm very soon, and maybe probably allow some way to toggle between
algorithms.

=head1 METHODS

=over

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

Make a new Hashids object.  This constructor accepts a few options:

=over

=item  salt => 'this is my salt'

Salt string, this should be unique per Hashid object.

=item  alphabet => 'abcdefghij'

Alphabet set to use.  This is optional as Hashids comes with a default
set suitable for URL shortening.

=item  minHashLength => 5

Minimum hash length.  Use this to control how long the generated hash
string should be.

=back

You can also construct with just a single argument for the salt:

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

=item  my $hash = $hashids->encrypt($x, [$y, $z, ...]);

Encrypt a single number (or a list of numbers) into a hash string.

=item  my $number = $hashids->decrypt($hash);

Decrypt a hash string into its number (or numbers.)  Returns either a
simple scalar if it is a single number, an arrayref of numbers if it
decrypted a set, or C<undef> if given bad input.  Use L<ref> on the
result to ensure proper usage.

You can also retrieve the result as a proper list by assigning it to an
array variable, by doing so you will always get a list of one or more
numbers that are decrypted from the hash, or the empty list if none were
found:

    my @numbers = $hashids->decrypt($hash);

=back

=head1 SEE ALSO

L<Hashids|http://www.hashids.org>

=head1 LICENSE

Copyright (C) Zak B. Elep.

Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the
"Software"), to deal in the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish,
distribute, sublicense, and/or sell copies of the Software, and to
permit persons to whom the Software is furnished to do so, subject to
the following conditions:

The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

=head1 AUTHOR

Zak B. Elep E<lt>zakame@cpan.orgE<gt>

Original Hashids JavaScript library written by L<Ivan
Akimov|http://twitter.com/ivanakimov>

=head1 THANKS

Props to L<Jofell Gallardo|http://twitter.com/jofell> for pointing this
excellent project to me in the first place.

=cut
