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