| Subject: | Enhancements: select* methods, capture parameters, query filter [patch] |
I've put together a few changes to DBIx::Profile that have been useful to me recently and
thought I'd share them.
1. Capture statistics for the high-level $dbh->select* methods.
2. Capture the parameters used for each execution of a query. This is important information if
you want to run the *exact* same query again.
3. Allow a filter to be placed on what results are printed. Useful for cutting out clutter from the
logs when you're only interested in a small subset of all the queries being run.
Patch file attached.
| Subject: | DBIx_Profile.patch |
--- original/DBIx/Profile.pm 2000-08-29 17:41:21.000000000 -0400
+++ jason/DBIx/Profile.pm 2008-03-20 09:41:18.000000000 -0400
@@ -103,6 +103,24 @@
Will save all output to the file.
+ setFilter
+ $dbh->setFilter('interesting_table');
+ $dbh->setFilter(sub {
+ my $query = shift;
+ my $info = shift;
+ $info->{'execute'}->{'normal'}->{'count'} > 100;
+ });
+
+ Will make printProfile print out information only for queries where
+ this filter is true. May be a string to match against (regex syntax
+ is allowed) or a code reference.
+
+ For the code reference, the first parameter will be the query text and
+ the second will be the hashref with all the stored information.
+
+ Alternatively, you may also specify text to match in an environment
+ variable named DBIXPROFILEFILTER.
+
=head1 AUTHORS
Jeff Lathan, lathan@pobox.com
@@ -146,11 +164,16 @@ __PACKAGE__->init_rootclass;
$DBIx::Profile::DBIXFILE = "";
$DBIx::Profile::DBIXFILEHANDLE = "";
$DBIx::Profile::DBIXTRACE = 0;
+$DBIx::Profile::DBIXFILTERSUB = undef;
if ($ENV{DBIXPROFILETRACE}) {
$DBIx::Profile::DBIXTRACE = 1;
}
+if ($ENV{DBIXPROFILEFILTER}) {
+ $DBIx::Profile::DBIXFILTERSUB = sub { $_[0] =~ /$ENV{DBIXPROFILEFILTER}/ };
+}
+
sub connect {
my $self = shift;
my $result = __PACKAGE__->_DBI_connect(@_);
@@ -169,9 +192,72 @@ sub connect {
package DBIx::Profile::db;
use strict;
use vars qw(@ISA );
+use Time::HiRes qw ( gettimeofday tv_interval);
+use Data::Dumper;
@ISA = qw( DBI::db );
+BEGIN {
+
+ # Basic idea for each timing function:
+ # Grab timing info
+ # Call real DBI call
+ # Grab timing info
+ # Calculate time diff
+ #
+ # Just add more functions in @func_list
+
+ my @func_list = qw(selectrow_array selectrow_arrayref selectall_array selectall_arrayref);
+
+ my $func;
+
+ foreach $func (@func_list){
+
+ # define subroutine code, incl dynamic name and SUPER:: call
+ my $sub_code =
+ "sub $func {" . '
+ my $self = shift;
+ my ($query, $blah, @args) = @_;
+ my @result;
+ my $result;
+ my ($time, $ctime, $x, $y, $z);
+ if (wantarray) {
+ $time = [gettimeofday];
+ ($ctime, $x ) = times();
+ @result = $self->SUPER::' . "$func" . '(@_);
+ ($y, $z ) = times();
+ $time = tv_interval($time, [gettimeofday]);
+ }
+ else {
+ $time = [gettimeofday];
+ ($ctime, $x) = times();
+ $result = $self->SUPER::' . "$func" . '(@_);
+ ($y, $z) = times();
+ $time = tv_interval($time, [gettimeofday]);
+ }
+
+ my $private_profile = {};
+ $private_profile->{"Total"}->{"count"}++;
+ $private_profile->{"Total"}->{"realtime"} += $time;
+ $private_profile->{"Total"}->{"cputime"} += (($y + $z) - ($x + $ctime));
+ push @{$private_profile->{"params"}}, \@args if @args;
+
+ $self->{"private_profile"}->{$query}->{$func} = $private_profile;
+
+ return @result if wantarray;
+ return $result;
+
+ } # end of function definition
+ ';
+
+ # define $func in current package
+ eval $sub_code;
+ warn $@ if $@;
+ }
+}
+
+
+
#
# insert our "hooks" to grab subsequent calls
#
@@ -214,6 +300,18 @@ sub setLogFile {
return 1;
}
+sub setFilter {
+ my $self = shift;
+ my $toMatch = shift;
+
+ if (ref($toMatch eq 'CODE')) {
+ $DBIx::Profile::DBIXFILTERSUB = $toMatch;
+ }
+ elsif (ref($toMatch eq 'SCALAR')) {
+ $DBIx::Profile::DBIXFILTERSUB = sub { $_[0] =~ /$toMatch/ };
+ }
+}
+
sub DESTROY {
my $self = shift;
$self->disconnect(@_);
@@ -244,6 +342,11 @@ sub printProfile {
next;
}
+ # If we've defined a filter, skip everything else
+ if ($DBIx::Profile::DBIXFILTERSUB && ref($DBIx::Profile::DBIXFILTERSUB) eq 'CODE') {
+ next unless $DBIx::Profile::DBIXFILTERSUB->($qry, $self->{'private_profile'}->{$qry});
+ }
+
$total = 0;
# Now loop through the actions (execute, fetchrow, etc)
@@ -256,8 +359,16 @@ sub printProfile {
}
$text .= " $name ---------------------------------------\n";
+ my $params = $self->{'private_profile'}->{$qry}->{$name}->{'params'};
+ if ($params and ref $params eq 'ARRAY') {
+ for my $inst_params (@$params) {
+ next unless $inst_params and ref $inst_params eq 'ARRAY' and @$inst_params > 0;
+ $text .= ' Parameters: ' . join(', ', @$inst_params) . "\n";
+ }
+ }
foreach my $type (sort keys %{$self->{'private_profile'}->{$qry}->{$name}}) {
+ next if $type eq 'params';
$text .= " $type\n";
my ($count, $time, $ctime);
@@ -265,6 +376,8 @@ sub printProfile {
$time = $self->{'private_profile'}->{$qry}->{$name}->{$type}->{'realtime'};
$ctime = $self->{'private_profile'}->{$qry}->{$name}->{$type}->{'cputime'};
+
+
$text .= sprintf " Count : %10d\n",$count;
$text .= sprintf " Wall Clock : %10.7f s %10.7f s\n",$time,$time/$count;
$text .= sprintf " Cpu Time : %10.7f s %10.7f s\n",$ctime,$ctime/$count;
@@ -384,7 +497,7 @@ BEGIN {
}
$ctime = ($y + $z) - ($x + $ctime);
- $self->increment($func,$type,$time, $ctime);
+ $self->increment($func,$type,$time, $ctime,\@_);
return @result;
} else {
@@ -413,7 +526,7 @@ BEGIN {
}
$ctime = ($y + $z) - ($x + $ctime);
- $self->increment($func,$type,$time, $ctime);
+ $self->increment($func,$type,$time, $ctime,\@_);
return $result;
} # end of if (wantarray);
@@ -423,6 +536,7 @@ BEGIN {
# define $func in current package
eval $sub_code;
+ warn $@ if $@;
}
}
@@ -439,23 +553,27 @@ sub fetchrow {
}
sub increment {
- my ($self, $name, $type, $time, $ctime) = @_;
+ my ($self, $name, $type, $time, $ctime, $params) = @_;
- my $ref;
my $qry = $self->{'Statement'};
- $ref = $self->{'private_profile'};
+ my $ref = $self->{'private_profile'};
# text matching?!? *sigh* - JEFF
- if ( $name =~ /^execute/ ) {
+ if ( $name =~ /^execute/ || $name=~ /^select/ ) {
$ref->{"first"} = 1;
+ push @{$ref->{$name}->{'params'}}, $params if $params;
+
if ( $DBIx::Profile::DBIXTRACE ) {
my ($sec, $min, $hour, $mday, $mon);
($sec, $min, $hour, $mday, $mon) = localtime(time);
my $text = sprintf("%d-%2d %2d:%2d:%2d", $mon, $mday,$hour,$min,$sec);
+
+ my $to_print = "$$ $text $name SQL: $qry\n";
+ $to_print .= 'Parameters: '. join(', ', @$params) if ref $params eq 'ARRAY';
if ($DBIx::Profile::DBIXFILE eq "" ) {
- warn "$$ text $name SQL: $qry\n";
+ warn $to_print;
} else {
- print $DBIx::Profile::DBIXFILEHANDLE "$$ $text $name SQL: $qry\n";
+ print $DBIx::Profile::DBIXFILEHANDLE $to_print;
}
}
}