use v5.12.0;
use warnings;
use Data::Dump qw/pp dd/;
use DBI;
use Test::More;
use Scalar::Util qw/blessed/;


#use HoldMyPlace qw/hmp/;
sub hmp (&);                  # dummy

my $dbh = connect_DB();


my $first= "Rolf";


# --------- The Bad

my $sth_bad = $dbh->prepare(<<"__SQL__");
SELECT *
    FROM USERS
    WHERE First = '$first'
__SQL__

$sth_bad->execute();

my $data_bad= $sth_bad->fetchall_hashref('Id');



# --------- The Good

my $sth_good = $dbh->prepare(<< '__SQL__' ); # no interpolation
SELECT *
    FROM USERS
    WHERE First = ?
__SQL__

$sth_good->execute($first);

my $data_good= $sth_good->fetchall_hashref('Id');

is_deeply ($data_good,$data_bad);

# --------- The Beautiful

if (1) {

    my $sth_best = $dbh->prepare( hmp { << "__SQL__" } );
    SELECT *
        FROM  USERS
        WHERE First = $first
__SQL__

    # warn pp '$sth_best->{Callbacks}: ', $sth_best->{Callbacks};
    # warn pp '$dbh->{Callbacks}{ChildCallbacks}: ', $dbh->{Callbacks}{ChildCallbacks};

    warn "************ \$sth_best->{Statement}: '$sth_best->{Statement}'", pp $sth_best->{Statement};


    $sth_best->execute();               ## NO BIND 

    warn pp my $data_best = $sth_best->fetchall_hashref('Id');
    is_deeply ($data_good,$data_best);
}




done_testing;






$dbh->disconnect;

exit;



sub hmp (&) {
    my $sql_good = <<'__SQL__';
SELECT *
    FROM USERS
    WHERE First = ?
    OR Last = ?
__SQL__

    my $first = "Rolf";

    my $hmp =
      {
       Statement  => $sql_good,
       bind_vars  => [\$first],
       bind_names => ["first"],
      };

    bless $hmp , 'HMP';

    #my $hmp = bless \$sql_good, "HMP";
    #$hmp = $sql_good;                   # <<< HACK
    #warn "******** \$hmp: '$hmp'", pp $hmp;

    return $hmp;
}







sub connect_DB {
    my ($driver, $db, $host ,$port);

    my $server = 'sqlite';

    my $user = 'perl_test';
    my $pwd  = 'perl_test';
    
    # my %connect = (
    # 	mysql => {
    # 	    db     => 'perl_test',
    # 	    host   => '127.0.0.1',
    # 	    port   => '3306',
    # 	},
    # 	sqlite => {
    # 	    db   => SQLite:dbname=$dbfile,
    # 	    host => "",
    # 	    port => ""
    # 	}
    # 	);

    pp my @driver_names = DBI->available_drivers;
    pp my %drivers      = DBI->installed_drivers;

    #my $dsn  = "dbi:$driver:database=$db;host=$host;port=$port";

    my $dbfile	  = "perl_test";
    my $dsn	  = "dbi:SQLite:dbname=$dbfile";
    $user	  = "";
    $pwd	  = "";

    my $Callbacks = callbacks();

    my $dbh =
      DBI->connect($dsn, $user, $pwd,
                   {
                    RaiseError => 1,
                    AutoCommit => 0,
                    Callbacks  => callbacks(),
                   });
    init_db_tables($dbh);
    return $dbh;
}


sub init_db_tables {
    my $dbh = shift;

    
    my $_table_  = "USERS";
    my @fields   = qw/Id First Last/;

    my @data     =
	(
	 [ 1, qw/Rolf LanX/ ],
	 [ 2, qw/Riba Sushi/ ],
	 [ 3, qw/Tony Stark/ ],
	);
    
    $dbh->do("DROP TABLE IF EXISTS $_table_;"); 

    my $_fields_ = join ", ", @fields;
    $dbh->do("CREATE TABLE $_table_ ( $_fields_ );");
    #--- populate test data
    my $sth = $dbh->prepare("INSERT INTO $_table_ VALUES (?,?,?);");
    
    for my $row (@data) {
	$sth->execute(@$row);
    }

    # dd "tmp_check",
    #	my $table_a = $dbh->selectall_arrayref("SELECT * FROM $_table_");

    
}


# --- https://metacpan.org/pod/DBI#Callbacks
sub callbacks {
    my $DBG = 0;

    my $prepare_hook = sub
      
      {
          #my $DBG = 1;

          my ( $obj, $query ) = \(@_) ;
          my $meth      = $_;

          return unless blessed $$query;
          warn "CB \U$meth: ",pp \@_ if $DBG ;

          my $statement = $$query->{Statement};
#          tie $statement ,"HMP_TIE";

          # if (blessed $$query eq "HMP") {
          #     $$query = $statement;
          #     #$$obj->{private_HMP} = ["dummy"]; #$$query;
          #     $$obj->{Callbacks}{ChildCallbacks}{private_HMP} = $$query; 
          # }

          return;                       # OK
      };

    my $execute_hook = sub
      {
          my $DBG = 0;

          my $handle  = $_[0]  ;
          #my @args    = @_;
          my $meth    = $_;

          my $hmp = $handle->{Statement};

          warn "CB \U$meth: ",pp [\@_]
            if $DBG;

          return
            unless (blessed($handle->{Statement}) //"") eq "HMP";
          #unless exists $handle->{Callbacks}{private_HMP};




          warn pp $hmp;

          #$handle->{Statement} = $hmp->{Statement};
          #@_ = @{ $hmp->{bind_vars} };

          # by value
          $handle->bind_param(1, ${ $hmp->{bind_vars}[0] } );
          $handle->bind_param(2, ${ $hmp->{bind_vars}[1] } );

          # bidirectional for stored procedures
          #$handle->bind_param_inout(1, $hmp->{bind_vars}[0],10000 );
          # not implemented in mysql
          
          #$_[1] = "Rolf";               # HACK


          #warn "CB \U$meth: ",pp [\@_]
          #  if $DBG;

          return;                       # OK
      }
;

    my $generic_hook = sub
      {
          my $DBG = 1;

          my ($obj, $query) = \( @_ ) ;
          my $meth          = $_;

          warn "CB \U$meth: ",pp \@_
            if $DBG;

          return;                       # OK
      };

    my $Callbacks =
      {
       prepare => $prepare_hook,
       ChildCallbacks =>
       {
        execute => $execute_hook,
       }
      }
    ;

    return $Callbacks;
}

BEGIN {
package HMP;


use overload
  '""' => sub {
      my $stmt = shift->{Statement};
      #warn "********* OVERLOAD: '$stmt'";
      return $stmt;
  };
}


# ========= tie experiment
package HMP_TIE;
require Tie::Scalar;

our @ISA = qw(Tie::StdScalar);

