view release on metacpan or  search on metacpan

lib/Algorithm/SlidingWindow.pm  view on Meta::CPAN

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};