Update the FSF's address. Plus some other whitespace and NON-WHITESPACE

[perl5.git] / lib / Tie / Array.pm

diff --git a/lib/Tie/Array.pm b/lib/Tie/Array.pm
index 32e269b..af8f51e 100644 (file)
--- a/lib/Tie/Array.pm
+++ b/lib/Tie/Array.pm
@@ -1,89 +1,85 @@
 package Tie::Array;
 
 package Tie::Array;
 

-use 5.005_64;
+use 5.006_001;

 use strict;
 use Carp;
 use strict;
 use Carp;

-our $VERSION = '1.01';
+our $VERSION = '1.03';

 
 # Pod documentation after __END__ below.
 
 sub DESTROY { }
 
 # Pod documentation after __END__ below.
 
 sub DESTROY { }

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

 sub CLEAR   { shift->STORESIZE(0) }
 
 sub CLEAR   { shift->STORESIZE(0) }
 

-sub PUSH 
-{  
+sub PUSH
+{

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

-sub POP 
+sub POP

 {
  my $obj = shift;
  my $newsize = $obj->FETCHSIZE - 1;
  my $val;
 {
  my $obj = shift;
  my $newsize = $obj->FETCHSIZE - 1;
  my $val;

- if ($newsize >= 0) 
+ if ($newsize >= 0)

   {
    $val = $obj->FETCH($newsize);
    $obj->STORESIZE($newsize);
   }
  $val;
   {
    $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;
- 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];
 
 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];
 }
 
 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;
 }
 
 package Tie::StdArray;


@@ -91,21 +87,21 @@ use vars qw(@ISA);
 @ISA = 'Tie::Array';
 
 sub TIEARRAY  { bless [], $_[0] }
 @ISA = 'Tie::Array';
 
 sub TIEARRAY  { bless [], $_[0] }

-sub FETCHSIZE { scalar @{$_[0]} }             
-sub STORESIZE { $#{$_[0]} = $_[1]-1 }  
+sub FETCHSIZE { scalar @{$_[0]} }
+sub STORESIZE { $#{$_[0]} = $_[1]-1 }

 sub STORE     { $_[0]->[$_[1]] = $_[2] }
 sub FETCH     { $_[0]->[$_[1]] }
 sub CLEAR     { @{$_[0]} = () }
 sub STORE     { $_[0]->[$_[1]] = $_[2] }
 sub FETCH     { $_[0]->[$_[1]] }
 sub CLEAR     { @{$_[0]} = () }

-sub POP       { pop(@{$_[0]}) } 
+sub POP       { pop(@{$_[0]}) }

 sub PUSH      { my $o = shift; push(@$o,@_) }
 sub PUSH      { my $o = shift; push(@$o,@_) }

-sub SHIFT     { shift(@{$_[0]}) } 
-sub UNSHIFT   { my $o = shift; unshift(@$o,@_) } 
+sub SHIFT     { shift(@{$_[0]}) }
+sub UNSHIFT   { my $o = shift; unshift(@$o,@_) }

 sub EXISTS    { exists $_[0]->[$_[1]] }
 sub DELETE    { delete $_[0]->[$_[1]] }
 
 sub SPLICE
 {
 sub EXISTS    { exists $_[0]->[$_[1]] }
 sub DELETE    { delete $_[0]->[$_[1]] }
 
 sub SPLICE
 {

- my $ob  = shift;                    
+ my $ob  = shift;

  my $sz  = $ob->FETCHSIZE;
  my $off = @_ ? shift : 0;
  $off   += $sz if $off < 0;
  my $sz  = $ob->FETCHSIZE;
  my $off = @_ ? shift : 0;
  $off   += $sz if $off < 0;


@@ -121,35 +117,35 @@ __END__
 
 Tie::Array - base class for tied arrays
 
 
 Tie::Array - base class for tied arrays
 

-=head1 SYNOPSIS  
+=head1 SYNOPSIS

 
 

-    package NewArray;
+    package Tie::NewArray;

     use Tie::Array;
     @ISA = ('Tie::Array');
     use Tie::Array;
     @ISA = ('Tie::Array');

-                       
+

     # mandatory methods
     # mandatory methods

-    sub TIEARRAY { ... }  
-    sub FETCH { ... }     
-    sub FETCHSIZE { ... } 
-        
+    sub TIEARRAY { ... }
+    sub FETCH { ... }
+    sub FETCHSIZE { ... }
+

     sub STORE { ... }        # mandatory if elements writeable
     sub STORESIZE { ... }    # mandatory if elements can be added/deleted
     sub EXISTS { ... }       # mandatory if exists() expected to work
     sub DELETE { ... }       # mandatory if delete() expected to work
     sub STORE { ... }        # mandatory if elements writeable
     sub STORESIZE { ... }    # mandatory if elements can be added/deleted
     sub EXISTS { ... }       # mandatory if exists() expected to work
     sub DELETE { ... }       # mandatory if delete() expected to work

-                               
+

     # optional methods - for efficiency
     # optional methods - for efficiency

-    sub CLEAR { ... }  
-    sub PUSH { ... } 
-    sub POP { ... } 
-    sub SHIFT { ... } 
-    sub UNSHIFT { ... } 
-    sub SPLICE { ... } 
-    sub EXTEND { ... } 
+    sub CLEAR { ... }
+    sub PUSH { ... }
+    sub POP { ... }
+    sub SHIFT { ... }
+    sub UNSHIFT { ... }
+    sub SPLICE { ... }
+    sub EXTEND { ... }

     sub DESTROY { ... }
 
     sub DESTROY { ... }
 

-    package NewStdArray;
+    package Tie::NewStdArray;

     use Tie::Array;
     use Tie::Array;

-    
+

     @ISA = ('Tie::StdArray');
 
     # all methods provided by default
     @ISA = ('Tie::StdArray');
 
     # all methods provided by default


@@ -162,7 +158,7 @@ Tie::Array - base class for tied arrays
 
 
 
 
 
 

-=head1 DESCRIPTION       
+=head1 DESCRIPTION

 
 This module provides methods for array-tying classes. See
 L<perltie> for a list of the functions required in order to tie an array
 
 This module provides methods for array-tying classes. See
 L<perltie> for a list of the functions required in order to tie an array


@@ -173,16 +169,16 @@ on the tied array, and implementations of C<PUSH>, C<POP>, C<SHIFT>,
 C<UNSHIFT>, C<SPLICE> and C<CLEAR> in terms of basic C<FETCH>, C<STORE>,
 C<FETCHSIZE>, C<STORESIZE>.
 
 C<UNSHIFT>, C<SPLICE> and C<CLEAR> in terms of basic C<FETCH>, C<STORE>,
 C<FETCHSIZE>, C<STORESIZE>.
 

-The B<Tie::StdArray> package provides efficient methods required for tied arrays 
+The B<Tie::StdArray> package provides efficient methods required for tied arrays

 which are implemented as blessed references to an "inner" perl array.
 which are implemented as blessed references to an "inner" perl array.

-It inherits from B<Tie::Array>, and should cause tied arrays to behave exactly 
-like standard arrays, allowing for selective overloading of methods. 
+It inherits from B<Tie::Array>, and should cause tied arrays to behave exactly
+like standard arrays, allowing for selective overloading of methods.

 
 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:
 
 
 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
 
 
 =item TIEARRAY classname, LIST
 


@@ -190,7 +186,7 @@ The class method is invoked by the command C<tie @array, classname>. Associates
 an array instance with the specified class. C<LIST> would represent
 additional arguments (along the lines of L<AnyDBM_File> and compatriots) needed
 to complete the association. The method should return an object of a class which
 an array instance with the specified class. C<LIST> would represent
 additional arguments (along the lines of L<AnyDBM_File> and compatriots) needed
 to complete the association. The method should return an object of a class which

-provides the methods below. 
+provides the methods below.

 
 =item STORE this, index, value
 
 
 =item STORE this, index, value
 


@@ -214,7 +210,7 @@ Sets the total number of items in the tied array associated with
 object I<this> to be I<count>. If this makes the array larger then
 class's mapping of C<undef> should be returned for new positions.
 If the array becomes smaller then entries beyond count should be
 object I<this> to be I<count>. If this makes the array larger then
 class's mapping of C<undef> should be returned for new positions.
 If the array becomes smaller then entries beyond count should be

-deleted. 
+deleted.

 
 =item EXTEND this, count
 
 
 =item EXTEND this, count
 


@@ -242,7 +238,7 @@ object I<this>.
 
 Normal object destructor method.
 
 
 Normal object destructor method.
 

-=item PUSH this, LIST 
+=item PUSH this, LIST

 
 Append elements of LIST to the array.
 
 
 Append elements of LIST to the array.
 


@@ -255,17 +251,17 @@ Remove last element of the array and return it.
 Remove the first element of the array (shifting other elements down)
 and return it.
 
 Remove the first element of the array (shifting other elements down)
 and return it.
 

-=item UNSHIFT this, LIST 
+=item UNSHIFT this, LIST

 
 Insert LIST elements at the beginning of the array, moving existing elements
 up to make room.
 
 =item SPLICE this, offset, length, LIST
 
 
 Insert LIST elements at the beginning of the array, moving existing elements
 up to make room.
 
 =item SPLICE this, offset, length, LIST
 

-Perform the equivalent of C<splice> on the array. 
+Perform the equivalent of C<splice> on the array.

 
 

-I<offset> is optional and defaults to zero, negative values count back 
-from the end of the array. 
+I<offset> is optional and defaults to zero, negative values count back
+from the end of the array.

 
 I<length> is optional and defaults to rest of the array.
 
 
 I<length> is optional and defaults to rest of the array.
 


@@ -277,16 +273,15 @@ Returns a list of the original I<length> elements at I<offset>.
 
 =head1 CAVEATS
 
 
 =head1 CAVEATS
 

-There is no support at present for tied @ISA. There is a potential conflict 
+There is no support at present for tied @ISA. There is a potential conflict

 between magic entries needed to notice setting of @ISA, and those needed to
 between magic entries needed to notice setting of @ISA, and those needed to

-implement 'tie'.   
+implement 'tie'.

 
 Very little consideration has been given to the behaviour of tied arrays
 when C<$[> is not default value of zero.
 
 
 Very little consideration has been given to the behaviour of tied arrays
 when C<$[> is not default value of zero.
 

-=head1 AUTHOR 
+=head1 AUTHOR

 
 Nick Ing-Simmons E<lt>nik@tiuk.ti.comE<gt>
 
 
 Nick Ing-Simmons E<lt>nik@tiuk.ti.comE<gt>
 

-=cut 
-
+=cut