[Bast-commits] r4731 - in DBIx-Class-QueryLog/1.0/trunk: .
lib/DBIx/Class lib/DBIx/Class/QueryLog t
gphat at dev.catalyst.perl.org
gphat at dev.catalyst.perl.org
Wed Aug 6 18:01:27 BST 2008
Author: gphat
Date: 2008-08-06 18:01:26 +0100 (Wed, 06 Aug 2008)
New Revision: 4731
Added:
DBIx-Class-QueryLog/1.0/trunk/t/03-buckets.t
Modified:
DBIx-Class-QueryLog/1.0/trunk/Changes
DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog.pm
DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Analyzer.pm
DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Query.pm
DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Transaction.pm
DBIx-Class-QueryLog/1.0/trunk/t/01-quickies.t
DBIx-Class-QueryLog/1.0/trunk/t/02-analyzer.t
Log:
Add buckets
Modified: DBIx-Class-QueryLog/1.0/trunk/Changes
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/Changes 2008-08-06 12:17:33 UTC (rev 4730)
+++ DBIx-Class-QueryLog/1.0/trunk/Changes 2008-08-06 17:01:26 UTC (rev 4731)
@@ -1,5 +1,13 @@
Revision history for DBIx-Class-QueryLog
+1.10
+ - Add buckets to QueryLog
+ - Transaction complete wasn't using add_to_log
+ - Small style fixes
+
+1.0.5
+ Update main POD to use Analyzer
+
1.0.4
Typo in Analyzer POD
Modified: DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Analyzer.pm
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Analyzer.pm 2008-08-06 12:17:33 UTC (rev 4730)
+++ DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Analyzer.pm 2008-08-06 17:01:26 UTC (rev 4731)
@@ -16,14 +16,14 @@
QueryLog:
my $schema = ... # Get your schema!
- my $ql = new DBIx::Class::QueryLog();
+ my $ql = DBIx::Class::QueryLog->new;
$schema->storage->debugobj($ql);
$schema->storage->debug(1);
... # do some stuff!
- my $ana = new DBIx::Class::QueryLog::Analyzer({ querylog => $ql });
- my @queries = $ana->get_sorted_queries();
+ my $ana = DBIx::Class::QueryLog::Analyzer->new({ querylog => $ql });
+ my @queries = $ana->get_sorted_queries;
# or...
- my $totaled = $ana->get_totaled_queries();
+ my $totaled = $ana->get_totaled_queries;
=head1 METHODS
@@ -35,7 +35,7 @@
=cut
sub new {
- my $proto = shift();
+ my $proto = shift;
my $self = $proto->SUPER::new(@_);
return $self;
@@ -48,17 +48,17 @@
=cut
sub get_sorted_queries {
- my $self = shift();
+ my ($self) = @_;
my @queries;
- foreach my $l (@{ $self->querylog->log() }) {
- push(@queries, @{ $l->get_sorted_queries() });
+ foreach my $l (@{ $self->querylog->log }) {
+ push(@queries, @{ $l->get_sorted_queries });
}
- return [ reverse sort { $a->time_elapsed() <=> $b->time_elapsed() } @queries ];
+ return [ reverse sort { $a->time_elapsed <=> $b->time_elapsed } @queries ];
}
-=head2 get_totaled_queries
+=head2 get_totaled_queries($honor_buckets)
Returns hashref of the queries executed, with same-SQL combined and totaled.
So if the same query is executed multiple times, it will be combined into
@@ -75,6 +75,23 @@
}
}
+If you pass a true value then this method will break out by bucket. The
+structure becomes:
+
+$var = {
+ 'bucket1' => {
+ 'SQL that was EXECUTED' => {
+ count => 2,
+ time_elapsed => 1931,
+ queries => [
+ DBIx::Class::QueryLog...,
+ DBIx::Class::QueryLog...
+ ]
+ }
+ }
+ 'bucket2' => { ... }
+}
+
This is useful for when you've fine-tuned individually slow queries and need
to isolate which queries are executed a lot, so that you can determine which
to focus on next.
@@ -82,7 +99,7 @@
To sort it you'll want to use something like this (sorry for the long line,
blame perl...):
- my $analyzed = $ana->get_totaled_queries();
+ my $analyzed = $ana->get_totaled_queries;
my @keys = reverse sort {
$analyzed->{$a}->{'time_elapsed'} <=> $analyzed->{$b}->{'time_elapsed'}
} keys(%{ $analyzed });
@@ -92,14 +109,20 @@
=cut
sub get_totaled_queries {
- my $self = shift();
+ my ($self, $honor_buckets) = @_;
my %totaled;
- foreach my $l (@{ $self->querylog->log() }) {
- foreach my $q (@{ $l->queries() }) {
- $totaled{$q->sql()}->{'count'}++;
- $totaled{$q->sql()}->{'time_elapsed'} += $q->time_elapsed();
- push(@{ $totaled{$q->sql()}->{'queries'} }, $q);
+ foreach my $l (@{ $self->querylog->log }) {
+ foreach my $q (@{ $l->queries }) {
+ if($honor_buckets) {
+ $totaled{$q->bucket}->{$q->sql}->{count}++;
+ $totaled{$q->bucket}->{$q->sql}->{time_elapsed} += $q->time_elapsed;
+ push(@{ $totaled{$q->bucket}->{$q->sql}->{queries} }, $q);
+ } else {
+ $totaled{$q->sql}->{count}++;
+ $totaled{$q->sql}->{time_elapsed} += $q->time_elapsed;
+ push(@{ $totaled{$q->sql}->{queries} }, $q);
+ }
}
}
return \%totaled;
Modified: DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Query.pm
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Query.pm 2008-08-06 12:17:33 UTC (rev 4730)
+++ DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Query.pm 2008-08-06 17:01:26 UTC (rev 4731)
@@ -4,7 +4,7 @@
use strict;
use base qw(Class::Accessor);
-__PACKAGE__->mk_accessors(qw(start_time end_time sql params));
+__PACKAGE__->mk_accessors(qw(bucket start_time end_time sql params));
=head1 NAME
@@ -16,8 +16,10 @@
=head1 METHODS
-=head2
+=head2 bucket
+The bucket this query is in.
+
=head2 start_time
Time this query started.
@@ -41,9 +43,9 @@
=cut
sub time_elapsed {
- my $self = shift();
+ my $self = shift;
- return $self->end_time() - $self->start_time();
+ return $self->end_time - $self->start_time;
}
=head2 count
@@ -63,7 +65,7 @@
=cut
sub queries {
- my $self = shift();
+ my $self = shift;
return [ $self ];
}
@@ -74,7 +76,7 @@
=cut
sub get_sorted_queries {
- my $self = shift();
+ my $self = shift;
return [ $self ];
}
Modified: DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Transaction.pm
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Transaction.pm 2008-08-06 12:17:33 UTC (rev 4730)
+++ DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Transaction.pm 2008-08-06 17:01:26 UTC (rev 4731)
@@ -4,7 +4,7 @@
use strict;
use base qw(Class::Accessor);
-__PACKAGE__->mk_accessors(qw(start_time end_time queries committed rolledback));
+__PACKAGE__->mk_accessors(qw(bucket start_time end_time queries committed rolledback));
=head1 NAME
@@ -25,7 +25,7 @@
=cut
sub new {
- my $proto = shift();
+ my $proto = shift;
my $self = $proto->SUPER::new(@_);
$self->queries([]);
@@ -33,6 +33,10 @@
return $self;
}
+=head2 bucket
+
+The bucket this tranaction is in.
+
=head2 queries
Arrayref containing all queries executed, in order of execution.
@@ -59,11 +63,11 @@
=cut
sub time_elapsed {
- my $self = shift();
+ my $self = shift;
my $total = 0;
- foreach my $q (@{ $self->queries() }) {
- $total += $q->time_elapsed();
+ foreach my $q (@{ $self->queries }) {
+ $total += $q->time_elapsed;
}
return $total;
@@ -75,10 +79,10 @@
=cut
sub add_to_queries {
- my $self = shift();
- my $query = shift();
+ my $self = shift;
+ my $query = shift;
- push(@{ $self->queries() }, $query);
+ push(@{ $self->queries }, $query);
}
=head2 count
@@ -87,9 +91,9 @@
=cut
sub count {
- my $self = shift();
+ my $self = shift;
- return scalar(@{ $self->queries() });
+ return scalar(@{ $self->queries });
}
=head2 get_sorted_queries
@@ -98,9 +102,9 @@
=cut
sub get_sorted_queries {
- my $self = shift();
+ my $self = shift;
- return [ reverse sort { $a->time_elapsed() <=> $b->time_elapsed() } @{ $self->queries() } ];
+ return [ reverse sort { $a->time_elapsed <=> $b->time_elapsed } @{ $self->queries } ];
}
=head1 AUTHOR
Modified: DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog.pm
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog.pm 2008-08-06 12:17:33 UTC (rev 4730)
+++ DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog.pm 2008-08-06 17:01:26 UTC (rev 4731)
@@ -4,9 +4,10 @@
use strict;
use base qw(DBIx::Class::Storage::Statistics);
-__PACKAGE__->mk_group_accessors(simple => qw(log current_transaction current_query passthrough));
+__PACKAGE__->mk_group_accessors(simple => qw(
+ bucket current_transaction current_query log passthrough
+));
-
use Time::HiRes;
use DBIx::Class::QueryLog::Query;
@@ -16,13 +17,9 @@
DBIx::Class::QueryLog - Log queries for later analysis.
-=head1 VERSION
-
-Version 1.0.4
-
=cut
-our $VERSION = '1.0.4';
+our $VERSION = '1.1.0';
=head1 SYNOPSIS
@@ -31,12 +28,15 @@
in DBIx::Class:
use DBIx::Class::QueryLog;
+ use DBIx::Class::QueryLog::Analyzer;
my $schema = ... # Get your schema!
- my $ql = new DBIx::Class::QueryLog();
+ my $ql = DBIx::Class::QueryLog->new;
$schema->storage->debugobj($ql);
$schema->storage->debug(1);
... # do some stuff!
+ my $ana = DBIx::Class::QueryLog::Analyzer({ querylog => $ql })->new;
+ my @queries = $ana->get_sorted_queries;
Every transaction and query executed will have a corresponding Transaction
and Query object stored in order of execution, like so:
@@ -46,7 +46,7 @@
Transaction
Query
-This array can be retrieved with the log() method. Queries executed inside
+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.
@@ -56,6 +56,23 @@
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 BUCKETS
+
+Sometimes you want to break your analysis down into stages. To segregate the
+queries and transactions, simply set the bucket and run some queries:
+
+ $ql->bucket('selects');
+ $schema->resultset('Foo')->find(..);
+ # Some queries
+ $ql->bucket('updates');
+ $foo->update({ name => 'Gorch' });
+ $ql->bucket('something else);
+ ...
+
+Any time a query or transaction is completed the QueryLog's current bucket
+will be copied into it so that the Analyzer can later use it. See
+the get_totaled_queries method and it's optional parameter.
+
=head1 METHODS
=head2 new
@@ -64,25 +81,31 @@
=cut
sub new {
- my $proto = shift();
+ my $proto = shift;
my $self = $proto->SUPER::new(@_);
$self->log([]);
+ $self->bucket('default');
return $self;
}
+=head2 bucket
+
+Set the current bucket for this QueryLog. This bucket will be copied to any
+transactions or queries that finish.
+
=head2 time_elapsed
Returns the total time elapsed for ALL transactions and queries in this log.
=cut
sub time_elapsed {
- my $self = shift();
+ my $self = shift;
my $total = 0;
- foreach my $t (@{ $self->log() }) {
- $total += $t->time_elapsed();
+ foreach my $t (@{ $self->log }) {
+ $total += $t->time_elapsed;
}
return $total;
@@ -94,11 +117,11 @@
=cut
sub count {
- my $self = shift();
+ my $self = shift;
my $total = 0;
- foreach my $t (@{ $self->log() }) {
- $total += $t->count();
+ foreach my $t (@{ $self->log }) {
+ $total += $t->count;
}
return $total;
@@ -110,7 +133,7 @@
=cut
sub reset {
- my $self = shift();
+ my $self = shift;
$self->log(undef);
}
@@ -121,10 +144,11 @@
=cut
sub add_to_log {
- my $self = shift();
- my $thing = shift();
+ my $self = shift;
+ my $thing = shift;
- push(@{ $self->log() }, $thing);
+ $thing->bucket($self->bucket);
+ push(@{ $self->log }, $thing);
}
=head2 txn_begin
@@ -134,12 +158,12 @@
=cut
sub txn_begin {
- my $self = shift();
+ my $self = shift;
$self->next::method(@_) if $self->passthrough;
$self->current_transaction(
- new DBIx::Class::QueryLog::Transaction({
- start_time => Time::HiRes::time()
+ DBIx::Class::QueryLog::Transaction->new({
+ start_time => Time::HiRes::time
})
);
}
@@ -151,15 +175,15 @@
=cut
sub txn_commit {
- my $self = shift();
+ my $self = shift;
$self->next::method(@_) if $self->passthrough;
- if(defined($self->current_transaction())) {
- my $txn = $self->current_transaction();
- $txn->end_time(Time::HiRes::time());
+ 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->add_to_log($txn);
$self->current_transaction(undef);
} else {
warn('Unknown transaction committed.')
@@ -173,12 +197,12 @@
=cut
sub txn_rollback {
- my $self = shift();
+ my $self = shift;
$self->next::method(@_) if $self->passthrough;
- if(defined($self->current_transaction())) {
- my $txn = $self->current_transaction();
- $txn->end_time(Time::HiRes::time());
+ 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);
@@ -195,14 +219,14 @@
=cut
sub query_start {
- my $self = shift();
- my $sql = shift();
+ my $self = shift;
+ my $sql = shift;
my @params = @_;
$self->next::method($sql, @params) if $self->passthrough;
$self->current_query(
- new DBIx::Class::QueryLog::Query({
- start_time => Time::HiRes::time(),
+ DBIx::Class::QueryLog::Query->new({
+ start_time => Time::HiRes::time,
sql => $sql,
params => \@params,
})
@@ -216,13 +240,14 @@
=cut
sub query_end {
- my $self = shift();
+ my $self = shift;
$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())) {
+ if(defined($self->current_query)) {
+ my $q = $self->current_query;
+ $q->end_time(Time::HiRes::time);
+ $q->bucket($self->bucket);
+ if(defined($self->current_transaction)) {
$self->current_transaction->add_to_queries($q);
} else {
$self->add_to_log($q)
Modified: DBIx-Class-QueryLog/1.0/trunk/t/01-quickies.t
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/t/01-quickies.t 2008-08-06 12:17:33 UTC (rev 4730)
+++ DBIx-Class-QueryLog/1.0/trunk/t/01-quickies.t 2008-08-06 17:01:26 UTC (rev 4731)
@@ -9,22 +9,22 @@
use DBIx::Class::QueryLog::Transaction;
-my $ql = new DBIx::Class::QueryLog();
+my $ql = DBIx::Class::QueryLog->new;
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');
-ok(scalar(@{ $ql->log() }) == 1, 'log count w/1 query');
+ok(scalar(@{ $ql->log }) == 1, 'log count w/1 query');
-$ql->txn_begin();
+$ql->txn_begin;
$ql->query_start('SELECT * from foo');
$ql->query_end('SELECT * from foo');
-$ql->txn_commit();
+$ql->txn_commit;
-ok(scalar(@{ $ql->log() }) == 2, 'log count w/1 query + 1 trans');
-my $log = $ql->log();
-ok(scalar(@{ $log->[1]->queries() }) == 1, '1 query in txn');
+ok(scalar(@{ $ql->log }) == 2, 'log count w/1 query + 1 trans');
+my $log = $ql->log;
+ok(scalar(@{ $log->[1]->queries }) == 1, '1 query in txn');
ok($log->[1]->committed, 'Committed txn');
ok(!$log->[1]->rolledback, '! Rolled back txn');
@@ -40,16 +40,16 @@
$ql->passthrough(1);
$ql->debugfh(bless {}, "Printable");
-$ql->txn_begin();
+$ql->txn_begin;
$ql->query_start('SELECT * from foo');
$ql->query_end('SELECT * from foo');
$ql->query_start('SELECT * from foo');
$ql->query_end('SELECT * from foo');
-$ql->txn_rollback();
+$ql->txn_rollback;
-ok(scalar(@{ $ql->log() }) == 3, 'log count w/1 query + 2 trans');
-$log = $ql->log();
-ok(scalar(@{ $log->[2]->queries() }) == 2, '2 queries in 2nd txn');
+ok(scalar(@{ $ql->log }) == 3, 'log count w/1 query + 2 trans');
+$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');
Modified: DBIx-Class-QueryLog/1.0/trunk/t/02-analyzer.t
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/t/02-analyzer.t 2008-08-06 12:17:33 UTC (rev 4730)
+++ DBIx-Class-QueryLog/1.0/trunk/t/02-analyzer.t 2008-08-06 17:01:26 UTC (rev 4731)
@@ -10,14 +10,14 @@
}
require_ok('DBIx::Class::QueryLog::Analyzer');
-my $ql = new DBIx::Class::QueryLog();
+my $ql = DBIx::Class::QueryLog->new;
ok($ql->isa('DBIx::Class::QueryLog'), 'new');
$ql->query_start('SELECT * from foo');
$ql->query_end('SELECT * from foo');
-ok(scalar(@{ $ql->log() }) == 1, 'log count w/1 query');
+ok(scalar(@{ $ql->log }) == 1, 'log count w/1 query');
-$ql->txn_begin();
+$ql->txn_begin;
$ql->query_start('SELECT * from foo');
$ql->query_end('SELECT * from foo');
@@ -25,20 +25,20 @@
sleep(1);
$ql->query_end('SELECT * from bar');
-$ql->txn_commit();
+$ql->txn_commit;
-my $ana = new DBIx::Class::QueryLog::Analyzer({
+my $ana = DBIx::Class::QueryLog::Analyzer->new({
querylog => $ql
});
isa_ok($ana, 'DBIx::Class::QueryLog::Analyzer');
-isa_ok($ana->querylog(), 'DBIx::Class::QueryLog');
+isa_ok($ana->querylog, 'DBIx::Class::QueryLog');
-cmp_ok(scalar(@{ $ana->get_sorted_queries() }), '==', 3, 'Sorted Count');
+cmp_ok(scalar(@{ $ana->get_sorted_queries }), '==', 3, 'Sorted Count');
-my $analyzed = $ana->get_totaled_queries();
+my $analyzed = $ana->get_totaled_queries;
my @keys = reverse sort {
$analyzed->{$a}->{'time_elapsed'} <=> $analyzed->{$b}->{'time_elapsed'}
- } keys(%{ $ana->get_totaled_queries() });
+ } keys(%{ $ana->get_totaled_queries });
cmp_ok(scalar(@keys), '==', 2, '2 different queries');
cmp_ok($analyzed->{$keys[0]}->{'count'}, '==', 1, '1 executions');
Added: DBIx-Class-QueryLog/1.0/trunk/t/03-buckets.t
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/t/03-buckets.t (rev 0)
+++ DBIx-Class-QueryLog/1.0/trunk/t/03-buckets.t 2008-08-06 17:01:26 UTC (rev 4731)
@@ -0,0 +1,31 @@
+#!perl
+use strict;
+use warnings;
+use Test::More tests => 5;
+
+use DBIx::Class::QueryLog;
+use DBIx::Class::QueryLog::Analyzer;
+use DBIx::Class::QueryLog::Query;
+use DBIx::Class::QueryLog::Transaction;
+
+my $ql = DBIx::Class::QueryLog->new;
+$ql->query_start('SELECT * from foo');
+$ql->query_end('SELECT * from foo');
+cmp_ok($ql->log->[0]->bucket, 'eq', 'default', 'default bucket');
+
+$ql->bucket('foo');
+$ql->txn_begin;
+$ql->query_start('SELECT * from foo');
+$ql->query_end('SELECT * from foo');
+$ql->txn_commit;
+cmp_ok($ql->log->[1]->bucket, 'eq', 'foo', 'foo bucket');
+
+cmp_ok($ql->log->[1]->queries->[0]->bucket, 'eq', 'foo', 'inner query bucket');
+
+cmp_ok($ql->log->[0]->bucket, 'eq', 'default', 'first still default bucket');
+
+my $ana = DBIx::Class::QueryLog::Analyzer->new({
+ querylog => $ql
+});
+my $total = $ana->get_totaled_queries(1);
+cmp_ok(scalar(keys(%{ $total })), '==', 2, '2 buckets');
\ No newline at end of file
More information about the Bast-commits
mailing list