File Coverage

blib/lib/Array/Circular.pm

Criterion	Covered	Total	%
statement	67	75	89.3
branch	23	30	76.6
condition	2	3	66.6
subroutine	15	18	83.3
pod	12	12	100.0
total	119	138	86.2

use strict;
use warnings;
package Array::Circular;
# ABSTRACT: Provide an array data structure that can go around in circles

use Carp;
use Scalar::Util qw/refaddr/;

my %DATA;

sub new {
    my ($class, @self) = @_;
    my $self = bless \@self, $class;
    $self->me( { current => 0, count => 0 } );
    return $self;
}

sub me {
    my ($self, $args) = @_;
    my $loc = refaddr $self;
    $DATA{$loc} = $args if $args;
    return $DATA{$loc};
}

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

*curr = \¤t;

sub index {
    my ($self, $idx) = @_;
    $self->me->{current} = $idx if defined $idx;
    return $self->me->{current};
}

sub loops {
    my ($self, $new_ct) = @_;
    $self->me->{count} = $new_ct if defined $new_ct;
    return $self->me->{count};
}

sub next {
    my ($self, $num) = @_;
    return unless @$self;
    return $self->current if defined $num && $num == 0; # undefined just goes next.  zero gives current.
    if ($num) {
	croak "Calls to next with a count of how many to go forward must be a positive number" if $num < 0;
	$num--;
	$self->next for 1 .. $num; # This is inefficient but simple.  Could use $self->me to compute where we are as optimisation
    }


    my $last_index = $#{$self};
    if ( $self->me->{current} == $last_index ) {
	$self->me->{current} = -1;
	$self->me->{count}++;
    }
    return $self->[ ++ $self->me->{current} ];
}

sub previous {
    my ($self, $num) = @_;
    return unless @$self;

    if ($num) {
	croak "Calls to next with a count of how many to go forward must be a positive number" if $num < 0;
	$num--;
	$self->previous for 1 .. $num; # This is inefficient but simple.  Could use $self->me to compute where we are as optimisation
    }

    if ( $self->me->{current} == 0 ) {
	$self->me->{current} = scalar(@$self);
	$self->me->{count}--;

    }
    return $self->[ -- $self->me->{current} ];
}

*prev = \&previous;

sub reset {
    my ($self) = @_;
    $self->me->{current} = 0;
    $self->me->{count} = 0;
    return $self->current;
}

sub _current_and_action {
    my ($self, $action) = @_;
    my $c = $self->current;
    $self->$action;
    return $c
}

sub current_and_next {
    my ($self) = @_;
    return $self->_current_and_action('next');
}

*curr_and_next = \¤t_and_next;

sub current_and_previous {
    my ($self) = @_;
    return $self->_current_and_action('previous');
}

*curr_and_prev = \&curr_and_prev;

sub peek {
    my ($self, $count) = @_;
    return $self->current if $count == 0;
    my $meth = $count > 0 ? 'next': 'prev';
    my $undo = $count > 0 ? 'prev': 'next';
    $count = abs $count;
    my $val = $self->$meth($count);
    $self->$undo($count);
    return $val;
}

sub size {
    my ($self ) = @_;
    return scalar @$self;
}



sub DESTROY {
    my $self = shift;
    delete $DATA{refaddr $self};
}

1;

__END__