[Bast-commits] r3869 - in DBIx-Class-QueryLog/1.0/trunk: . lib/DBIx/Class t

ash at dev.catalyst.perl.org ash at dev.catalyst.perl.org
Fri Nov 9 12:31:12 GMT 2007


Author: ash
Date: 2007-11-09 12:31:12 +0000 (Fri, 09 Nov 2007)
New Revision: 3869

Modified:
   DBIx-Class-QueryLog/1.0/trunk/Changes
   DBIx-Class-QueryLog/1.0/trunk/Makefile.PL
   DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog.pm
   DBIx-Class-QueryLog/1.0/trunk/t/01-quickies.t
Log:
Added passthrough option to allow DBIC_TRACE to work as normal

Modified: DBIx-Class-QueryLog/1.0/trunk/Changes
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/Changes	2007-11-09 07:36:47 UTC (rev 3868)
+++ DBIx-Class-QueryLog/1.0/trunk/Changes	2007-11-09 12:31:12 UTC (rev 3869)
@@ -1,6 +1,9 @@
 Revision history for DBIx-Class-QueryLog
 
-1.0.1  ---
+1.0.2
+    Added passthrough option to get queries printing to debugfh like normal
+
+1.0.1  Tues Aug 31 2007
     Remove Sort::Key, since it's not used (thanks nigel)
 
 1.0.0  Mon Aug 30 19:22:11 2007
@@ -8,13 +11,13 @@
     Add documentation for a couple of Query methods
     Add Analyzer and move get_sorted_queries to same
 
-0.03	Fri Mar 09 18:18:45 2007
-		Remove OS X resource fork files (thanks jshirley)
-		Add a missing dependency (Sort::Key)
+0.03  Fri Mar 09 18:18:45 2007
+    Remove OS X resource fork files (thanks jshirley)
+    Add a missing dependency (Sort::Key)
 
-0.02	Mon Mar 06 23:06:21 2007
-		Update POD to pass POD coverage tests.
+0.02  Mon Mar 06 23:06:21 2007
+    Update POD to pass POD coverage tests.
 
 0.01    Wed Feb 28 10:54:23 2007
-        First version, released on an innocent, unsuspecting world.
+    First version, released on an innocent, unsuspecting world.
 

Modified: DBIx-Class-QueryLog/1.0/trunk/Makefile.PL
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/Makefile.PL	2007-11-09 07:36:47 UTC (rev 3868)
+++ DBIx-Class-QueryLog/1.0/trunk/Makefile.PL	2007-11-09 12:31:12 UTC (rev 3869)
@@ -3,11 +3,11 @@
 name    'DBIx-Class-QueryLog';
 all_from    'lib/DBIx/Class/QueryLog.pm';
 
-requires    'Test::More'		=> 0;
-requires    'Class::Accessor'	=> 0;
-requires    'Time::HiRes'		=> 0;
-requires	'DBIx::Class'		=> 0;
+requires    'Test::More'       => 0;
+requires    'Class::Accessor'  => 0;
+requires    'Time::HiRes'      => 0;
+requires    'DBIx::Class'      => 0;
 
 auto_install;
 
-WriteAll;
\ No newline at end of file
+WriteAll;

Modified: DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog.pm
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog.pm	2007-11-09 07:36:47 UTC (rev 3868)
+++ DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog.pm	2007-11-09 12:31:12 UTC (rev 3869)
@@ -3,9 +3,10 @@
 use warnings;
 use strict;
 
-use base qw(Class::Accessor);
-__PACKAGE__->mk_accessors(qw(log current_transaction current_query));
+use base qw(DBIx::Class::Storage::Statistics);
+__PACKAGE__->mk_group_accessors(simple => qw(log current_transaction current_query passthrough));
 
+
 use Time::HiRes;
 
 use DBIx::Class::QueryLog::Query;
@@ -30,21 +31,21 @@
 in DBIx::Class:
 
     use DBIx::Class::QueryLog;
-
-	my $schema = ... # Get your schema!
+    
+    my $schema = ... # Get your schema!
     my $ql = new DBIx::Class::QueryLog();
-	$schema->storage->debugobj($ql);
-	$schema->storage->debug(1);
-    ... # do some stuff!
+    $schema->storage->debugobj($ql);
+    $schema->storage->debug(1);
+      ... # do some stuff!
 
 Every transaction and query executed will have a corresponding Transaction
 and Query object stored in order of execution, like so:
 
