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