contrib/perl5/lib/Tie/Array.pm

   1 package Tie::Array;
   2 use vars qw($VERSION);
   3 use strict;
   4 $VERSION = '1.00';
   5
   6 # Pod documentation after __END__ below.
   7
   8 sub DESTROY { }
   9 sub EXTEND  { }
  10 sub UNSHIFT { shift->SPLICE(0,0,@_) }
  11 sub SHIFT   { shift->SPLICE(0,1) }
  12 sub CLEAR   { shift->STORESIZE(0) }
  13
  14 sub PUSH
  15 {
  16  my $obj = shift;
  17  my $i   = $obj->FETCHSIZE;
  18  $obj->STORE($i++, shift) while (@_);
  19 }
  20
  21 sub POP
  22 {
  23  my $obj = shift;
  24  my $newsize = $obj->FETCHSIZE - 1;
  25  my $val;
  26  if ($newsize >= 0)
  27   {
  28    $val = $obj->FETCH($newsize);
  29    $obj->STORESIZE($newsize);
  30   }
  31  $val;
  32 }
  33
  34 sub SPLICE
  35 {
  36  my $obj = shift;
  37  my $sz  = $obj->FETCHSIZE;
  38  my $off = (@_) ? shift : 0;
  39  $off += $sz if ($off < 0);
  40  my $len = (@_) ? shift : $sz - $off;
  41  my @result;
  42  for (my $i = 0; $i < $len; $i++)
  43   {
  44    push(@result,$obj->FETCH($off+$i));
  45   }
  46  if (@_ > $len)
  47   {
  48    # Move items up to make room
  49    my $d = @_ - $len;
  50    my $e = $off+$len;
  51    $obj->EXTEND($sz+$d);
  52    for (my $i=$sz-1; $i >= $e; $i--)
  53     {
  54      my $val = $obj->FETCH($i);
  55      $obj->STORE($i+$d,$val);
  56     }
  57   }
  58  elsif (@_ < $len)
  59   {
  60    # Move items down to close the gap
  61    my $d = $len - @_;
  62    my $e = $off+$len;
  63    for (my $i=$off+$len; $i < $sz; $i++)
  64     {
  65      my $val = $obj->FETCH($i);
  66      $obj->STORE($i-$d,$val);
  67     }
  68    $obj->STORESIZE($sz-$d);
  69   }
  70  for (my $i=0; $i < @_; $i++)
  71   {
  72    $obj->STORE($off+$i,$_[$i]);
  73   }
  74  return @result;
  75 }
  76
  77 package Tie::StdArray;
  78 use vars qw(@ISA);
  79 @ISA = 'Tie::Array';
  80
  81 sub TIEARRAY  { bless [], $_[0] }
  82 sub FETCHSIZE { scalar @{$_[0]} }
  83 sub STORESIZE { $#{$_[0]} = $_[1]-1 }
  84 sub STORE     { $_[0]->[$_[1]] = $_[2] }
  85 sub FETCH     { $_[0]->[$_[1]] }
  86 sub CLEAR     { @{$_[0]} = () }
  87 sub POP       { pop(@{$_[0]}) }
  88 sub PUSH      { my $o = shift; push(@$o,@_) }
  89 sub SHIFT     { shift(@{$_[0]}) }
  90 sub UNSHIFT   { my $o = shift; unshift(@$o,@_) }
  91
  92 sub SPLICE
  93 {
  94  my $ob  = shift;
  95  my $sz  = $ob->FETCHSIZE;
  96  my $off = @_ ? shift : 0;
  97  $off   += $sz if $off < 0;
  98  my $len = @_ ? shift : $sz-$off;
  99  return splice(@$ob,$off,$len,@_);
 100 }
 101
 102 1;
 103
 104 __END__
 105
 106 =head1 NAME
 107
 108 Tie::Array - base class for tied arrays
 109
 110 =head1 SYNOPSIS
 111
 112     package NewArray;
 113     use Tie::Array;
 114     @ISA = ('Tie::Array');
 115
 116     # mandatory methods
 117     sub TIEARRAY { ... }
 118     sub FETCH { ... }
 119     sub FETCHSIZE { ... }
 120
 121     sub STORE { ... }        # mandatory if elements writeable
 122     sub STORESIZE { ... }    # mandatory if elements can be added/deleted
 123
 124     # optional methods - for efficiency
 125     sub CLEAR { ... }
 126     sub PUSH { ... }
 127     sub POP { ... }
 128     sub SHIFT { ... }
 129     sub UNSHIFT { ... }
 130     sub SPLICE { ... }
 131     sub EXTEND { ... }
 132     sub DESTROY { ... }
 133
 134     package NewStdArray;
 135     use Tie::Array;
 136
 137     @ISA = ('Tie::StdArray');
 138
 139     # all methods provided by default
 140
 141     package main;
 142
 143     $object = tie @somearray,Tie::NewArray;
 144     $object = tie @somearray,Tie::StdArray;
 145     $object = tie @somearray,Tie::NewStdArray;
 146
 147
 148
 149 =head1 DESCRIPTION
 150
 151 This module provides methods for array-tying classes. See
 152 L<perltie> for a list of the functions required in order to tie an array
 153 to a package. The basic B<Tie::Array> package provides stub C<DELETE>
 154 and C<EXTEND> methods, and implementations of C<PUSH>, C<POP>, C<SHIFT>,
 155 C<UNSHIFT>, C<SPLICE> and C<CLEAR> in terms of basic C<FETCH>, C<STORE>,
 156 C<FETCHSIZE>, C<STORESIZE>.
 157
 158 The B<Tie::StdArray> package provides efficient methods required for tied arrays
 159 which are implemented as blessed references to an "inner" perl array.
 160 It inherits from B<Tie::Array>, and should cause tied arrays to behave exactly
 161 like standard arrays, allowing for selective overloading of methods.
 162
 163 For developers wishing to write their own tied arrays, the required methods
 164 are briefly defined below. See the L<perltie> section for more detailed
 165 descriptive, as well as example code:
 166
 167 =over
 168
 169 =item TIEARRAY classname, LIST
 170
 171 The class method is invoked by the command C<tie @array, classname>. Associates
 172 an array instance with the specified class. C<LIST> would represent
 173 additional arguments (along the lines of L<AnyDBM_File> and compatriots) needed
 174 to complete the association. The method should return an object of a class which
 175 provides the methods below.
 176
 177 =item STORE this, index, value
 178
 179 Store datum I<value> into I<index> for the tied array associated with
 180 object I<this>. If this makes the array larger then
 181 class's mapping of C<undef> should be returned for new positions.
 182
 183 =item FETCH this, index
 184
 185 Retrieve the datum in I<index> for the tied array associated with
 186 object I<this>.
 187
 188 =item FETCHSIZE this
 189
 190 Returns the total number of items in the tied array associated with
 191 object I<this>. (Equivalent to C<scalar(@array)>).
 192
 193 =item STORESIZE this, count
 194
 195 Sets the total number of items in the tied array associated with
 196 object I<this> to be I<count>. If this makes the array larger then
 197 class's mapping of C<undef> should be returned for new positions.
 198 If the array becomes smaller then entries beyond count should be
 199 deleted.
 200
 201 =item EXTEND this, count
 202
 203 Informative call that array is likely to grow to have I<count> entries.
 204 Can be used to optimize allocation. This method need do nothing.
 205
 206 =item CLEAR this
 207
 208 Clear (remove, delete, ...) all values from the tied array associated with
 209 object I<this>.
 210
 211 =item DESTROY this
 212
 213 Normal object destructor method.
 214
 215 =item PUSH this, LIST
 216
 217 Append elements of LIST to the array.
 218
 219 =item POP this
 220
 221 Remove last element of the array and return it.
 222
 223 =item SHIFT this
 224
 225 Remove the first element of the array (shifting other elements down)
 226 and return it.
 227
 228 =item UNSHIFT this, LIST
 229
 230 Insert LIST elements at the beginning of the array, moving existing elements
 231 up to make room.
 232
 233 =item SPLICE this, offset, length, LIST
 234
 235 Perform the equivalent of C<splice> on the array.
 236
 237 I<offset> is optional and defaults to zero, negative values count back
 238 from the end of the array.
 239
 240 I<length> is optional and defaults to rest of the array.
 241
 242 I<LIST> may be empty.
 243
 244 Returns a list of the original I<length> elements at I<offset>.
 245
 246 =back
 247
 248 =head1 CAVEATS
 249
 250 There is no support at present for tied @ISA. There is a potential conflict
 251 between magic entries needed to notice setting of @ISA, and those needed to
 252 implement 'tie'.
 253
 254 Very little consideration has been given to the behaviour of tied arrays
 255 when C<$[> is not default value of zero.
 256
 257 =head1 AUTHOR
 258
 259 Nick Ing-Simmons E<lt>nik@tiuk.ti.comE<gt>
 260
 261 =cut
 262