package Tracer;

sub new {
  my $class = shift || __PACKAGE__;
  my $self = { };
  bless $self, $class;
}

sub STORE {
  print STDERR "\n\x23 ", (caller(1))[3], "\n";
  my $self = shift;
  my $key  = shift;
  my $val  = shift;
  $self->{$key} = $val;
}

sub FETCH {
  print STDERR "\n\x23 ", (caller(1))[3], "\n";
  my $self = shift;
  my $key  = shift;
  $self->{$key};
}

1;

package Creator;

use strict;
use warnings;

sub create {
  my $caller = (caller(0))[0]; # $caller =~ s/::(((?!::).)+)$//;
  my $field = shift;
  no strict 'refs';
  *{$caller."::".$field} = sub {
    my $self = shift;
    if (@_) {
      return $self->STORE($field,@_);
    } else {
      return $self->FETCH($field);
    }
  };
}

1;

package TracedCreatee;

our @ISA = qw( Tracer );


Creator::create("foo");


1;

package main;

use strict;
use warnings;

my $obj = TracedCreatee->new();

$obj->foo(1);