-	Query
-	Query
-	Transaction
-	Query
-	
+    Query
+    Query
+    Transaction
+    Query
+
 This array can be retrieved with the log() method.  Queries executed inside
 a transaction are stored inside their Transaction object, not inside the
 QueryLog directly.
@@ -52,6 +53,9 @@
 See L<DBIx::Class::QueryLog::Analyzer> for options on digesting the results
 of a QueryLog session.
 
+If you wish to have the QueryLog collecting results, and the normal trace
+output of SQL queries from DBIx::Class, then set C<passthru> to 1
+
 =head1 METHODS
 
 =head2 new
@@ -63,9 +67,9 @@
     my $proto = shift();
     my $self = $proto->SUPER::new(@_);
 
-	$self->log([]);
+    $self->log([]);
 
-	return $self;
+    return $self;
 }
 
 =head2 time_elapsed
@@ -74,14 +78,14 @@
 
 =cut
 sub time_elapsed {
-	my $self = shift();
+    my $self = shift();
 
-	my $total = 0;
-	foreach my $t (@{ $self->log() }) {
-		$total += $t->time_elapsed();
-	}
+    my $total = 0;
+    foreach my $t (@{ $self->log() }) {
+        $total += $t->time_elapsed();
+    }
 
-	return $total;
+    return $total;
 }
 
 =head2 count
@@ -93,11 +97,11 @@
     my $self = shift();
 
     my $total = 0;
-	foreach my $t (@{ $self->log() }) {
-		$total += $t->count();
-	}
+    foreach my $t (@{ $self->log() }) {
+        $total += $t->count();
+    }
 
-	return $total;
+    return $total;
 }
 
 =head2 reset
@@ -106,9 +110,9 @@
 
 =cut
 sub reset {
-	my $self = shift();
+    my $self = shift();
 
-	$self->log(undef);
+    $self->log(undef);
 }
 
 =head2 add_to_log
@@ -117,10 +121,10 @@
 
 =cut
 sub add_to_log {
-	my $self = shift();
-	my $thing = shift();
+    my $self = shift();
+    my $thing = shift();
 
-	push(@{ $self->log() }, $thing);
+    push(@{ $self->log() }, $thing);
 }
 
 =head2 txn_begin
@@ -130,13 +134,14 @@
 =cut
 
 sub txn_begin {
-	my $self = shift();
+    my $self = shift();
 
-	$self->current_transaction(
-		new DBIx::Class::QueryLog::Transaction({
-			start_time => Time::HiRes::time()
-		})
-	);
+    $self->next::method(@_) if $self->passthrough;
+    $self->current_transaction(
+        new DBIx::Class::QueryLog::Transaction({
+            start_time => Time::HiRes::time()
+        })
+    );
 }
 
 =head2 txn_commit
@@ -146,18 +151,19 @@
 =cut
 
 sub txn_commit {
-	my $self = shift();
+    my $self = shift();
 
-	if(defined($self->current_transaction())) {
-		my $txn = $self->current_transaction();
-		$txn->end_time(Time::HiRes::time());
-		$txn->committed(1);
-		$txn->rolledback(0);
-		push(@{ $self->log() }, $txn);
-		$self->current_transaction(undef);
-	} else {
-		warn('Unknown transaction committed.')
-	}
+    $self->next::method(@_) if $self->passthrough;
+    if(defined($self->current_transaction())) {
+        my $txn = $self->current_transaction();
+        $txn->end_time(Time::HiRes::time());
+        $txn->committed(1);
+        $txn->rolledback(0);
+        push(@{ $self->log() }, $txn);
+        $self->current_transaction(undef);
+    } else {
+        warn('Unknown transaction committed.')
+    }
 }
 
 =head2 txn_rollback
@@ -167,18 +173,19 @@
 =cut
 
 sub txn_rollback {
-	my $self = shift();
+    my $self = shift();
 
-	if(defined($self->current_transaction())) {
-		my $txn = $self->current_transaction();
-		$txn->end_time(Time::HiRes::time());
-		$txn->committed(0);
-		$txn->rolledback(1);
-		$self->add_to_log($txn);
-		$self->current_transaction(undef);
-	} else {
-		warn('Unknown transaction committed.')
-	}
+    $self->next::method(@_) if $self->passthrough;
+    if(defined($self->current_transaction())) {
+        my $txn = $self->current_transaction();
+        $txn->end_time(Time::HiRes::time());
+        $txn->committed(0);
+        $txn->rolledback(1);
+        $self->add_to_log($txn);
+        $self->current_transaction(undef);
+    } else {
+        warn('Unknown transaction committed.')
+    }
 }
 
 =head2 query_start
