File Coverage

blib/lib/Hashids.pm

Criterion	Covered	Total	%
statement	118	118	100.0
branch	35	42	83.3
condition	8	9	88.8
subroutine	13	13	100.0
pod	6	7	85.7
total	180	189	95.2

package Hashids;

use Carp 'croak';
use POSIX 'ceil';
use Hashids::Util ':all';
use Moo;
use namespace::clean;

our $VERSION = "1.001011";

has salt => ( is => 'ro', default => '' );

has minHashLength => (
    is  => 'ro',
    isa => sub {
        croak "$_[0] must be a positive number" unless $_[0] =~ /^[0-9]+$/;
    },
    default => 0
);

has alphabet => (
    is  => 'rwp',
    isa => sub {
        local $_ = shift;
        croak "$_ must not have spaces" if /\s/;
        croak "$_ must contain at least 16 characters" if 16 > length;
        my %u;
        croak "$_ must contain unique characters"
            if any { $u{$_}++ } split //;
    },
    default => sub { join '' => 'a' .. 'z', 'A' .. 'Z', 1 .. 9, 0 }
);

has chars => ( is => 'rwp', init_arg => undef, default => sub { [] } );

has seps => (
    is       => 'rwp',
    init_arg => undef,
    default  => sub {
        my @seps = qw(c f h i s t u);
        [ @seps, map {uc} @seps ];
    },
);

has guards => ( is => 'rwp', init_arg => undef, default => sub { [] } );

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

    $class->$orig(@args);
};

sub BUILD {
    my $self = shift;

    croak "salt must be shorter than or of equal length to alphabet"
        if length $self->salt > length $self->alphabet;

    my @alphabet = split // => $self->alphabet;
    my ( @seps, @guards );

    my $sepDiv   = 3.5;
    my $guardDiv = 12;

    # seps should contain only chars present in alphabet;
    # alphabet should not contain seps
    for my $sep ( @{ $self->seps } ) {
        push @seps, $sep if any {/$sep/} @alphabet;
        @alphabet = grep { !/$sep/ } @alphabet;
    }

    @seps = consistent_shuffle( \@seps, $self->salt );

    if ( !@seps || ( @alphabet / @seps ) > $sepDiv ) {
        my $sepsLength = ceil( @alphabet / $sepDiv );
        $sepsLength++ if $sepsLength == 1;
        if ( $sepsLength > @seps ) {
            push @seps => splice @alphabet, 0, $sepsLength - @seps;
        }
    }

    @alphabet = consistent_shuffle( \@alphabet, $self->salt );
    my $guardCount = ceil( @alphabet / $guardDiv );

    @guards
        = @alphabet < 3
        ? splice @seps, 0, $guardCount
        : splice @alphabet, 0, $guardCount;

    $self->_set_chars( \@alphabet );
    $self->_set_seps( \@seps );
    $self->_set_guards( \@guards );
}

sub encode_hex {
    my ( $self, $str ) = @_;

    return '' unless $str =~ /^[0-9a-fA-F]+$/;

    my @num;
    push @num, '1' . substr $str, 0, 11, '' while $str;

    @num = map { bignum(0)->from_hex($_) } @num;

    $self->encode(@num);
}

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

    my @res = $self->decode($hash);

    @res ? join '' => map { substr( bignum($_)->to_hex, 1 ) } @res : '';
}

sub encrypt {
    shift->encode(@_);
}

sub decrypt {
    shift->decode(shift);
}

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

    return '' unless @num;
    map { return '' unless defined and /^[0-9]+$/ } @num;

    my $num = [ map { bignum($_) } @num ];

    my @alphabet = @{ $self->chars };
    my @res;

    my $numHashInt = bignum(0);
    for my $i ( 0 .. $#$num ) {
        $numHashInt += $num->[$i] % ( $i + 100 );
    }

    my $lottery = $res[0] = $alphabet[ $numHashInt % @alphabet ];

    for my $i ( 0 .. $#$num ) {
        my $n = bignum( $num->[$i] );
        my @s = ( $lottery, split( // => $self->salt ), @alphabet )
            [ 0 .. @alphabet ];

        @alphabet = consistent_shuffle( \@alphabet, \@s );
        my $last = to_alphabet( $n, \@alphabet );

        push @res => split // => $last;

        if ( $i + 1 < @$num ) {
            $n %= ord($last) + $i;
            my $sepsIndex = $n % @{ $self->seps };
            push @res, $self->seps->[$sepsIndex];
        }
    }

    if ( @res < $self->minHashLength ) {
        my $guards     = $self->guards;
        my $guardIndex = ( $numHashInt + ord $res[0] ) % @$guards;
        my $guard      = $guards->[$guardIndex];

        unshift @res, $guard;

        if ( @res < $self->minHashLength ) {
            $guardIndex = ( $numHashInt + ord $res[2] ) % @$guards;
            $guard      = $guards->[$guardIndex];

            push @res, $guard;
        }
    }

    my $halfLength = int @alphabet / 2;
    while ( @res < $self->minHashLength ) {
        @alphabet = consistent_shuffle( \@alphabet, \@alphabet );
        @res = (
            @alphabet[ $halfLength .. $#alphabet ],
            @res, @alphabet[ 0 .. $halfLength - 1 ]
        );

        if ( ( my $excess = @res - $self->minHashLength ) > 0 ) {
            @res = splice @res, int $excess / 2, $self->minHashLength;
        }
    }

    join '' => @res;
}

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

    return unless $hash;
    return unless defined wantarray;

    my $res  = [];
    my $orig = $hash;

    my $guard = join '|', map {quotemeta} @{ $self->guards };
    my @hash = grep { $_ ne '' } split /$guard/ => $hash;
    my $i = ( @hash == 3 || @hash == 2 ) ? 1 : 0;

    return unless defined( $hash = $hash[$i] );
    my $lottery = substr $hash, 0, 1;
    $hash = substr $hash, 1;

    my $sep = join '|', @{ $self->seps };
    @hash = grep { $_ ne '' } split /$sep/ => $hash;

    my @alphabet = @{ $self->chars };
    for my $part (@hash) {
        my @s = ( $lottery, split( // => $self->salt ), @alphabet )
            [ 0 .. @alphabet ];

        @alphabet = consistent_shuffle( \@alphabet, \@s );
        push @$res => from_alphabet( $part, \@alphabet );
    }

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

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

1;
__END__