package Tie::Array;
-use 5.005_64;
+use 5.006_001;
use strict;
use Carp;
-our $VERSION = '1.01';
+our $VERSION = '1.03';
# Pod documentation after __END__ below.
sub EXTEND { }
sub UNSHIFT { scalar shift->SPLICE(0,0,@_) }
sub SHIFT { shift->SPLICE(0,1) }
-#sub SHIFT { (shift->SPLICE(0,1))[0] }
sub CLEAR { shift->STORESIZE(0) }
sub PUSH
$val;
}
-sub SPLICE
-{
- my $obj = shift;
- my $sz = $obj->FETCHSIZE;
- my $off = (@_) ? shift : 0;
- $off += $sz if ($off < 0);
- my $len = (@_) ? shift : $sz - $off;
- my @result;
- for (my $i = 0; $i < $len; $i++)
- {
- push(@result,$obj->FETCH($off+$i));
- }
- 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);
+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));
}
- }
- 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);
+ $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);
+ }
}
- $obj->STORESIZE($sz-$d);
- }
- for (my $i=0; $i < @_; $i++)
- {
- $obj->STORE($off+$i,$_[$i]);
- }
- return @result;
+ 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);
+ }
+ $obj->STORESIZE($sz-$d);
+ }
+ for (my $i=0; $i < @_; $i++) {
+ $obj->STORE($off+$i,$_[$i]);
+ }
+ return wantarray ? @result : pop @result;
}
sub EXISTS {
my $pkg = ref $_[0];
- croak "$pkg dosn't define an EXISTS method";
+ croak "$pkg doesn't define an EXISTS method";
}
sub DELETE {
my $pkg = ref $_[0];
- croak "$pkg dosn't define a DELETE method";
+ croak "$pkg doesn't define a DELETE method";
}
package Tie::StdArray;
=head1 SYNOPSIS
- package NewArray;
+ package Tie::NewArray;
use Tie::Array;
@ISA = ('Tie::Array');
sub EXTEND { ... }
sub DESTROY { ... }
- package NewStdArray;
+ package Tie::NewStdArray;
use Tie::Array;
@ISA = ('Tie::StdArray');
are briefly defined below. See the L<perltie> section for more detailed
descriptive, as well as example code:
-=over
+=over 4
=item TIEARRAY classname, LIST