@@ -188,17 +195,18 @@
 =cut
 
 sub query_start {
-	my $self = shift();
-	my $sql = shift();
-	my @params = @_;
+    my $self = shift();
+    my $sql = shift();
+    my @params = @_;
 
-	$self->current_query(
-		new DBIx::Class::QueryLog::Query({
-			start_time 	=> Time::HiRes::time(),
-			sql			=> $sql,
-			params		=> \@params,
-		})
-	);
+    $self->next::method($sql, @params) if $self->passthrough;
+    $self->current_query(
+        new DBIx::Class::QueryLog::Query({
+            start_time  => Time::HiRes::time(),
+            sql         => $sql,
+            params      => \@params,
+        })
+    );
 }
 
 =head2 query_end
@@ -208,20 +216,21 @@
 =cut
 
 sub query_end {
-	my $self = shift();
+    my $self = shift();
 
-	if(defined($self->current_query())) {
-		my $q = $self->current_query();
-		$q->end_time(Time::HiRes::time());
-		if(defined($self->current_transaction())) {
-			$self->current_transaction->add_to_queries($q);
-		} else {
-			$self->add_to_log($q)
-		}
-		$self->current_query(undef);
-	} else {
-		warn('Completed unknown query.');
-	}
+    $self->next::method(@_) if $self->passthrough;
+    if(defined($self->current_query())) {
+        my $q = $self->current_query();
+        $q->end_time(Time::HiRes::time());
+        if(defined($self->current_transaction())) {
+            $self->current_transaction->add_to_queries($q);
+        } else {
+            $self->add_to_log($q)
+        }
+        $self->current_query(undef);
+    } else {
+        warn('Completed unknown query.');
+    }
 }
 
 =head1 AUTHOR

Modified: DBIx-Class-QueryLog/1.0/trunk/t/01-quickies.t
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/t/01-quickies.t	2007-11-09 07:36:47 UTC (rev 3868)
+++ DBIx-Class-QueryLog/1.0/trunk/t/01-quickies.t	2007-11-09 12:31:12 UTC (rev 3869)
@@ -1,15 +1,17 @@
-#!perl -T
+#!perl
 
 use strict;
 use warnings;
-use Test::More tests => 10;
+use Test::More tests => 12;
 
 use DBIx::Class::QueryLog;
 use DBIx::Class::QueryLog::Query;
 use DBIx::Class::QueryLog::Transaction;
 
+
 my $ql = new DBIx::Class::QueryLog();
 ok($ql->isa('DBIx::Class::QueryLog'), 'new');
+ok($ql->isa('DBIx::Class::Storage::Statistics'), "extends base debug object");
 
 $ql->query_start('SELECT * from foo');
 $ql->query_end('SELECT * from foo');
@@ -26,6 +28,18 @@
 ok($log->[1]->committed, 'Committed txn');
 ok(!$log->[1]->rolledback, '! Rolled back txn');
 
+my $output = "";
+{
+  package Printable;
+
+  sub print {
+    my ($self, @args) = @_;
+    $output .= join('', @args);
+  }
+}
+
+$ql->passthrough(1);
+$ql->debugfh(bless {}, "Printable");
 $ql->txn_begin();
 $ql->query_start('SELECT * from foo');
 $ql->query_end('SELECT * from foo');
@@ -37,4 +51,11 @@
 $log = $ql->log();
 ok(scalar(@{ $log->[2]->queries() }) == 2, '2 queries in 2nd txn');
 ok($log->[2]->rolledback, 'Rolled back 2nd txn');
-ok(!$log->[2]->committed, 'Not committed 2nd txn');
\ No newline at end of file
+ok(!$log->[2]->committed, 'Not committed 2nd txn');
+
+is( $output, <<'EOF', "Passthrough worked");
+BEGIN WORK
+SELECT * from foo: 
+SELECT * from foo: 
+ROLLBACK
+EOF




More information about the Bast-commits mailing list