view release on metacpan or  search on metacpan

lib/Algorithm/Toy/HashSC.pm  view on Meta::CPAN

# -*- Perl -*-
#
# Toy deterministic separate chain hash implementation, based on code in
# "Algorithms (4th Edition)" by Robert Sedgewick and Kevin Wayne. This
# code is not for any sort of use where performance is critical, or
# where malicious input may cause "Algorithmic Complexity Attacks" (see
# perlsec(1)).
#
# run perldoc(1) on this file for additional documentation

package Algorithm::Toy::HashSC;

use 5.010;
use strict;
use warnings;

use Carp qw/croak/;
use Moo;
use namespace::clean;
use Scalar::Util qw/looks_like_number/;

our $VERSION = '0.02';

##############################################################################
#
# ATTRIBUTES

# Each list should end up with ~N/M key-value pairs, assuming the input
# is not malicious, and that the hash function is perfect enough. "M"
# here is the modulus, and "N" is the number of key-value pairs added.
#
# Internally, it's an array of array of arrays, or something like that.
has _chain => (
    is      => 'rw',
    default => sub { [] },
);

has modulus => (
    is      => 'rw',
    default => sub { 7 },
    coerce  => sub {
        die 'modulus must be a positive integer > 1'
          if !defined $_[0]
          or !looks_like_number $_[0]
          or $_[0] < 2;
        return int $_[0];
    },
    trigger => sub {
        my ($self) = @_;
        # clobber extant hash (Moo does not provide old value, so cannot do
        # this only when the modulus changes, oh well)
        $self->_chain( [] ) unless $self->unsafe;
    },
);

# Boolean, disables various sanity checks if set to a true value (in
# particular whether the hash is cleared when the modulus is changed).
has unsafe => (
    is      => 'rw',
    default => sub { 0 },
    coerce  => sub { $_[0] ? 1 : 0 },
);

##############################################################################
#
# METHODS

sub clear_hash {
    my ($self) = @_;
    $self->_chain( [] );
    return $self;
}

sub get {
    my ( $self, $key ) = @_;
    croak "must provide key" if !defined $key;
    my $chain = $self->_chain->[ $self->hash($key) ];
    if ( defined $chain ) {
        for my $kvpair (@$chain) {
            return $kvpair->[1] if $key eq $kvpair->[0];
        }
    }
    return;
}

# Derives the index of the chain a particular key will be added to. The
# hashcode function, if available, should return something that ideally
# evenly distributes the given keys across the given modulus.
#
# Alternative: subclass this module and write yer own hash function.
sub hash {
    my ( $self, $key ) = @_;
    croak "must provide key" if !defined $key;
    my $code = 0;
    if ( $key->can('hashcode') ) {
        $code = $key->hashcode();
    } else {
        # this is pretty terrible...
        for my $n ( map ord, split //, $key ) {
            $code += $n;
        }
    }
    return abs( $code % $self->modulus );
}