#!/usr/bin/perl
use warnings;
use strict;

{   package ShortArr;
    use parent 'Tie::Array';
    use Carp;

    my %max_size;
    my $last_index = sub { $max_size{+shift} - 1 };


    sub TIEARRAY {
        my ($class, $max_size) = @_;
        my $self = bless [], $class;
        $max_size{$self} = $max_size;
        return $self
    }

    sub STORE {
        my ($self, $index, $value) = @_;
        if ($index > $self->$last_index) {
            carp 'Array too long';
            return
        }
        $self->[$index] = $value;
    }

    sub FETCH {
        my ($self, $index) = @_;
        $self->[$index]
    }

    sub FETCHSIZE {
        my $self = shift;
        @$self
    }

    sub STORESIZE {
        my ($self, $count) = @_;
        if ($count > $max_size{$self}) {
            carp 'Array too long';
            $count = $max_size{$self};
        }
        $#{$self} = $count - 1;
    }

    sub SPLICE {
        my ($self, $offset, $length, @list) = @_;
        if ($offset > $max_size{$self}) {
            carp 'Array too long';
            return;
        }

        if ($offset + $length > $max_size{$self}) {
            carp 'Array too long';
            $length = $max_size{$self} - $offset;
        }

        my $asked = @$self - $length + @list;
        if ($asked > $max_size{$self}) {
            carp 'Array too long';
            if ($offset == 0) {
                splice @list, 0, $asked - $max_size{$self};
            } else {
                splice @list, $max_size{$self} - $asked;
            }
        }
        $self->SUPER::SPLICE($offset, $length, @list);
    }
}

tie my @arr, 'ShortArr', 3;

use Test::More;

$#arr = 3;
is($#arr, 2, '$#=');

@arr = (1, 2, 3, 4);
is("@arr", '1 2 3', '=()');

shift @arr;
is("@arr", '2 3', 'shift');

push @arr, 5, 6, 7, 8;
is("@arr", '2 3 5', 'push');

pop @arr;
is("@arr", '2 3', 'pop');

unshift @arr, -1, 0, 1;  # From right!
is("@arr", '1 2 3', 'unshift');

splice @arr, 0, 0, 4, 5;
is "@arr", '1 2 3', 'splice 0 0';

splice @arr, 0, 1, 4, 5;
is "@arr", '5 2 3', 'splice 0 1';

splice @arr, 0, 2, 0, 1, 4;
is "@arr", '1 4 3', 'splice 0 2';

splice @arr, 3, 1, 2;
is "@arr", '1 4 3', 'splice offset >';

splice @arr, 2, 0, 2, 3;
is "@arr", '1 4 3', 'splice 2 0';

splice @arr, 2, 1, 2, 5;
is "@arr", '1 4 2', 'splice 2 1';

splice @arr, 2, 2, 5, 6, 3;
is "@arr", '1 4 5', 'splice 2 2';

splice @arr, 1, 0, 3;
is "@arr", '1 4 5', 'splice 1 0';

splice @arr, 1, 0, 2, 3;
is "@arr", '1 4 5', 'splice 1 0 + list';

splice @arr, 1, 1, 2, 3;
is "@arr", '1 2 5', 'splice 1 1';

splice @arr, 1, 2, 3, 4, 6;
is "@arr", '1 3 4', 'splice 1 2';

@arr = (1, 2);
splice @arr, 1, 0, 3;
is "@arr", '1 3 2', 'prolong';

@arr = (1, 2);
splice @arr, 1, 0, 3, 4;
is "@arr", '1 3 2', 'prolong >';

done_testing();
[download]