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