[Catalyst-commits] r6178 - in trunk: . Catalyst-Plugin-DBI-Profile Catalyst-Plugin-DBI-Profile/lib Catalyst-Plugin-DBI-Profile/lib/Catalyst Catalyst-Plugin-DBI-Profile/lib/Catalyst/Plugin Catalyst-Plugin-DBI-Profile/lib/Catalyst/Plugin/DBI

[andyg at dev.catalyst.perl.org]

Author: andyg
Date: 2007-03-20 19:51:18 +0000 (Tue, 20 Mar 2007)
New Revision: 6178

Added:
   trunk/Catalyst-Plugin-DBI-Profile/
   trunk/Catalyst-Plugin-DBI-Profile/lib/
   trunk/Catalyst-Plugin-DBI-Profile/lib/Catalyst/
   trunk/Catalyst-Plugin-DBI-Profile/lib/Catalyst/Plugin/
   trunk/Catalyst-Plugin-DBI-Profile/lib/Catalyst/Plugin/DBI/
   trunk/Catalyst-Plugin-DBI-Profile/lib/Catalyst/Plugin/DBI/Profile.pm
Log:
Import of work-in-progress plugin that displays per-request DBI::Profile info

Added: trunk/Catalyst-Plugin-DBI-Profile/lib/Catalyst/Plugin/DBI/Profile.pm
===================================================================
--- trunk/Catalyst-Plugin-DBI-Profile/lib/Catalyst/Plugin/DBI/Profile.pm	                        (rev 0)
+++ trunk/Catalyst-Plugin-DBI-Profile/lib/Catalyst/Plugin/DBI/Profile.pm	2007-03-20 19:51:18 UTC (rev 6178)
@@ -0,0 +1,141 @@
+package Catalyst::Plugin::DBI::Profile;
+
+use strict;
+use warnings;
+use base qw/Class::Data::Inheritable/;
+use DBI::ProfileDumper;
+use DBI::ProfileData;
+use File::Temp ();
+use NEXT;
+use Scalar::Util qw(blessed);
+use Text::SimpleTable;
+use Time::HiRes qw(tv_interval);
+
+our $VERSION = '0.01';
+
+__PACKAGE__->mk_classdata('_profile_dbh');
+
+__PACKAGE__->mk_classdata( 
+    _profile_fh => File::Temp->new(
+        Template => 'catalyst-dbi-profile-XXXX',
+    )
+);
+
+# Disable dumping of profile data during DESTROY
+# I considered subclassing DBI::Profile to do this, but it's
+# documented, so why not...
+$DBI::Profile::ON_DESTROY_DUMP = sub {};
+
+sub set_profile_dbh {
+    my ( $class, $dbh ) = @_;
+    
+    if ( !$class->debug ) {
+        warn "Not running in debug mode, disabling DBI profiling\n";
+        return;
+    }
+    
+    # Enable profiling on this handle
+    $dbh->{Profile} = DBI::ProfileDumper->new(
+        Path => [ '!Statement', '!MethodName' ],
+        File => $class->_profile_fh->filename,
+    );
+    
+    $class->_profile_dbh( $dbh );
+}
+
+sub finalize {
+    my $c = shift;
+    
+    my $status = $c->NEXT::finalize(@_);
+    
+    if ( $c->debug ) {
+        # Display profile results in a nice table
+        my $dbh = $c->_profile_dbh;
+        if ( blessed($dbh) ) {
+            if ( keys %{ $dbh->{Profile}->{Data} } ) {
+                
+                # Get an approx. time the request took to execute,
+                # before we spend time processing the profile
+                my $elapsed = tv_interval($c->stats->getNodeValue);
+                
+                # format results into table
+                my $t = Text::SimpleTable->new( 
+                    [ 54, 'SQL Statement' ],
+                    [ 5,  'Count' ],
+                    [ 9,  'Time' ]
+                );
+                
+                # Dump and load the data back in
+                $dbh->{Profile}->flush_to_disk;
+                my $data = DBI::ProfileData->new( 
+                    File => $c->_profile_fh->filename
+                );
+                
+                # Sort by longest total time
+                $data->sort( field => 'total' );
+                
+                # find total time spent in DBI
+                my $total_time = 0;
+                
+                for my $node ( @{ $data->nodes } ) {
+                    my ($count, $time, $sql, $method) = @{$node}[0, 1, 7, 8];
+                    
+                    $total_time += $time;
+                    
+                    # Only display certain methods
+                    next unless $method =~ /execute/;
+                    
+                    $t->row( $sql, $count, $time . 's' );
+                }
+                
+                # Display percentage of total request spent in DBI
+                my $percent = sprintf "%.2f", ( ( $total_time / $elapsed ) * 100 );
+                
+                $c->log->info(
+                      "Time spent in DBI: ${total_time}s "
+                    . "(${percent}% of total request)\n" . $t->draw 
+                    . "\n"
+                );
+                
+                # XXX: Set profile data in the stash
+                
+                # Wipe profile data and file for next request
+                $dbh->{Profile}->empty;
+                delete $dbh->{Profile}->{_wrote_header};
+                truncate $c->_profile_fh, 0;
+            }
+        }
+    }
+    
+    return $status;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Catalyst::Plugin::DBI::Profile - Easily profile your database activity during development
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 CONFIGURATION
+
+=head1 METHODS
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<DBI::Profile>
+
+=head1 AUTHOR
+
+Andy Grundman, <andy at hybridized.org>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
\ No newline at end of file