Skip Menu |
 
rt.cpan.org will be shut down on March 1st, 2021.

This queue is for tickets about the DBIx-Profile CPAN distribution.

Report information
The Basics
Id: 34286
Status: new
Priority: 0/
Queue: DBIx-Profile

People
Owner: Nobody in particular
Requestors: jasonporritt [...] gmail.com
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: (no value)
Fixed in: (no value)



Subject: Enhancements: select* methods, capture parameters, query filter [patch]
Download (untitled) / with headers
text/plain 527b
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
Download DBIx_Profile.patch
text/x-diff 7.1k
--- 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; } } }


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.