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