8 # Michael G Schwern, 11-1999
11 # Copyright (c) 1999,2000 Jeff Lathan, Kerry Clendinning. All rights reserved.
12 # This program is free software; you can redistribute it and/or modify it
13 # under the same terms as Perl itself.
15 # .15 First public release. Bad naming.
16 # .20 Fixed naming problems
17 # .30 Module is now more transparent, thanks to Michael G Schwern
18 # One less "To Do" left!
20 # 1.0 Added ability to trace executes, chosen by an environment variable
21 # Added capability of saving everything to a log file
25 # This package provides an easy way to profile your DBI-based application.
26 # By just "use"ing this module, you will enable counting and measuring
27 # realtime and cpu time for each and every query used in the application.
28 # The times are accumulated by phase: execute vs. fetch, and broken down by
29 # first fetch, subsequent fetch and failed fetch within each of the
30 # fetchrow_array, fetchrow_arrayref, and fetchrow_hashref methods.
31 # More DBI functions will be added in the future.
34 # Add "use DBIx::Profile;" or use "perl -MDBIx::Profile <program>"
35 # Add a call to $dbh->printProfile() before calling disconnect,
36 # or disconnect will dump the information.
39 # Make the printProfile code better
42 ##########################################################################
43 ##########################################################################
47 DBIx::Profile - DBI query profiler
50 Copyright (c) 1999,2000 Jeff Lathan, Kerry Clendinning.
53 This program is free software; you can redistribute it and/or modify it
54 under the same terms as Perl itself.
58 use DBIx::Profile; or "perl -MDBIx::Profile <program>"
64 DBIx::Profile is a quick and easy, and mostly transparent, profiler
65 for scripts using DBI. It collects information on the query
66 level, and keeps track of first, failed, normal, and total amounts
67 (count, wall clock, cput time) for each function on the query.
69 NOTE: DBIx::Profile use Time::HiRes to clock the wall time and
70 the old standby times() to clock the cpu time. The cpu time is
73 DBIx::Profile can also trace the execution of queries. It will print
74 a timestamp and the query that was called. This is optional, and
75 occurs only when the environment variable DBIXPROFILETRACE is set
76 to 1. (ex: (bash) export DBIXPROFILETRACE=1).
78 Not all DBI methods are profiled at this time.
79 Except for replacing the existing "use" and "connect" statements,
80 DBIx::Profile allows DBI functions to be called as usual on handles.
82 Prints information to STDERR, prefaced with the pid.
86 1) Add "use DBIx::Profile" or execute "perl -MDBIx::Profile <program>"
87 2) Optional: add $dbh->printProfile (will execute during
90 4) Data output will happen at printProfile or $dbh->disconnect;
97 Will print out the data collected.
98 If this is not called before disconnect, disconnect will call
102 $dbh->setLogFile("ProfileOutput.txt");
104 Will save all output to the file.
108 Jeff Lathan, lathan@pobox.com
109 Kerry Clendinning, kerry@deja.com
111 Aaron Lee, aaron@pointx.org
112 Michael G Schwern, schwern@pobox.com
121 # For CPAN and Makefile.PL
127 package DBIx::Profile;
129 # Store DBI's original connect & disconnect then replace it with ours.
131 local $^W = 0; # Redefining a subrouting makes noise.
132 *_DBI_connect = DBI->can('connect');
133 *DBI::connect = \&connect;
142 # Make DBI aware of us.
144 __PACKAGE__->init_rootclass;
146 $DBIx::Profile::DBIXFILE = "";
147 $DBIx::Profile::DBIXFILEHANDLE = "";
148 $DBIx::Profile::DBIXTRACE = 0;
150 if ($ENV{DBIXPROFILETRACE}) {
151 $DBIx::Profile::DBIXTRACE = 1;
156 my $result = __PACKAGE__->_DBI_connect(@_);
159 # set flag so we know if we have not printed profile data
160 $result->{'private_profile'}->{'printProfileFlag'} = 0;
166 ##########################################################################
167 ##########################################################################
169 package DBIx::Profile::db;
173 @ISA = qw( DBI::db );
176 # insert our "hooks" to grab subsequent calls
182 my $result = $self->SUPER::prepare(@_);
192 # disconnect from the database; if printProfile has not been called, call it.
197 if ( !$self->{'private_profile'}->{'printProfileFlag'}) {
201 return $self->SUPER::disconnect(@_);
208 $DBIx::Profile::DBIXFILE = $logName;
210 open(OUT,">$logName") || die "Could not open file!";
212 $DBIx::Profile::DBIXFILEHANDLE = \*OUT;
219 $self->disconnect(@_);
223 # Print the data collected.
225 # JEFF - The printing and the print code is kinda (er... very) ugly!
235 # Set that we have printed the results
236 $self->{'private_profile'}->{'printProfileFlag'} = 1;
238 # Loop through the queries
239 foreach my $qry (keys %{$self->{'private_profile'}}) {
243 if ( $qry eq "printProfileFlag" ) {
249 # Now loop through the actions (execute, fetchrow, etc)
250 foreach my $name ( sort keys %{$self->{'private_profile'}->{$qry}}) {
251 # Right now, this assumes that we only have wall clock, cpu
252 # and count. Not generic, but what we want NOW
254 if ( $name eq "first" ) {
258 $text .= " $name ---------------------------------------\n";
260 foreach my $type (sort keys %{$self->{'private_profile'}->{$qry}->{$name}}) {
263 my ($count, $time, $ctime);
264 $count = $self->{'private_profile'}->{$qry}->{$name}->{$type}->{'count'};
265 $time = $self->{'private_profile'}->{$qry}->{$name}->{$type}->{'realtime'};
266 $ctime = $self->{'private_profile'}->{$qry}->{$name}->{$type}->{'cputime'};
268 $text .= sprintf " Count : %10d\n",$count;
269 $text .= sprintf " Wall Clock : %10.7f s %10.7f s\n",$time,$time/$count;
270 $text .= sprintf " Cpu Time : %10.7f s %10.7f s\n",$ctime,$ctime/$count;
272 if ($type eq "Total") {
279 $text = "$$ \"" . $qry . "\" Total wall clock time: ". $total ."s \n" . $text;
280 $text = "=================================================================\n" . $text;
282 # In order to sort based on the total time taken for a query "easily"
283 # we are placing the information in a hash with the total time as the key.
284 # Since we could have many queries with the same total, if this exists,
285 # we cat the query string to the total string and use that as the key.
286 # The sort function will do the right thing.
288 if (exists $result{$total} ) {
292 $result{$total} = $text;
295 foreach my $qry (sort stripsort keys %result) {
296 if ($DBIx::Profile::DBIXFILE eq "" ) {
297 warn $result{$qry} . "\n";
299 print $DBIx::Profile::DBIXFILEHANDLE $result{$qry} . "\n";
306 # Strip off the actual number amount, since the variables may
307 # contain text as well
309 $a =~ m/^(\d+\.\d+)/;
311 $b =~ m/^(\d+\.\d+)/;
314 # Yes, this processes backwards since we want to go decreasing
319 ##########################################################################
320 ##########################################################################
322 package DBIx::Profile::st;
328 # Get some accurancy for wall clock time
329 # Cpu time is still very coarse, but...
331 use Time::HiRes qw ( gettimeofday tv_interval);
333 # Aaron Lee (aaron@pointx.org) provided the majority of
334 # BEGIN block below. It allowed the removal of a lot of duplicate code
335 # and makes the code much much cleaner, and easier to add DBI functionality.
339 # Basic idea for each timing function:
343 # Calculate time diff
345 # Just add more functions in @func_list
347 my @func_list = ('fetchrow_array','fetchrow_arrayref','execute',
352 foreach $func (@func_list){
354 # define subroutine code, incl dynamic name and SUPER:: call
360 my ($time, $ctime, $temp, $x, $y, $z, $type);
364 $time = [gettimeofday];
365 ($ctime, $x ) = times();
367 @result = $self->SUPER::' . "$func" . '(@_);
370 $time = tv_interval ($time, [gettimeofday]);
373 # Checking scalar because we are also interested
374 # in catching empty list
376 if (scalar @result) {
380 $type = "no more rows";
386 $ctime = ($y + $z) - ($x + $ctime);
387 $self->increment($func,$type,$time, $ctime);
392 $time = [gettimeofday];
393 ($ctime, $x ) = times();
395 $result = $self->SUPER::' . "$func" . '(@_);
398 $time = tv_interval ($time, [gettimeofday]);
400 if (defined $result) {
401 if ($result ne "0E0") {
404 $type = "returned 0E0";
409 $type = "no more rows";
415 $ctime = ($y + $z) - ($x + $ctime);
416 $self->increment($func,$type,$time, $ctime);
419 } # end of if (wantarray);
421 } # end of function definition
424 # define $func in current package
432 # fetchrow is just an alias for fetchrow_array, so
435 # Is the return below safe, given the main function above? - JEFF
438 return $self->fetchrow_array(@_);
442 my ($self, $name, $type, $time, $ctime) = @_;
445 my $qry = $self->{'Statement'};
446 $ref = $self->{'private_profile'};
448 # text matching?!? *sigh* - JEFF
449 if ( $name =~ /^execute/ ) {
451 if ( $DBIx::Profile::DBIXTRACE ) {
452 my ($sec, $min, $hour, $mday, $mon);
453 ($sec, $min, $hour, $mday, $mon) = localtime(time);
454 my $text = sprintf("%d-%2d %2d:%2d:%2d", $mon, $mday,$hour,$min,$sec);
455 if ($DBIx::Profile::DBIXFILE eq "" ) {
456 warn "$$ text $name SQL: $qry\n";
458 print $DBIx::Profile::DBIXFILEHANDLE "$$ $text $name SQL: $qry\n";
463 if ( ($name =~ /^fetch/) && ($ref->{'first'} == 1) ) {
468 $ref->{$name}->{$type}->{'count'}++;
469 $ref->{$name}->{$type}->{'realtime'}+= $time;
470 $ref->{$name}->{$type}->{'cputime'}+= $ctime;
472 $ref->{$name}->{"Total"}->{'count'}++;
473 $ref->{$name}->{"Total"}->{'realtime'}+= $time;
474 $ref->{$name}->{"Total"}->{'cputime'}+= $ctime;
478 # initRef is called from Prepare in DBIProfile
480 # Its purpose is to create the DBI's private_profile info
481 # so that we do not lose DBI::errstr in increment() later
485 my $qry = $self->{'Statement'};
487 if (!exists($self->{'private_profile'})) {
488 if (!exists($self->{'Database'}->{'private_profile'}->{$qry})) {
489 $self->{'Database'}->{'private_profile'}->{$qry} = {};
491 $self->{'private_profile'} =
492 $self->{'Database'}->{'private_profile'}->{$qry};