{
     use Class BLA => ISA-LIST;

     use Data::Dump qw/pp/;

     my Int ($x,$y) :has :rw  = (10,11);
    
    
     sub set_x {
         my ($var) = @_;
         #warn  "set_x $$x -> $var \n";
         $$x = $var;
     }
    
     sub print_x {
         print "x = $$x \n";
     }

     sub print_self_x {
         print "x = $self->{x} (via \$self)\n";
     }


     sub dump {
         warn '$self:',\$self;
         warn pp '$self: ', $self;
         warn pp '$$x: ', $$x;
         warn pp '$$y: ', $$y;
     }
  
}

##</code><code>##

use strict;
use warnings;
use Data::Dump qw/pp/;







{
    package EOS;
    use Data::Dump qw/pp/;
    use Sub::Util qw/subname/;
    use PadWalker qw/set_closed_over/;
    
    sub new {
        my ($class, $package, $r_self) = @_;
        return bless {package =>$package, r_self => $r_self}, "EOS";
    }

    sub show_subs {
        my $this = shift;
        my $pkg  = $this->{package}; 

        no strict "refs";
        my $stash = \ %{"${pkg}::"};

        my %methods;
        
        while ( my($sym,$glob) = each %$stash) {
            next unless my $code = *{$glob}{CODE};
            #warn "fullname: ",
            my $fullname = join "::", *{$glob}{PACKAGE}, $sym;
            
            #warn "subname: ",
            my $subname = subname($code);

            next unless $subname eq $fullname;            

            #warn $fullname;
            $methods{$fullname} = $code;    
            
        }
        return %methods;
    }

    sub patch_methods {
        my ($this, $a_attributes, $h_methods) = @_;
        
        # warn pp \@_;

        my $var_names =
            join ", ",
                map { keys %$_ }
                    @$a_attributes;

        my $key_names =
            join " ",
                map { s/^\$//r }
                    map { keys %$_ }
                        @$a_attributes;

        my %ref_map =
            map { keys %$_ => map {$_->{ref}} values %$_ }
                @$a_attributes;

        $ref_map{'$self'} = $this->{r_self};
        
        
        # warn pp
        #     '$var_names: ', $var_names,
        #         '$key_names: ', $key_names,
        #             '\%ref_map: ', \%ref_map;


        while ( my ($name,$old_meth) = each %$h_methods) {


            my $patch= <<"__CODE__";
            my (\$self, $var_names); #closure
            sub {
               \$self = shift \@_;
               #warn '\$self:',\\\$self;
               ($var_names) = \\ \@\$self{qw/$key_names/};
               # warn "patch called";
               # warn q/$var_names/, pp [$var_names];
               goto \&\$old_meth;
            };
__CODE__

            #warn $patch;
            my $c_patch = eval($patch) or die $@;

            #warn pp '$c_patch: ', $c_patch;
            set_closed_over($c_patch,\%ref_map);

            #my $fake_self = {x=>30,y=>40};
            #$c_patch->($fake_self);
        
            
            #warn "redefining $name";
            no warnings "redefine";
            no strict "refs";
            *{$name} = $c_patch;
        }
        
        
        #BLA::test({x=>30,y=>40});

        #delete $ref_map{'$self'};
        
        $this->new_constructor(\%ref_map);
        
    }

    sub new_constructor {
        my ($this, $ref_map) = @_;
        #warn "constructor: ", pp \@_;

        my @var_names = grep {!/\$self/ } keys %$ref_map;
        my @init = map { $$_ } @$ref_map{@var_names};
        my @keys = map { s/^\$//r } @var_names;

        my $pkg    = $this->{package};
        #my $r_self = $this->{'$self'};

        # pp '@var_names: ', @var_names;
        # pp '@init: ', @init;
        # pp '@keys: ', @keys;


        my $c_new = sub {
            my $self= {};
            @$self{@keys} = @init;     
            return bless $self, $pkg;
        };

        no strict 'refs';
        *{"${pkg}::new"} = $c_new;
        
    }

    
    
    
    sub DESTROY {
        my $self = shift;
        # warn "DESTROYED",pp $self;
        my %methods = $self->show_subs();
        # warn pp \@BLA::__att__,\%methods;
        $self->patch_methods(\@BLA::__att__,\%methods);
    }
}


{
    package Int; 
    use Data::Dump qw/pp/;
    use PadWalker qw/var_name/;
    
    sub MODIFY_SCALAR_ATTRIBUTES {
        
        #warn pp
        my ( $type, $ref, @att) = @_;
        
        #warn pp 
        my (
            $class
        ) = caller(1);

        #warn 
        my $name = var_name(2, $ref);
        
        no strict 'refs';
            
        push @{"${class}::__att__"},
            {
                $name => {
                    ref => $ref,
                    att => \@att,
                }
            };
        

        return ;
    }
    
}
 

{
     # use Class BLA => ISA-LIST
     # ----start boilerplate
     package BLA;

     our @ISA = qw/ISA-LIST/;
     my $self = {};
     #warn '$self:',\$self;
     
     my $__end_of_scope__ =  EOS->new(__PACKAGE__, \ $self);     
     no warnings 'reserved';            # allow lowercase :attributes

     # --- stop boilerplate
    
     use Data::Dump qw/pp/;
    
     my Int ($x,$y) :has :rw  = (10,11);
    

     sub dump {
         warn '$self:',\$self;
         warn pp '$self: ', $self;
         warn pp '$$x: ', $$x;
         warn pp '$$y: ', $$y;
     }
     
     sub set_x {
         my ($var) = @_;
         #warn  "set_x $$x -> $var \n";
         $$x = $var;
     }
    
     sub print_x {
         print "x = $$x \n";
     }

     sub print_self_x {
         print "x = $self->{x} (via \$self)\n";
     }
        
 }
 
 
 

 
 my $obj = BLA->new();
 
 $obj->print_x();
 $obj->set_x(666);
 $obj->print_x(); 
 $obj->set_x(42);
 $obj->print_self_x;
 
 #$obj->dump();