### Set up inheritance: ###
use strict;

########################################
package Everything::DBI;
########################################
use vars qw( $VERSION );
BEGIN { $VERSION= 1.000; }
use vars qw( @ISA );
BEGIN { push @ISA, 'DBI'; }

########################################
package Everything::DBI::db;
########################################
use vars qw( @ISA );
BEGIN { push @ISA, 'DBI::db'; }

########################################
package Everything::DBI::st;
########################################
use vars qw( @ISA );
BEGIN { push @ISA, 'DBI::st'; }


### The implementation: ###

########################################
package Everything::DBI::_impl;
########################################


use Time::HiRes qw( gettimeofday );

sub IntervalUS {
    my( $a0, $a1, $b0, $b1 )= @_;
    ( $b0, $b1 )= gettimeofday()   unless  defined($b1);
    return  $b1 - $a1 + ( $b0 - $a0 )*1_000_000;
}


sub TotalUS()    { "us" }
sub OpCount()    { "cnt" }
sub OpDist()     { "dist" }
sub CalledFrom() { "from" }


sub Everything::DBI::connect {
    my $pkg= shift @_;
    my $dbh= $pkg->DBI::connect( @_ );
    return $dbh   if  ! $dbh;

    die "Everything::DBI: ref(DBI::connect(...)) eq '",
        ref($dbh), "' not 'DBI::db' !\n"
        unless  'DBI::db' eq ref($dbh);
    bless $dbh, 'Everything::DBI::db';
    return $dbh;
}


# Wrap the common Everything methods used to query
# so we can track the source of each query:

for my $meth (  qw(
    Everything.pm
    Everything::getNode
    Everything::getNodeById
    Everything::getType
    Everything::selectLinks
    Everything::setVars
    Everything::updateHits
    Everything/HTML.pm
    Everything::HTML::genContainer
    Everything::HTML::htmlcode
    Everything/NodeBase.pm
    Everything::NodeBase::getNode
    Everything::NodeBase::getNodeById
    Everything::NodeBase::getNodeWhere
    Everything::NodeBase::getRef
    Everything::NodeBase::getType
    Everything::NodeBase::selectNodeWhere
    Everything::NodeBase::sqlSelect
    Everything::NodeBase::sqlSelectHashref
    Everything::NodeBase::sqlSelectMany
    Everything::NodeCache::new
)  ) {
    if(  $meth =~ /\.pm$/  ) {
        require $meth;
        next;
    }
    my $orig= \&$meth;
    my $new= sub {
        my $set= setCaller($meth);
        my @ret;
        if(  wantarray  ) {
            @ret= &$orig( @_ );
        } elsif(  ! defined wantarray  ) {
            &$orig( @_ );
        } else {
            $ret[0]= &$orig( @_ );
        }
        clearCaller()   if  $set;
        return  wantarray ? @ret : $ret[0];
    };
    no strict 'refs';
    *{$meth}= $new;
}


BEGIN {

    open LOG, ">db.log"
      or  die "Can't write to db.log: $!\n";

    my $caller= "";
    my %objs;

    sub setCaller {
        return   if  $caller;
        my( $meth )= shift @_;
        my( $pkg, $file, $line )= caller(1);
        my( $sub )= ( caller(2) )[3];
        $sub ||= "n/a";
        $caller= "$sub > $meth\n    line $line of $file";
        return 1;
    }

    sub clearCaller {
        $caller= "";
    }

    sub logQuery {
        my( $sth, $us, $op, $sql, $res )= @_;
        my $stack= "";
        #if(  ! $caller  ) {
        #    my $depth= 3;
        #    while(  my $sub= (caller(++$depth))[3]  ) {
        #        $stack .= " < $sub";
        #    }
        #}
        if(  ! $sth  ||  ! ref($sth)  ) {
            printf LOG "%.3fms %s%s;%s %s:\n\t%s\n",
                $us/1000, $op, $res, $stack, $caller, $sql;
        } elsif(  "DESTROY" eq $op  ) {
            my $obj= delete $objs{0+$sth};
            my $h= $obj->{OpDist()};
            my $ops= "";
            for my $op (  keys %$h  ) {
                $ops .= " $h->{$op}:$op";
            }
            printf LOG "%.3fms %s; %s:\n\t%s\n",
                $obj->{TotalUS()}/1000,$ops, $obj->{CalledFrom()}, $sql;
        } else {
            my $obj= $objs{0+$sth};
            if(  ! $obj  ) {
                $objs{0+$sth}= $obj= {};
                $obj->{CalledFrom()}= $caller.$stack;
            }
            $obj->{TotalUS()} += $us;
            $obj->{OpCount()}++;
            $obj->{OpDist()}{$op}++;
        }
    }
}


### Database methods wrapper: ###

sub prepare
{
    my $meth= shift @_;
    my $dbh= shift @_;
    my( $sql )= @_;
    my @t0= gettimeofday();
    my $spec= "DBI::db::" . $meth;
    my $sth= $dbh->$spec( @_ );
    my $us= IntervalUS( @t0 );
    logQuery( $sth, $us, $meth, $sql );

    return $sth   if  ! $sth  ||  ! ref($sth);
    if(  'Everything::DBI::st' ne ref($sth)  ) {
        die "ref(DBI::db::$meth(...)) eq ", ref($sth), " not DBI::st!"
            unless  'DBI::st' eq ref($sth);
        bless $sth, 'Everything::DBI::st';
    }

    return $sth;
}


for my $meth (  qw(
    prepare
    prepare_cached
    do
    selectall_arrayref
    selectall_hashref
    selectcol_arrayref
    selectrow_array
    selectrow_arrayref
    selectrow_hashref
) ) {
    eval "sub Everything::DBI::db::$meth { prepare( '$meth', \@_ ); }  1"
        or  die "$@\n";
}


### Statement methods wrapper: ###

sub execute
{
    my $meth= shift @_;
    my $sth= shift @_;
    my @t0= gettimeofday();
    my $spec= "DBI::st::" . $meth;
    my $res= $sth->$spec( @_ );
    my $us= IntervalUS( @t0 );
    my( $sql )= $sth->{Statement};
    logQuery( $sth, $us, $meth, $sql, $res );

    return $res;
}


for my $meth (  qw(
    execute
    execute_array
    fetchrow_array
    fetchrow_arrayref
    fetchrow_hashref
    fetchall_arrayref
    fetchall_hashref
    DESTROY
) ) {
    eval "sub Everything::DBI::st::$meth { execute( '$meth', \@_ ); }  1"
        or  die "$@\n";
}


1;