#!/usr/bin/perl

use strict;
use warnings;


package Foo;

use Scalar::Util qw/refaddr/;

{
    my %bar;
    
    sub bar { 
        my $id=refaddr shift;
        @_ ? $bar{$id}=shift : $bar{$id};
    }
    
    sub DESTROY { 
        my $obj=shift;
        warn "Deleting $obj\n";
        delete $bar{refaddr $obj};
    }
}

sub new {
    my ($class, $type, $data)=@_;
    my $obj;
    $obj=bless $type eq 'code' ?
      sub { $obj } :
      {} => $class;
    warn "Creating $obj\n";
    $obj->bar($data);
}


package main;

sub test {
    my $type=shift;
    warn "--- Testing <$type> ---\n";
    my $x=Foo->new($type => 'x');
    warn "Leaving context\n";
}

test $_ for qw/code other/;

END { warn "Leaving program\n" }

__END__