summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tie/Array.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tie/Array.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Tie/Array.pm287
1 files changed, 0 insertions, 287 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tie/Array.pm b/Master/tlpkg/tlperl/lib/Tie/Array.pm
deleted file mode 100644
index af8f51e9f51..00000000000
--- a/Master/tlpkg/tlperl/lib/Tie/Array.pm
+++ /dev/null
@@ -1,287 +0,0 @@
-package Tie::Array;
-
-use 5.006_001;
-use strict;
-use Carp;
-our $VERSION = '1.03';
-
-# Pod documentation after __END__ below.
-
-sub DESTROY { }
-sub EXTEND { }
-sub UNSHIFT { scalar shift->SPLICE(0,0,@_) }
-sub SHIFT { shift->SPLICE(0,1) }
-sub CLEAR { shift->STORESIZE(0) }
-
-sub PUSH
-{
- my $obj = shift;
- my $i = $obj->FETCHSIZE;
- $obj->STORE($i++, shift) while (@_);
-}
-
-sub POP
-{
- my $obj = shift;
- my $newsize = $obj->FETCHSIZE - 1;
- my $val;
- if ($newsize >= 0)
- {
- $val = $obj->FETCH($newsize);
- $obj->STORESIZE($newsize);
- }
- $val;
-}
-
-sub SPLICE {
- my $obj = shift;
- my $sz = $obj->FETCHSIZE;
- my $off = (@_) ? shift : 0;
- $off += $sz if ($off < 0);
- my $len = (@_) ? shift : $sz - $off;
- $len += $sz - $off if $len < 0;
- my @result;
- for (my $i = 0; $i < $len; $i++) {
- push(@result,$obj->FETCH($off+$i));
- }
- $off = $sz if $off > $sz;
- $len -= $off + $len - $sz if $off + $len > $sz;
- if (@_ > $len) {
- # Move items up to make room
- my $d = @_ - $len;
- my $e = $off+$len;
- $obj->EXTEND($sz+$d);
- for (my $i=$sz-1; $i >= $e; $i--) {
- my $val = $obj->FETCH($i);
- $obj->STORE($i+$d,$val);
- }
- }
- elsif (@_ < $len) {
- # Move items down to close the gap
- my $d = $len - @_;
- my $e = $off+$len;
- for (my $i=$off+$len; $i < $sz; $i++) {
- my $val = $obj->FETCH($i);
- $obj->STORE($i-$d,$val);
- }
- $obj->STORESIZE($sz-$d);
- }
- for (my $i=0; $i < @_; $i++) {
- $obj->STORE($off+$i,$_[$i]);
- }
- return wantarray ? @result : pop @result;
-}
-
-sub EXISTS {
- my $pkg = ref $_[0];
- croak "$pkg doesn't define an EXISTS method";
-}
-
-sub DELETE {
- my $pkg = ref $_[0];
- croak "$pkg doesn't define a DELETE method";
-}
-
-package Tie::StdArray;
-use vars qw(@ISA);
-@ISA = 'Tie::Array';
-
-sub TIEARRAY { bless [], $_[0] }
-sub FETCHSIZE { scalar @{$_[0]} }
-sub STORESIZE { $#{$_[0]} = $_[1]-1 }
-sub STORE { $_[0]->[$_[1]] = $_[2] }
-sub FETCH { $_[0]->[$_[1]] }
-sub CLEAR { @{$_[0]} = () }
-sub POP { pop(@{$_[0]}) }
-sub PUSH { my $o = shift; push(@$o,@_) }
-sub SHIFT { shift(@{$_[0]}) }
-sub UNSHIFT { my $o = shift; unshift(@$o,@_) }
-sub EXISTS { exists $_[0]->[$_[1]] }
-sub DELETE { delete $_[0]->[$_[1]] }
-
-sub SPLICE
-{
- my $ob = shift;
- my $sz = $ob->FETCHSIZE;
- my $off = @_ ? shift : 0;
- $off += $sz if $off < 0;
- my $len = @_ ? shift : $sz-$off;
- return splice(@$ob,$off,$len,@_);
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-Tie::Array - base class for tied arrays
-
-=head1 SYNOPSIS
-
- package Tie::NewArray;
- use Tie::Array;
- @ISA = ('Tie::Array');
-
- # mandatory methods
- sub TIEARRAY { ... }
- sub FETCH { ... }
- sub FETCHSIZE { ... }
-
- sub STORE { ... } # mandatory if elements writeable
- sub STORESIZE { ... } # mandatory if elements can be added/deleted
- sub EXISTS { ... } # mandatory if exists() expected to work
- sub DELETE { ... } # mandatory if delete() expected to work
-
- # optional methods - for efficiency
- sub CLEAR { ... }
- sub PUSH { ... }
- sub POP { ... }
- sub SHIFT { ... }
- sub UNSHIFT { ... }
- sub SPLICE { ... }
- sub EXTEND { ... }
- sub DESTROY { ... }
-
- package Tie::NewStdArray;
- use Tie::Array;
-
- @ISA = ('Tie::StdArray');
-
- # all methods provided by default
-
- package main;
-
- $object = tie @somearray,Tie::NewArray;
- $object = tie @somearray,Tie::StdArray;
- $object = tie @somearray,Tie::NewStdArray;
-
-
-
-=head1 DESCRIPTION
-
-This module provides methods for array-tying classes. See
-L<perltie> for a list of the functions required in order to tie an array
-to a package. The basic B<Tie::Array> package provides stub C<DESTROY>,
-and C<EXTEND> methods that do nothing, stub C<DELETE> and C<EXISTS>
-methods that croak() if the delete() or exists() builtins are ever called
-on the tied array, and implementations of C<PUSH>, C<POP>, C<SHIFT>,
-C<UNSHIFT>, C<SPLICE> and C<CLEAR> in terms of basic C<FETCH>, C<STORE>,
-C<FETCHSIZE>, C<STORESIZE>.
-
-The B<Tie::StdArray> package provides efficient methods required for tied arrays
-which are implemented as blessed references to an "inner" perl array.
-It inherits from B<Tie::Array>, and should cause tied arrays to behave exactly
-like standard arrays, allowing for selective overloading of methods.
-
-For developers wishing to write their own tied arrays, the required methods
-are briefly defined below. See the L<perltie> section for more detailed
-descriptive, as well as example code:
-
-=over 4
-
-=item TIEARRAY classname, LIST
-
-The class method is invoked by the command C<tie @array, classname>. Associates
-an array instance with the specified class. C<LIST> would represent
-additional arguments (along the lines of L<AnyDBM_File> and compatriots) needed
-to complete the association. The method should return an object of a class which
-provides the methods below.
-
-=item STORE this, index, value
-
-Store datum I<value> into I<index> for the tied array associated with
-object I<this>. If this makes the array larger then
-class's mapping of C<undef> should be returned for new positions.
-
-=item FETCH this, index
-
-Retrieve the datum in I<index> for the tied array associated with
-object I<this>.
-
-=item FETCHSIZE this
-
-Returns the total number of items in the tied array associated with
-object I<this>. (Equivalent to C<scalar(@array)>).
-
-=item STORESIZE this, count
-
-Sets the total number of items in the tied array associated with
-object I<this> to be I<count>. If this makes the array larger then
-class's mapping of C<undef> should be returned for new positions.
-If the array becomes smaller then entries beyond count should be
-deleted.
-
-=item EXTEND this, count
-
-Informative call that array is likely to grow to have I<count> entries.
-Can be used to optimize allocation. This method need do nothing.
-
-=item EXISTS this, key
-
-Verify that the element at index I<key> exists in the tied array I<this>.
-
-The B<Tie::Array> implementation is a stub that simply croaks.
-
-=item DELETE this, key
-
-Delete the element at index I<key> from the tied array I<this>.
-
-The B<Tie::Array> implementation is a stub that simply croaks.
-
-=item CLEAR this
-
-Clear (remove, delete, ...) all values from the tied array associated with
-object I<this>.
-
-=item DESTROY this
-
-Normal object destructor method.
-
-=item PUSH this, LIST
-
-Append elements of LIST to the array.
-
-=item POP this
-
-Remove last element of the array and return it.
-
-=item SHIFT this
-
-Remove the first element of the array (shifting other elements down)
-and return it.
-
-=item UNSHIFT this, LIST
-
-Insert LIST elements at the beginning of the array, moving existing elements
-up to make room.
-
-=item SPLICE this, offset, length, LIST
-
-Perform the equivalent of C<splice> on the array.
-
-I<offset> is optional and defaults to zero, negative values count back
-from the end of the array.
-
-I<length> is optional and defaults to rest of the array.
-
-I<LIST> may be empty.
-
-Returns a list of the original I<length> elements at I<offset>.
-
-=back
-
-=head1 CAVEATS
-
-There is no support at present for tied @ISA. There is a potential conflict
-between magic entries needed to notice setting of @ISA, and those needed to
-implement 'tie'.
-
-Very little consideration has been given to the behaviour of tied arrays
-when C<$[> is not default value of zero.
-
-=head1 AUTHOR
-
-Nick Ing-Simmons E<lt>nik@tiuk.ti.comE<gt>
-
-=cut