File Coverage

lib/Algorithm/SlidingWindow.pm

Criterion	Covered	Total	%
statement	102	102	100.0
branch	44	46	95.6
condition			n/a
subroutine	14	14	100.0
pod	11	11	100.0
total	171	173	98.8

package Algorithm::SlidingWindow;

use strict;
use warnings;

use Carp 'croak';


our $VERSION = '1.002';

sub new {
    my ($class, %args) = @_;

    # --- die if extra arguments ---
    my %allowed = map { $_ => 1 } qw(capacity on_evict);
    for my $k (keys %args) {
        croak "unknown argument '$k'" unless $allowed{$k};
    }

    # --- required arguments ---
    my $capacity = $args{capacity};
    defined $capacity or croak "capacity is required";
    $capacity =~ /\A[0-9]+\z/ or croak "capacity must be a positive integer";
    $capacity > 0 or croak "capacity must be > 0";

    # --- optional arguments ---
    my $on_evict = $args{on_evict};
    if (defined $on_evict) {
        ref($on_evict) eq 'CODE' or croak "on_evict must be a CODE reference";
    }

    # --- initialize backing store ---
    my @buf;
    $#buf = $capacity - 1;   # preallocate fixed storage

    my $self = bless {
        _cap      => 0 + $capacity,
        _buf      => \@buf,
        _head     => 0,
        _size     => 0,
        _on_evict => $on_evict,
    }, $class;

    return $self;
}

sub add {
    my $self = $_[0];

    # Fast path: no items to add
    return $self if @_ == 1;

    my $cap  = $self->{_cap};
    my $buf  = $self->{_buf};
    my $head = $self->{_head};
    my $size = $self->{_size};
    my $cb   = $self->{_on_evict};

    for (my $ai = 1; $ai < @_; $ai++) {
        my $item = $_[$ai];

        if ($size == $cap) {
            my $old = $buf->[$head];
            $cb->($old) if $cb;

            # Drop references immediately
            $buf->[$head] = undef;

            $head++;
            $head = 0 if $head == $cap;
        }
        else {
            $size++;
        }

        my $tail = $head + $size - 1;
        $tail -= $cap if $tail >= $cap;

        $buf->[$tail] = $item;
    }

    $self->{_head} = $head;
    $self->{_size} = $size;

    return $self;
}

sub values {
    my $self = $_[0];

    my $size = $self->{_size};
    return () if $size == 0;

    my $cap  = $self->{_cap};
    my $buf  = $self->{_buf};
    my $i    = $self->{_head};

    my @out;
    $#out = $size - 1;

    for (my $k = 0; $k < $size; $k++) {
        $out[$k] = $buf->[$i];
        $i++;
        $i = 0 if $i == $cap;
    }

    return @out;
}

sub get {
    my $self = $_[0];
    return undef if @_ < 2;

    my $index = $_[1];
    return undef if !defined $index;
    return undef unless $index =~ /\A[0-9]+\z/;
    $index = 0 + $index;

    my $size = $self->{_size};
    return undef if $index >= $size;

    my $cap  = $self->{_cap};
    my $buf  = $self->{_buf};
    my $head = $self->{_head};

    my $i = $head + $index;
    $i -= $cap if $i >= $cap;

    return $buf->[$i];
}

sub clear {
    my $self = $_[0];

    my $size = $self->{_size};
    return $self if $size == 0;

    my $cap  = $self->{_cap};
    my $buf  = $self->{_buf};
    my $i    = $self->{_head};

    for (my $k = 0; $k < $size; $k++) {
        $buf->[$i] = undef;
        $i++;
        $i = 0 if $i == $cap;
    }

    $self->{_head} = 0;
    $self->{_size} = 0;

    return $self;
}

sub capacity { $_[0]->{_cap} }
sub size     { $_[0]->{_size} }
sub is_empty { $_[0]->{_size} == 0 }
sub is_full  { $_[0]->{_size} == $_[0]->{_cap} }

sub oldest {
    my $self = $_[0];
    return undef if $self->{_size} == 0;
    return $self->{_buf}[ $self->{_head} ];
}

sub newest {
    my $self = $_[0];

    my $size = $self->{_size};
    return undef if $size == 0;

    my $cap  = $self->{_cap};
    my $head = $self->{_head};

    my $i = $head + $size - 1;
    $i -= $cap if $i >= $cap;

    return $self->{_buf}[$i];
}

1;

__END__