File Coverage

blib/lib/Tie/IxHash/FixedSize.pm

Criterion	Covered	Total	%
statement	26	26	100.0
branch	4	6	66.6
condition	1	2	50.0
subroutine	7	7	100.0
pod			n/a
total	38	41	92.6

#
# This file is part of Tie-IxHash-FixedSize
#
# This software is copyright (c) 2018 by Michael Schout.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#

package Tie::IxHash::FixedSize;
$Tie::IxHash::FixedSize::VERSION = '1.02';
# ABSTRACT: Tie::IxHash with a fixed maximum size

use 5.008;
use strict;
use warnings;
use parent 'Tie::IxHash';

# location of size field in @$self. Tie::IxHash uses 0-3
use constant SIZE_IX => 4;

sub TIEHASH {
    my $class = shift;
    my $conf = shift if ref $_[0] eq 'HASH';

    $conf ||= {};

    my $self = $class->SUPER::TIEHASH(@_);

    if ($conf->{size}) {
        $self->[SIZE_IX] = $conf->{size};
    }

    return $self;
}

sub STORE {
    my $self = shift;

    $self->SUPER::STORE(@_);

    if (my $max_size = $self->[SIZE_IX]) {
        while ($self->Keys > $max_size) {
            $self->Shift;
        }
    }
}

1;

__END__