File Coverage

blib/lib/Tie/Scalar/RingBuffer.pm

Criterion	Covered	Total	%
statement	54	59	91.5
branch	21	36	58.3
condition	7	14	50.0
subroutine	11	13	84.6
pod	3	3	100.0
total	96	125	76.8

package Tie::Scalar::RingBuffer;

use 5.008;
use strict;
use warnings;
use Carp qw(croak);
our $VERSION = '0.04';

sub _castbool ($) { $_[0] ? 1 : 0 }

sub TIESCALAR {
    my $class = shift;
    my $list = shift;
    my $opts = shift || +{};

    croak "Tie::Scalar::RingBuffer expects a listref" unless @_ == 0 && ref($list) eq 'ARRAY';
    croak "Tie::Scalar::RingBuffer expects a hashref of options" unless ref($opts) eq 'HASH';

    # validate options
    for (keys %$opts){
        /^(?:start_offset|increment|random)$/ or croak "Unrecognized option '$_'";
    }

    if (exists($opts->{'increment'}) && exists($opts->{'random'})){
        croak "options 'increment' and 'random' are mutually exclusive"
    }

    # set defaults
    my $self =  bless +{ _list    => $list,
                         _ix      => 0,
                         _last_ix => 0,
                         _random  => 0,
                         _debug   => 0,
                         _incr    => 1}, $class;

    # apply options
    if (exists $opts->{'random'}){
        $self->{_random} = _castbool ($opts->{'random'});
        $self->start_offset(int rand @{$self->{_list}});
    }
    $self->start_offset ($opts->{'start_offset'}) if exists $opts->{'start_offset'};
    $self->increment ($opts->{'increment'}) if exists $opts->{'increment'};

    $self
}

sub FETCH
{
    my $self = shift;
    print ("FETCH(ix=",$self->{_ix},")\n") if $self->{_debug};
    my ($list,$ix) = ($self->{_list}, $self->{_ix});
    $self->{_ix} = $self->{_random} ?  (rand @$list)
                                    : ($ix + $self->{_incr}) % @$list;
    $self->{_last_ix} = $ix;
    $list->[$ix];
}

sub redo ()
{
    my $self = shift;
    croak "redo expects an object" unless UNIVERSAL::isa($self, __PACKAGE__);
    $self->{_list}->[$self->{_last_ix}]
}

sub STORE
{
    my $self = shift;
    print("STORE(_last_ix=",$self->{_last_ix},")\n") if $self->{_debug};
    $self->{_list}->[$self->{_last_ix}] = shift;
}

sub UNTIE { }
sub DESTROY { }

sub start_offset {
    my $self = shift;
    croak "start_offset() expects an object" unless UNIVERSAL::isa($self,__PACKAGE__);

    if (@_){
        my $start_offset = shift;
        croak "start_offset() expects a numeric offset" unless defined($start_offset) && $start_offset =~ /^[+-]?\d+$/;
        $self->{_ix} = ($start_offset % scalar @{$self->{_list}});
    }
    $self->{_ix};
}

sub increment {
    my $self = shift;
    croak "increment() expects an object" unless UNIVERSAL::isa($self,__PACKAGE__);
    if(@_){
        my $incr = shift;
        croak "increment() expects an integer" unless defined($incr) && $incr =~ /^[+-]?\d+$/;
        $self->{_incr} = $incr;
    }
    $self->{_incr};
}


1;
__END__