Commit | Line | Data |
a60c0954 |
1 | package Tie::Array; |
17f410f9 |
2 | |
3 | use 5.005_64; |
a60c0954 |
4 | use strict; |
01020589 |
5 | use Carp; |
17f410f9 |
6 | our $VERSION = '1.01'; |
ab3c8535 |
7 | |
a60c0954 |
8 | # Pod documentation after __END__ below. |
9 | |
10 | sub DESTROY { } |
22d4bb9c |
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] } |
a60c0954 |
15 | sub CLEAR { shift->STORESIZE(0) } |
16 | |
22d4bb9c |
17 | sub PUSH |
18 | { |
a60c0954 |
19 | my $obj = shift; |
20 | my $i = $obj->FETCHSIZE; |
21 | $obj->STORE($i++, shift) while (@_); |
22 | } |
23 | |
22d4bb9c |
24 | sub POP |
a60c0954 |
25 | { |
26 | my $obj = shift; |
27 | my $newsize = $obj->FETCHSIZE - 1; |
28 | my $val; |
22d4bb9c |
29 | if ($newsize >= 0) |
a60c0954 |
30 | { |
31 | $val = $obj->FETCH($newsize); |
e5724059 |
32 | $obj->STORESIZE($newsize); |
a60c0954 |
33 | } |
34 | $val; |
22d4bb9c |
35 | } |
a60c0954 |
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) |
22d4bb9c |
50 | { |
a60c0954 |
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 | { |
22d4bb9c |
63 | # Move items down to close the gap |
a60c0954 |
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; |
22d4bb9c |
78 | } |
a60c0954 |
79 | |
01020589 |
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 | |
a60c0954 |
90 | package Tie::StdArray; |
91 | use vars qw(@ISA); |
92 | @ISA = 'Tie::Array'; |
93 | |
94 | sub TIEARRAY { bless [], $_[0] } |
22d4bb9c |
95 | sub FETCHSIZE { scalar @{$_[0]} } |
96 | sub STORESIZE { $#{$_[0]} = $_[1]-1 } |
a60c0954 |
97 | sub STORE { $_[0]->[$_[1]] = $_[2] } |
98 | sub FETCH { $_[0]->[$_[1]] } |
99 | sub CLEAR { @{$_[0]} = () } |
22d4bb9c |
100 | sub POP { pop(@{$_[0]}) } |
a60c0954 |
101 | sub PUSH { my $o = shift; push(@$o,@_) } |
22d4bb9c |
102 | sub SHIFT { shift(@{$_[0]}) } |
103 | sub UNSHIFT { my $o = shift; unshift(@$o,@_) } |
01020589 |
104 | sub EXISTS { exists $_[0]->[$_[1]] } |
105 | sub DELETE { delete $_[0]->[$_[1]] } |
a60c0954 |
106 | |
107 | sub SPLICE |
108 | { |
22d4bb9c |
109 | my $ob = shift; |
a60c0954 |
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 | } |
ab3c8535 |
116 | |
117 | 1; |
118 | |
119 | __END__ |
120 | |
121 | =head1 NAME |
122 | |
123 | Tie::Array - base class for tied arrays |
124 | |
22d4bb9c |
125 | =head1 SYNOPSIS |
ab3c8535 |
126 | |
a60c0954 |
127 | package NewArray; |
ab3c8535 |
128 | use Tie::Array; |
a60c0954 |
129 | @ISA = ('Tie::Array'); |
3cb6de81 |
130 | |
a60c0954 |
131 | # mandatory methods |
22d4bb9c |
132 | sub TIEARRAY { ... } |
133 | sub FETCH { ... } |
134 | sub FETCHSIZE { ... } |
3cb6de81 |
135 | |
a60c0954 |
136 | sub STORE { ... } # mandatory if elements writeable |
137 | sub STORESIZE { ... } # mandatory if elements can be added/deleted |
01020589 |
138 | sub EXISTS { ... } # mandatory if exists() expected to work |
139 | sub DELETE { ... } # mandatory if delete() expected to work |
3cb6de81 |
140 | |
a60c0954 |
141 | # optional methods - for efficiency |
22d4bb9c |
142 | sub CLEAR { ... } |
143 | sub PUSH { ... } |
144 | sub POP { ... } |
145 | sub SHIFT { ... } |
146 | sub UNSHIFT { ... } |
147 | sub SPLICE { ... } |
148 | sub EXTEND { ... } |
a60c0954 |
149 | sub DESTROY { ... } |
150 | |
151 | package NewStdArray; |
152 | use Tie::Array; |
3cb6de81 |
153 | |
a60c0954 |
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 | |
ab3c8535 |
165 | |
22d4bb9c |
166 | =head1 DESCRIPTION |
ab3c8535 |
167 | |
a60c0954 |
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 |
01020589 |
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>, |
a60c0954 |
175 | C<FETCHSIZE>, C<STORESIZE>. |
176 | |
22d4bb9c |
177 | The B<Tie::StdArray> package provides efficient methods required for tied arrays |
a60c0954 |
178 | which are implemented as blessed references to an "inner" perl array. |
22d4bb9c |
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. |
a60c0954 |
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 | |
22d4bb9c |
186 | =over |
a60c0954 |
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 |
22d4bb9c |
194 | provides the methods below. |
a60c0954 |
195 | |
196 | =item STORE this, index, value |
197 | |
8dcee03e |
198 | Store datum I<value> into I<index> for the tied array associated with |
a60c0954 |
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 | |
8dcee03e |
204 | Retrieve the datum in I<index> for the tied array associated with |
a60c0954 |
205 | object I<this>. |
206 | |
207 | =item FETCHSIZE this |
208 | |
8dcee03e |
209 | Returns the total number of items in the tied array associated with |
a60c0954 |
210 | object I<this>. (Equivalent to C<scalar(@array)>). |
ab3c8535 |
211 | |
a60c0954 |
212 | =item STORESIZE this, count |
213 | |
8dcee03e |
214 | Sets the total number of items in the tied array associated with |
a60c0954 |
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 |
22d4bb9c |
218 | deleted. |
a60c0954 |
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 | |
01020589 |
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 | |
a60c0954 |
237 | =item CLEAR this |
238 | |
8dcee03e |
239 | Clear (remove, delete, ...) all values from the tied array associated with |
a60c0954 |
240 | object I<this>. |
241 | |
242 | =item DESTROY this |
243 | |
244 | Normal object destructor method. |
245 | |
22d4bb9c |
246 | =item PUSH this, LIST |
a60c0954 |
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 | |
22d4bb9c |
259 | =item UNSHIFT this, LIST |
a60c0954 |
260 | |
8dcee03e |
261 | Insert LIST elements at the beginning of the array, moving existing elements |
a60c0954 |
262 | up to make room. |
263 | |
264 | =item SPLICE this, offset, length, LIST |
265 | |
22d4bb9c |
266 | Perform the equivalent of C<splice> on the array. |
a60c0954 |
267 | |
22d4bb9c |
268 | I<offset> is optional and defaults to zero, negative values count back |
269 | from the end of the array. |
a60c0954 |
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 |
ab3c8535 |
278 | |
279 | =head1 CAVEATS |
280 | |
22d4bb9c |
281 | There is no support at present for tied @ISA. There is a potential conflict |
ab3c8535 |
282 | between magic entries needed to notice setting of @ISA, and those needed to |
22d4bb9c |
283 | implement 'tie'. |
a60c0954 |
284 | |
285 | Very little consideration has been given to the behaviour of tied arrays |
286 | when C<$[> is not default value of zero. |
287 | |
22d4bb9c |
288 | =head1 AUTHOR |
a60c0954 |
289 | |
290 | Nick Ing-Simmons E<lt>nik@tiuk.ti.comE<gt> |
ab3c8535 |
291 | |
22d4bb9c |
292 | =cut |