z/OS: CPAN-ized ext/ and lib/

[p5sagit/p5-mst-13.2.git] / lib / Tie / Array.pm

diff --git a/lib/Tie/Array.pm b/lib/Tie/Array.pm
index e3b85d4..af8f51e 100644 (file)
--- a/lib/Tie/Array.pm
+++ b/lib/Tie/Array.pm
@@ -1,9 +1,9 @@
 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.
 
@@ -11,7 +11,6 @@ sub DESTROY { }
 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
@@ -34,57 +33,53 @@ sub POP
  $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;
@@ -124,7 +119,7 @@ Tie::Array - base class for tied arrays
 
 =head1 SYNOPSIS
 
-    package NewArray;
+    package Tie::NewArray;
     use Tie::Array;
     @ISA = ('Tie::Array');
 
@@ -148,7 +143,7 @@ Tie::Array - base class for tied arrays
     sub EXTEND { ... }
     sub DESTROY { ... }
 
-    package NewStdArray;
+    package Tie::NewStdArray;
     use Tie::Array;
 
     @ISA = ('Tie::StdArray');
@@ -183,7 +178,7 @@ For developers wishing to write their own tied arrays, the required methods
 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