File Coverage

blib/lib/Type/Tie/Aggregate/Array.pm

Criterion	Covered	Total	%
statement	21	21	100.0
branch	2	2	100.0
condition			n/a
subroutine	8	9	88.8
pod			n/a
total	31	32	96.8

# ABSTRACT: class to tie arrays for Type::Tie::Aggregate

######################################################################
# Copyright (C) 2021 Asher Gordon                 #
#                                                                    #
# This program is free software: you can redistribute it and/or      #
# modify it under the terms of the GNU General Public License as     #
# published by the Free Software Foundation, either version 3 of     #
# the License, or (at your option) any later version.                #
#                                                                    #
# This program is distributed in the hope that it will be useful,    #
# but WITHOUT ANY WARRANTY; without even the implied warranty of     #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU   #
# General Public License for more details.                           #
#                                                                    #
# You should have received a copy of the GNU General Public License  #
# along with this program. If not, see                               #
# .                                    #
######################################################################

package Type::Tie::Aggregate::Array;
$Type::Tie::Aggregate::Array::VERSION = '0.001';
#pod =head1 DESCRIPTION
#pod
#pod This class is used to tie arrays. This class is internal to
#pod L.
#pod
#pod =cut

use v5.6.0;
use strict;
use warnings;
use namespace::autoclean;
use parent 'Type::Tie::Aggregate::Base';

sub _create_ref { shift; \@_ }

sub _check_value {
    my (undef, $value) = @_;
    return 'Not an ARRAY reference' unless ref $value eq 'ARRAY';
    return;
}

sub TIEARRAY { my $class = shift; $class->_new(@_) }

__PACKAGE__->_install_methods(
    { mutates => 1 },
    STORESIZE	=> '$#$ref = $_[0] - 1',
    STORE	=> '$ref->[$_[0]] = $_[1]',
    CLEAR	=> '@$ref = ()',
    POP		=> 'pop @$ref',
    PUSH	=> 'push @$ref, @_',
    SHIFT	=> 'shift @$ref',
    UNSHIFT	=> 'unshift @$ref, @_',
    SPLICE	=> '&CORE::splice($ref, @_)',
    DELETE	=> 'delete $ref->[$_[1]]',
);

__PACKAGE__->_install_methods(
    { mutates => 0 },
    FETCHSIZE	=> '@$ref',
    FETCH	=> '$ref->[$_[0]]',
    EXISTS	=> 'exists $ref->[$_[0]]',
    EXTEND	=> sub {},
);

#pod =head1 SEE ALSO
#pod
#pod =for :list
#pod * L
#pod
#pod =cut

1;

__END__