File Coverage

blib/lib/Variable/Strongly/Typed/Array.pm

Criterion	Covered	Total	%
statement	18	61	29.5
branch	0	8	0.0
condition			n/a
subroutine	6	19	31.5
pod			n/a
total	24	88	27.2

package Variable::Strongly::Typed::Array;

use version; $VERSION = qv('1.0.0');

use warnings;
use strict;
use Carp;

use base qw(Variable::Strongly::Typed);

{
    sub TIEARRAY {
        my($class, $type) = @_;

        my $self = bless \my($anon_scalar), $class;
        $self->_init([], $type);
    }

    ### Bummer have to implement all the array functions...
    sub FETCHSIZE {
        my $arr = shift->_get_object;
        return scalar @{$arr};
    }

    sub STORESIZE {
        my $arr = shift->_get_object;
        $#{$arr} = $_[0]-1;
    }

    sub STORE     {
        my ($self, $index, $value) = @_;
        my $arr = $self->_get_object;

        $self->_check_values($value);
        $arr->[$index] = $value;
    }

    # Note we don't currently check on the way out as
    #   Tie::Constrained does...
    sub FETCH     {
        my $arr = shift->_get_object;
        $arr->[$_[0]];
    }

    sub CLEAR     {
        my $arr = shift->_get_object;
        @{$arr} = ();
    }

    sub POP       {
        my $arr = shift->_get_object;
        pop(@{$arr});
    }

    sub PUSH      {
        my ($self, @values) = @_;
        my $arr = $self->_get_object;

        $self->_check_values(@values);
        push(@$arr, @values);
    }

    sub SHIFT     {
        my $arr = shift->_get_object;
        shift(@{$arr});
    }

    sub UNSHIFT   {
        my ($self, @values) = @_;
        my $arr = $self->_get_object;

        $self->_check_values(@values);
        unshift(@$arr, @values);
    }

    sub EXISTS    {
        my $arr = shift->_get_object;
        exists $arr->[$_[0]];
    }

    sub DELETE    {
        my $arr = shift->_get_object;
        delete $arr->[$_[0]];
    }

    sub SPLICE {
        my ($self) = shift;
        my $arr = $self->_get_object;

        my $sz  = $arr->FETCHSIZE;
        my $off = @_ ? shift : 0;
        $off   += $sz if $off < 0;
        my $len = @_ ? shift : $sz - $off;

        $self->_check_values(@_) if (@_);

        return splice(@$arr, $off, $len, @_);
    }

    sub EXTEND {
        my ($self) = shift;
        $self->STORESIZE(shift);
    }
}

1;

__END__