summaryrefslogtreecommitdiff
path: root/lib/TUWF/DB.pm
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2017-12-10 09:50:04 +0100
committerYorhel <git@yorhel.nl>2017-12-10 09:50:04 +0100
commitf7db78e4a0fdd5580f6ddc8aadbcdca8abf6d9b6 (patch)
tree6cb2244ea67bc71249c57200a1b7befab3ae94aa /lib/TUWF/DB.pm
parentfe37312dcb60f97be0b17aaa6cdb0db115be7d6a (diff)
Add logging and profiling to tuwf->dbh directly
This changes the format of the 'log_queries' logs a bit, in order to support non-numeric bind parameters. It also changes the structure of the tuwf->{_TUWF}{queries} array, which will break some debugging code in VNDB. The primary goal of this change is to make it easier to use TUWF with other modules on CPAN. The following should now work, without losing the logging & profiling that TUWF::DB offers: use TUWF; use SQL::Yapp dbh => sub { tuwf->dbh }; sub somefunc { my @usernames = sqlFetch{SELECT username FROM users}; };
Diffstat (limited to 'lib/TUWF/DB.pm')
-rw-r--r--lib/TUWF/DB.pm79
1 files changed, 56 insertions, 23 deletions
diff --git a/lib/TUWF/DB.pm b/lib/TUWF/DB.pm
index 0463a2c..d72c527 100644
--- a/lib/TUWF/DB.pm
+++ b/lib/TUWF/DB.pm
@@ -5,6 +5,7 @@ use strict;
use warnings;
use Carp 'croak';
use Exporter 'import';
+use Time::HiRes 'time';
our $VERSION = '1.1';
our @EXPORT = qw|
@@ -32,6 +33,8 @@ sub dbInit {
} else {
croak 'Invalid value for the db_login setting.';
}
+ $sql->{private_tuwf} = 1;
+ inject_logging();
$self->{_TUWF}{DB} = {
sql => $sql,
@@ -49,20 +52,15 @@ sub dbCheck {
my $self = shift;
my $info = $self->{_TUWF}{DB};
- my $start;
- if($self->debug || $self->{_TUWF}{log_slow_pages}) {
- $info->{queries} = [];
- $start = [Time::HiRes::gettimeofday()];
- }
+ my $start = time;
+ $info->{queries} = [];
if(!$info->{sql}->ping) {
warn "Ping failed, reconnecting";
$self->dbInit;
}
$self->dbRollBack;
- push(@{$info->{queries}},
- [ 'ping/rollback', Time::HiRes::tv_interval($start) ])
- if $self->debug || $self->{_TUWF}{log_slow_pages};
+ push(@{$info->{queries}}, [ 'ping/rollback', {}, time-$start ]);
}
@@ -75,7 +73,7 @@ sub dbCommit {
my $self = shift;
my $start = [Time::HiRes::gettimeofday()] if $self->debug || $self->{_TUWF}{log_slow_pages};
$self->{_TUWF}{DB}{sql}->commit();
- push(@{$self->{_TUWF}{DB}{queries}}, [ 'commit', Time::HiRes::tv_interval($start) ])
+ push(@{$self->{_TUWF}{DB}{queries}}, [ 'commit', {}, Time::HiRes::tv_interval($start) ])
if $self->debug || $self->{_TUWF}{log_slow_pages};
}
@@ -123,9 +121,6 @@ sub sqlhelper { # type, query, @list
my $self = shift;
my $type = shift;
my $sqlq = shift;
- my $s = $self->{_TUWF}{DB}{sql};
-
- my $start = [Time::HiRes::gettimeofday()] if $self->debug || $self->{_TUWF}{log_slow_pages} || $self->{_TUWF}{log_queries};
$sqlq =~ s/\r?\n/ /g;
$sqlq =~ s/ +/ /g;
@@ -133,25 +128,16 @@ sub sqlhelper { # type, query, @list
my($q, $r);
my $ret = eval {
- $q = $s->prepare($q[0]);
+ $q = $self->dbh->prepare($q[0]);
$q->execute($#q ? @q[1..$#q] : ());
$r = $type == 1 ? $q->fetchrow_hashref :
$type == 2 ? $q->fetchall_arrayref({}) :
$q->rows;
- $q->finish();
1;
};
- # count and log, if requested
- my $itv = Time::HiRes::tv_interval($start) if $self->debug || $self->{_TUWF}{log_slow_pages} || $self->{_TUWF}{log_queries};
-
- $self->log(sprintf '[%7.2fms] %s | %s', $itv*1000, $q[0], DBI::neat_list([@q[1..$#q]]))
- if $self->{_TUWF}{log_queries};
-
- push(@{$self->{_TUWF}{DB}{queries}}, [ \@q, $itv ]) if $self->debug || $self->{_TUWF}{log_slow_pages};
-
# re-throw the error in the context of the calling code
- croak $s->errstr if !$ret;
+ croak $self->dbh->errstr if !$ret;
$r = 0 if $type == 0 && (!$r || $r == 0);
$r = {} if $type == 1 && (!$r || ref($r) ne 'HASH');
@@ -204,5 +190,52 @@ sub sqlprint { # query, bind values. Returns new query + bind values
}
+# There are generally two approaches to adding logging to DBI: The common and
+# clean approach is to subclass DBD::st and DBD::db (e.g. DBIx::LogAny). But
+# subclassing doesn't stack nicely, and you may need to implement more methods
+# because methods calling each other internally won't be caught.
+#
+# The other approach is to replace the methods of DBD::st and DBD::db directly,
+# as done in DBI::Log. The downside is that it's hacky, unreliable when DBD::*
+# modules come with their own implementation of something, and this approach
+# affects *all* DBI interation and not just those of selected handlers. The
+# latter issue is easily solved by setting a private flag in the DBI object
+# ('private_tuwf' in this case).
+sub inject_logging {
+ require DBI;
+
+ # The measured SQL timing only includes that of the execute() call, but it's
+ # likely that some query processing also happens during fetching.
+ # Unfortunately, I haven't found a reliable way to trigger on "Okay, I'm done
+ # with executing and fetching this statement". The final() method is not
+ # implicitely called, and adding an object destructor wouldn't work with
+ # cached prepared statements.
+ my $orig_execute = \&DBI::st::execute;
+ *DBI::st::execute = sub {
+ my($self) = @_;
+ my $start = time;
+ my $ret = $orig_execute->(@_);
+
+ if($self->{Database}{private_tuwf}) {
+ my $time = time - $start;
+ my %params = %{$self->{ParamValues}};
+
+ $TUWF::OBJ->log(sprintf
+ '[%7.2fms] %s | %s',
+ $time*1000,
+ $self->{Statement},
+ join ', ',
+ map "$_:".DBI::neat($params{$_}),
+ sort { $a =~ /^[0-9]+$/ && $b =~ /^[0-9]+$/ ? $a <=> $b : $a cmp $b }
+ keys %params
+ ) if $TUWF::OBJ->{_TUWF}{log_queries};
+
+ push @{$TUWF::OBJ->{_TUWF}{DB}{queries}}, [ $self->{Statement}, \%params , $time ];
+ }
+
+ return $ret;
+ };
+}
+
1;