File Coverage

blib/lib/Tie/Array/Cavity.pm

Criterion	Covered	Total	%
statement	54	105	51.4
branch	0	26	0.0
condition	0	6	0.0
subroutine	18	36	50.0
pod	6	6	100.0
total	78	179	43.5

package Tie::Array::Cavity;

use 5.006;
use strict;
use warnings;
use Tie::Array;

our $VERSION = '0.02';


sub TIEARRAY
{
    my ( $class ) = @_;
    bless {
        _step => $_[1] || 1,
        _base => $_[2] || 0,
        _data => [],
    }, $class;
}


sub STORE
{
    use integer;
    my $i = ( $_[1] - $_[0]->{ _base } ) / $_[0]->{ _step };
    $i = 0 if ( $i < 0 );
    no integer;
    $_[0]->{ _data }->[$i] = $_[2];
}



sub STORESIZE
{
    $#{ $_[0] } = $_[1] - 1;
}


sub FETCHSIZE
{
    scalar @{ $_[0]->{ _data } };
}


sub FETCHCAVITY
{
    use integer;
    my $i = ( $_[1] - $_[0]->{ _base } ) / $_[0]->{ _step };
    $i = 0 if ( $i < 0 );
    no integer;
    $_[0]->{ _data }->[$i];
}



sub FETCHKEY
{
    use integer;
    my $i = ( $_[1] - $_[0]->{ _base } ) / $_[0]->{ _step };
    $i = 0 if ( $i < 0 );
    no integer;
    ( $i * $_[0]->{ _step } ) + $_[0]->{ _base };
}


sub FETCHKEYCAVITY
{
    use integer;
    my $i = ( ($_[1] || 0 ) * $_[0]->{ _step } ) + $_[0]->{ _base };
    $i = 0 if ( $i < 0 );
    no integer;
    $i;
}


sub FETCH
{
    $_[0]->{ _data }->[ $_[1] ];
}



sub POP
{
    pop @{ $_[0]->{ _data } };
}


sub SHIFT
{
    shift @{ $_[0]->{ _data } };
}



sub PUSH
{
    push @{ $_[0]->{ _data } }, $_[1];
}




sub UNSHIFT
{
    unshift @{ $_[0]->{ _data } }, $_[1];
}


sub EXISTSCAVITY
{
    use integer;
    my $i = ( $_[1] - $_[0]->{ _base } ) / $_[0]->{ _step };
    $i = 0 if ( $i < 0 );
    no integer;
    exists $_[0]->{ _data }->[$i];
}


sub EXISTS
{
    exists $_[0]->{ _data }->[$_[1]];
}


sub DELETECAVITY
{
    use integer;
    my $i = ( $_[1] - $_[0]->{ _base } ) / $_[0]->{ _step };
    $i = 0 if ( $i < 0 );
    no integer;
    delete $_[0]->{ _data }->[$i];
}


sub DELETE
{
    delete $_[0]->{ _data }->[$_[1]];
}



sub SPLICECAVITY
{
    my $self = shift;
    my $offset = @_ ? shift : 0;
    my $s = $self->{ _step };
    my $b = $self->{ _base };
    use integer;
    my $off = ( $offset - $b ) / $s;
    $off = 0 if ( $off < 0 );
    my $sz = $self->FETCHSIZE;
    $off += $sz if $off < 0;
    my $len = @_ ? shift : $sz - $off;
    no integer;
    return splice( $self->{ _data }, $off, $len, @_ );

}


sub SPLICE
{
    my $self = shift;
    my $offset = @_ ? shift : 0;
    my $sz = $self->FETCHSIZE;
    $offset += $sz if $offset < 0;
    my $len = @_ ? shift : $sz - $offset;
    return splice( $self->{ _data }, $offset, $len, @_ );
}



1;    # End of Tie::Array::Cavity

__END__