[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