source: trunk/essentials/dev-lang/perl/lib/Tie/Array.pm@ 3184

package Tie::Array;

use 5.006_001;
use strict;
use Carp;
our $VERSION = '1.03';

# Pod documentation after __END__ below.

sub DESTROY { }
sub EXTEND  { }
sub UNSHIFT { scalar shift->SPLICE(0,0,@_) }
sub SHIFT { shift->SPLICE(0,1) }
sub CLEAR   { shift->STORESIZE(0) }

sub PUSH
{
 my $obj = shift;
 my $i   = $obj->FETCHSIZE;
 $obj->STORE($i++, shift) while (@_);
}

sub POP
{
 my $obj = shift;
 my $newsize = $obj->FETCHSIZE - 1;
 my $val;
 if ($newsize >= 0)
  {
   $val = $obj->FETCH($newsize);
   $obj->STORESIZE($newsize);
  }
 $val;
}

sub SPLICE {
    my $obj = shift;
    my $sz  = $obj->FETCHSIZE;
    my $off = (@_) ? shift : 0;
    $off += $sz if ($off < 0);
    my $len = (@_) ? shift : $sz - $off;
    $len += $sz - $off if $len < 0;
    my @result;
    for (my $i = 0; $i < $len; $i++) {
        push(@result,$obj->FETCH($off+$i));
    }
    $off = $sz if $off > $sz;
    $len -= $off + $len - $sz if $off + $len > $sz;
    if (@_ > $len) {
        # Move items up to make room
        my $d = @_ - $len;
        my $e = $off+$len;
        $obj->EXTEND($sz+$d);
        for (my $i=$sz-1; $i >= $e; $i--) {
            my $val = $obj->FETCH($i);
            $obj->STORE($i+$d,$val);
        }
    }
    elsif (@_ < $len) {
        # Move items down to close the gap
        my $d = $len - @_;
        my $e = $off+$len;
        for (my $i=$off+$len; $i < $sz; $i++) {
            my $val = $obj->FETCH($i);
            $obj->STORE($i-$d,$val);
        }