use v5.12.0;
use warnings;
use Data::Dump qw/pp dd/;
use DBI;
use B::Deparse;

my $DBG = 0;


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

my $driver = 'mysql';
my $db     = 'perl_test';
my $host   = '127.0.0.1';
my $port   = '3306';


my $dsn  = "dbi:$driver:database=$db;host=$host;port=$port";
my $user = 'perl_test';
my $pwd  = 'perl_test';

# my $dbh =
#   DBI->connect($dsn, $user, $pwd,
#                        { RaiseError => 1, AutoCommit => 0 });
my $dbh2 =
  DBI::Wrapper->connect($dsn, $user, $pwd,
                       { RaiseError => 1, AutoCommit => 0 });



#warn pp '$dbh: ', $dbh;
warn pp '$dbh2: ', $dbh2;

# my $c_prepare = $dbh->can('prepare');
 # warn pp $c_prepare;


# patch(
#       'DBI::db',
#       'prepare',
#       sub { warn "PATCH"; goto &DBI::prepare }
#      );

my $first= "Rolf";
#my $sth = $dbh->$c_prepare( <<"__SQL__") or die "ERROR prepare";



my $sth = $dbh2->prepare(<<"__SQL__") or die "ERROR prepare";
SELECT *
    FROM users
    WHERE First = '$first'
;
__SQL__

warn pp '$sth: ', $sth;
bless $sth, "DBI::st::Wrapper";



$sth->execute() or die "ERROR execute";


pp  my $href = $sth->fetchall_hashref(['Id']);

#exit();

# my $c_test = sub { "bla" };


# my $deparse = B::Deparse->new();

# warn 'deparse c_prepare :', $deparse->coderef2text($c_prepare);

# my $c_connect = DBI->can("connect");
# warn $deparse->coderef2text($c_connect);




$dbh2->disconnect;


=pod

how to wrap a class and an object

=cut
BEGIN {
    # {
    #     package DBI::Wrapper;

    #     my $DBG = 0;
    #     use Data::Dump qw/pp/;
    #     use Scalar::Util qw(blessed);
        
    #     our $AUTOLOAD;

    #     (my $OrigClass = __PACKAGE__) =~ s/::Wrapper$//;

    #     sub AUTOLOAD {
    #         my $self = shift;           # class or object

    #         my ( $ORIG, $method ) =
    #           split /::Wrapper::/, $AUTOLOAD, 2;
    #         # e.g ("DBI", "connect") <- "DBI::Wrapper::connect"

    #         my $blessed = blessed $self;

    #         # my $DBG = 1;
    #         warn $AUTOLOAD if $DBG;
    #         warn pp '\@_', \@_ if $DBG;
    #         warn pp '[$OrigClass,$self,$method]: ', [$OrigClass,$self,$method] if $DBG;


    #         my @args;

    #         # --- delegate context
    #         unless (defined wantarray) { # VOID
    #             $ORIG->$method(@_);
    #         } elsif (wantarray) {       # LIST
    #             @args    = $ORIG->$method(@_);
    #         } else {                    # SCALAR
    #             $args[0] = $ORIG->$method(@_);
    #         }

    #         warn pp 'wantarray: ', wantarray if $DBG;
    #         warn pp '\@args: ', \@args if $DBG;

    #         return @args[0..$#args];    # handle context
    #     }
    # }
    {
        package DBI::Wrapper;
        use Data::Dump qw/pp/;
        use Scalar::Util qw(blessed);
        our $AUTOLOAD;

        my $DBG = 1;

        my $OrigClass =  my $Class = __PACKAGE__;
        $OrigClass =~ s/::Wrapper$//;

        sub AUTOLOAD {
            my $self = shift;           # class or object
            my ( $ORIG, $method ) =
              split /::Wrapper::/, $AUTOLOAD, 2;

            # my $DBG = 1;
            warn pp '$AUTOLOAD: ', $AUTOLOAD if $DBG;
            warn pp '\@_', \@_ if $DBG;
            warn pp '[$OrigClass,$self,$method]: ', [$OrigClass,$self,$method] if $DBG;

            # --- rebless objects to wrapped class
            my $blessed = blessed $self;
            if ( $blessed ) {           # is object 
                bless $self, $OrigClass;
                warn pp '$blessed: ', $blessed if $DBG
            } else {                    # is class
                $self = $OrigClass;
            }

            # --- call original method in correct context
            my @args;
            # TODO is that right???
            # or better $OrigClass::$method($self,@_) ???
            unless (defined wantarray) { # VOID
                $self->$method(@_);

            } elsif (wantarray) {       # LIST
                @args    = $self->$method(@_);

            } else {                    # SCALAR
                $args[0] = $self->$method(@_);

            }

            # --- restore class of object
            bless $self, $blessed if $blessed;

            warn pp 'wantarray: ', wantarray if $DBG;
            warn pp '\@args: ', \@args if $DBG;

            my @needsWrapping = grep { blessed($_) =~ /^DBI::/ } @args ;
            warn pp '********* \@needsWrapping: ', \@needsWrapping if @needsWrapping;


            return @args[0..$#args];    # handle context
        }

        
    }
    
    {
        package DBI::st::Wrapper;
        use Data::Dump qw/pp/;
        use Scalar::Util qw(blessed);
        our $AUTOLOAD;

        my $DBG = 0;




        my $OrigClass =  my $Class = __PACKAGE__;
        $OrigClass =~ s/::Wrapper$//;

        sub AUTOLOAD {
            my $self = shift;           # class or object
            my ( $ORIG, $method ) =
              split /::Wrapper::/, $AUTOLOAD, 2;

            # my $DBG = 1;
            warn pp '$AUTOLOAD: ', $AUTOLOAD if $DBG;
            warn pp '\@_', \@_ if $DBG;
            warn pp '[$OrigClass,$self,$method]: ', [$OrigClass,$self,$method] if $DBG;

            # --- rebless objects to wrapped class
            my $blessed = blessed $self;
            if ( $blessed ) {           # is object not class?
                bless $self, $OrigClass;
                warn pp '$blessed: ', $blessed if $DBG
            }

            # --- call original method in correct context
            my @args;
            # TODO is that right???
            # or better $OrigClass::$method($self,@_) ???
            unless (defined wantarray) { # VOID
                $self->$method(@_);

            } elsif (wantarray) {       # LIST
                @args    = $self->$method(@_);

            } else {                    # SCALAR
                $args[0] = $self->$method(@_);

            }

            # --- restore class of object
            bless $self, $blessed if $blessed;

            warn pp 'wantarray: ', wantarray if $DBG;
            warn pp '\@args: ', \@args if $DBG;

            my @needsWrapping = grep { blessed $_ =~ /^DBI::/ } @args ;
            warn pp '********* \@needsWrapping: ', \@needsWrapping if @needsWrapping;

            return @args[0..$#args];    # handle context
        }
    }

}


