unless (caller()) {
    warn "run directly $0";
    exec "perl t_dbi4.pl";
    die "never executed...";
}


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


package TEST;
use PadWalker qw/closed_over peek_sub set_closed_over/;
use Data::Dump qw/pp/;
use Carp;
our @ref_list;


use overload
  '""' => sub {
      carp 'OL:"": ';#,pp \@_;
      my ($l,$r,$f) = @_;
      push @ref_list, $l;

      #'<"'.$l->{val}.'">';
     $l->{val};
      #'?'
  },
  # #  dereferencing       => '${} @{} %{} &{} *{}',
  '%{}' => sub {
      carp 'OL:%{}: ';#,pp \@_;
#       my ($l,$r,$f) = @_;
#       #push @ref_list, $l;

#       #'<"'.$l->{val}.'">';
# bless { val=>'$val', ref => '$ref' }, __PACKAGE__ ;
      return {key => "DUMMY"};
  },
  ;
;

sub bless_scalar {
   my ($val,$ref) = ($_[0], \$_[0]);
   $_[0] = bless { val=>$val, ref => $ref }, __PACKAGE__;
}

sub unbless_scalar {
   $_ = \"X";
}

package HMP;

sub hmp (&) {
    #die "called";
    my $lambda = shift;
    my $h_vars = closed_over($lambda);
    #warn "CLOSED OVER", pp $h_vars;

    #warn $h_vars->{'$x'};

    #   bless_scalar(${$h_vars->{'$x'}});
    #TEST::bless_scalar(${$h_vars->{'$y'}});

    while ( my ($val,$ref) = each %$h_vars) {
        #my ($val,$ref) = ( ${$h_vars->{'$x'}}, $h_vars->{'$x'});
        warn "patch: ",$val;
        my $obj= (
                  bless {
                         #val=>$val,
                         val => '?',
                         ref => $ref }
                  , "TEST"
              );
        $h_vars->{$val} = \$obj;
    }

    set_closed_over $lambda, $h_vars;

    #warn ${$h_vars->{'$x'}}->{ref};

    #warn pp $h_vars;

    #warn pp "$h_vars->{'$x'}";

    @ref_list = ();
    my $string =  $lambda->();
    my @refs   = @ref_list;
    #$h_vars->{'$x'} = \"X";
    #warn $h_vars->{'$x'};

    return [$string, \@refs];

}




# package main;


# my $x = 'X';
# my $y = 'Y';

# #TEST::bless_scalar($y);
# my @a = ("a".."c");



# my $ret =  TEST::sql {
#     "$x --- $y --- $x"
# };


# #TEST::unbless_scalar($y);

# warn 'RET:',pp $ret;

# warn "$x";
#die "DIED";



