package calltest::tied; use 5.010000; use strict; use warnings; use Data::Dumper; use Scalar::Util qw( weaken ); require Exporter; our @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. # This allows declaration use calltest ':all'; # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK # will save memory. our %EXPORT_TAGS = ( 'all' => [ qw( ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( ); our $VERSION = '0.01'; sub hello2 { print "h2\n"; } # Preloaded methods go here. sub TIESCALAR { my $class = shift; my $self = {'calltestObj' => shift}; weaken($self->{'calltestObj'}); return bless($self, $class); } sub FETCH { my $self = shift; print Dumper([[caller()],[caller(0)],[caller(1)]]); if((caller())[0] ne "calltest") { print "FETCH: bad caller \"".(caller())[0]."\" returning undef\n"; return undef } else { print "FETCH: good caller \"".(caller())[0]."\" returning 5\n"; } my $newvalue = 5; my $newSelf = {'calltestObj' => $self->{'calltestObj'}}; untie($newSelf->{'calltestObj'}->{'value'}); $newSelf->{'calltestObj'}->{'value'} = $newvalue; return $newvalue; } sub STORE { my $self = shift; my $newSelf = {'calltestObj' => $self->{'calltestObj'}}; untie($newSelf->{'calltestObj'}->{'value'}); $newSelf->{'calltestObj'}->{'value'} = $_[0]; return $_[0]; } sub UNTIE { my $self = shift; } 1; __END__