This more or less does the trick:
package TwoFaced;
use strict;
my $instance_counter = 0;
my $instance_array = [];
sub new {
my $class = shift;
my @array;
tie @array, $class, @_;
return bless \@array, $class;
}
sub method {
print "Method call\n";
return;
}
sub TIEARRAY {
my ( $class, @args ) = @_;
my $self = $instance_counter++;
return bless \$self, $class;
}
sub FETCH {
my ( $self, $i ) = @_;
return $instance_array->[ $$self ]->[$i];
}
sub STORE {
my ( $self, $i, $val ) = @_;
if ( not $val eq 'a' ) {
$instance_array->[ $$self ]->[$i] = $val;
return $self;
}
else {
die "Illegal value: $val\n";
}
}
sub FETCHSIZE {
my ( $self ) = @_;
return scalar @{ $instance_array->[ $$self ] };
}
sub DESTROY {
print "Contents at death:\n";
print "\t", $_, "\n" for @{ $instance_array->[ $$_[0] ] };
}
package main;
my $t = new TwoFaced;
print "it's an array!\n" if UNIVERSAL::isa($t, 'ARRAY'); # prints "it'
+s an array!";
$t->[0] = 'b';
print ${ tied @$t }, $t->[0]; # prints "0b"
print $t->method; # prints "Method call"
$t->[0] = 'a'; # dies "Illegal value: a"
# prints "Contents at death: ..." during object destruction
...except the destructor is called twice. I presume this is for the @array and the tied object respectively? |