[Bast-commits] r3691 - in DBIx-Class-QueryLog/1.0/trunk: . lib
lib/DBIx lib/DBIx/Class lib/DBIx/Class/QueryLog t
gphat at dev.catalyst.perl.org
gphat at dev.catalyst.perl.org
Tue Aug 21 17:37:54 GMT 2007
Author: gphat
Date: 2007-08-21 17:37:53 +0100 (Tue, 21 Aug 2007)
New Revision: 3691
Added:
DBIx-Class-QueryLog/1.0/trunk/Changes
DBIx-Class-QueryLog/1.0/trunk/MANIFEST
DBIx-Class-QueryLog/1.0/trunk/Makefile.PL
DBIx-Class-QueryLog/1.0/trunk/README
DBIx-Class-QueryLog/1.0/trunk/lib/
DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/
DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/
DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog.pm
DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/
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/
DBIx-Class-QueryLog/1.0/trunk/t/00-load.t
DBIx-Class-QueryLog/1.0/trunk/t/01-quickies.t
DBIx-Class-QueryLog/1.0/trunk/t/02-analyzer.t
DBIx-Class-QueryLog/1.0/trunk/t/pod-coverage.t
DBIx-Class-QueryLog/1.0/trunk/t/pod.t
Log:
initial import
Added: DBIx-Class-QueryLog/1.0/trunk/Changes
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/Changes (rev 0)
+++ DBIx-Class-QueryLog/1.0/trunk/Changes 2007-08-21 16:37:53 UTC (rev 3691)
@@ -0,0 +1,17 @@
+Revision history for DBIx-Class-QueryLog
+
+0.10 Mon Aug 20 17:22:11 2007
+ Remove Sort::Key dependency
+ 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.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.
+
Added: DBIx-Class-QueryLog/1.0/trunk/MANIFEST
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/MANIFEST (rev 0)
+++ DBIx-Class-QueryLog/1.0/trunk/MANIFEST 2007-08-21 16:37:53 UTC (rev 3691)
@@ -0,0 +1,14 @@
+Changes
+MANIFEST
+META.yml # Will be created by "make dist"
+Makefile.PL
+README
+lib/DBIx/Class/QueryLog.pm
+lib/DBIx/Class/QueryLog/Analyzer.pm
+lib/DBIx/Class/QueryLog/Query.pm
+lib/DBIx/Class/QueryLog/Transaction.pm
+t/00-load.t
+t/01-quickies.t
+t/02-analyzer.t
+t/pod-coverage.t
+t/pod.t
Added: DBIx-Class-QueryLog/1.0/trunk/Makefile.PL
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/Makefile.PL (rev 0)
+++ DBIx-Class-QueryLog/1.0/trunk/Makefile.PL 2007-08-21 16:37:53 UTC (rev 3691)
@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'DBIx::Class::QueryLog',
+ AUTHOR => "Cory 'G' Watson <gphat\@cpan.org>",
+ VERSION_FROM => 'lib/DBIx/Class/QueryLog.pm',
+ ABSTRACT_FROM => 'lib/DBIx/Class/QueryLog.pm',
+ PL_FILES => {},
+ PREREQ_PM => {
+ 'Test::More' => 0,
+ 'Class::Accessor' => 0,
+ 'Time::HiRes' => 0,
+ 'DBIx::Class' => 0,
+ },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'DBIx-Class-QueryLog-*' },
+);
Added: DBIx-Class-QueryLog/1.0/trunk/README
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/README (rev 0)
+++ DBIx-Class-QueryLog/1.0/trunk/README 2007-08-21 16:37:53 UTC (rev 3691)
@@ -0,0 +1,49 @@
+DBIx-Class-QueryLog
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the README
+file from a module distribution so that people browsing the archive
+can use it get an idea of the modules uses. It is usually a good idea
+to provide version information here so that people can decide whether
+fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the perldoc command.
+
+ perldoc DBIx::Class::QueryLog
+
+You can also look for information at:
+
+ Search CPAN
+ http://search.cpan.org/dist/DBIx-Class-QueryLog
+
+ CPAN Request Tracker:
+ http://rt.cpan.org/NoAuth/Bugs.html?Dist=DBIx-Class-QueryLog
+
+ AnnoCPAN, annotated CPAN documentation:
+ http://annocpan.org/dist/DBIx-Class-QueryLog
+
+ CPAN Ratings:
+ http://cpanratings.perl.org/d/DBIx-Class-QueryLog
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2007 Cory 'G' Watson
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
Added: DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Analyzer.pm
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Analyzer.pm (rev 0)
+++ DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Analyzer.pm 2007-08-21 16:37:53 UTC (rev 3691)
@@ -0,0 +1,124 @@
+package DBIx::Class::QueryLog::Analyzer;
+
+use warnings;
+use strict;
+
+use base qw(Class::Accessor);
+__PACKAGE__->mk_accessors(qw(querylog));
+
+use Sort::Key;
+
+=head1 NAME
+
+DBIx::Class::QueryLog::Analyzer - Query Analysis
+
+=head1 SYNOPSIS
+
+Analyzes the results of a QueryLog. Create an Analyzer and pass it the
+QueryLog:
+
+ my $schema = ... # Get your schema!
+ my $ql = new DBIx::Class::QueryLog();
+ $schema->storage->debugobj($ql);
+ $schema->storage->debug(1);
+ ... # do some stuff!
+ my $ana = DBIx::Class::QueryLog::Analyzer({ querylog => $ql });
+ my @queries = $ana->get_sorted_queries();
+ # or...
+ my $totaled = $ana->get_totaled_queries();
+
+
+=head1 METHODS
+
+=head2 new
+
+Create a new DBIx::Class::QueryLog::Analyzer
+
+=cut
+
+sub new {
+ my $proto = shift();
+ my $self = $proto->SUPER::new(@_);
+
+ return $self;
+}
+
+=head2 get_sorted_queries
+
+Returns a list of all Query objects, sorted by elapsed time (descending).
+
+=cut
+
+sub get_sorted_queries {
+ my $self = shift();
+
+ my @queries;
+
+ foreach my $l (@{ $self->querylog->log() }) {
+ push(@queries, @{ $l->get_sorted_queries() });
+ }
+ return [ reverse sort { $a->time_elapsed() <=> $b->time_elapsed() } @queries ];
+}
+
+=head2 get_totaled_queries
+
+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
+a single entry. The structure is:
+
+ $var = {
+ 'SQL that was EXECUTED' => {
+ count => 2,
+ time_elapsed => 1931,
+ queries => [
+ DBIx::Class::QueryLog...,
+ DBIx::Class::QueryLog...
+ ]
+ }
+ }
+
+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.
+
+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 @keys = reverse sort {
+ $analyzed->{$a}->{'time_elapsed'} <=> $analyzed->{$b}->{'time_elapsed'}
+ } keys(%{ $analyzed });
+
+So one could sort by count or time_elapsed.
+
+=cut
+
+sub get_totaled_queries {
+ my $self = shift();
+
+ 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);
+ }
+ }
+ return \%totaled;
+}
+
+=head1 AUTHOR
+
+Cory 'G' Watson C<< <gphat at cpan.org> >>
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Cory 'G' Watson, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+1;
\ No newline at end of file
Added: DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Query.pm
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Query.pm (rev 0)
+++ DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Query.pm 2007-08-21 16:37:53 UTC (rev 3691)
@@ -0,0 +1,97 @@
+package DBIx::Class::QueryLog::Query;
+
+use warnings;
+use strict;
+
+use base qw(Class::Accessor);
+__PACKAGE__->mk_accessors(qw(start_time end_time sql params));
+
+=head1 NAME
+
+DBIx::Class::QueryLog::Query - A Query
+
+=head1 SYNOPSIS
+
+Represents a query. The sql, parameters, start time and end time are stored.
+
+=head1 METHODS
+
+=head2
+
+=head2 start_time
+
+Time this query started.
+
+=head2 end_time
+
+Time this query ended.
+
+=head2 sql
+
+SQL for this query.
+
+=head2 params
+
+Parameters used with this query.
+
+=head2 time_elapsed
+
+Time this query took to execute. start - end.
+
+=cut
+
+sub time_elapsed {
+ my $self = shift();
+
+ return $self->end_time() - $self->start_time();
+}
+
+=head2 count
+
+Returns 1. Exists to make it easier for QueryLog to get a count of
+queries executed.
+
+=cut
+sub count {
+
+ return 1;
+}
+
+=head2 queries
+
+Returns this query, here to make QueryLog's job easier.
+
+=cut
+sub queries {
+ my $self = shift();
+
+ return [ $self ];
+}
+
+=head2 get_sorted_queries
+
+Returns this query. Here to make QueryLog's job easier.
+
+=cut
+sub get_sorted_queries {
+ my $self = shift();
+
+ return [ $self ];
+}
+
+=head1 AUTHOR
+
+Cory 'G' Watson, C<< <gphat at cpan.org> >>
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Cory 'G' Watson, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1;
\ No newline at end of file
Added: DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Transaction.pm
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Transaction.pm (rev 0)
+++ DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog/Transaction.pm 2007-08-21 16:37:53 UTC (rev 3691)
@@ -0,0 +1,120 @@
+package DBIx::Class::QueryLog::Transaction;
+
+use warnings;
+use strict;
+
+use base qw(Class::Accessor);
+__PACKAGE__->mk_accessors(qw(start_time end_time queries committed rolledback));
+
+=head1 NAME
+
+DBIx::Class::QueryLog::Transaction - A Transaction
+
+=head1 SYNOPSIS
+
+Represents a transaction. All queries executed with the context of this
+transaction are stored herein, as well as a start time, end time and flag
+for committed or rolledback.
+
+=head1 METHODS
+
+=head2 new
+
+Create a new DBIx::Class::QueryLog::Transcation
+
+=cut
+
+sub new {
+ my $proto = shift();
+ my $self = $proto->SUPER::new(@_);
+
+ $self->queries([]);
+
+ return $self;
+}
+
+=head2 queries
+
+Arrayref containing all queries executed, in order of execution.
+
+=head2 committed
+
+Flag indicating if this transaction was committed.
+
+=head2 rolledback
+
+Flag indicating if this transaction was rolled back.
+
+=head2 start_time
+
+Time this transaction started.
+
+=head2 end_time
+
+Time this transaction ended.
+
+=head2 time_elapsed
+
+Time this transaction took to execute. start - end.
+
+=cut
+sub time_elapsed {
+ my $self = shift();
+
+ my $total = 0;
+ foreach my $q (@{ $self->queries() }) {
+ $total += $q->time_elapsed();
+ }
+
+ return $total;
+}
+
+=head2 add_to_queries
+
+Add the provided query to this transactions list.
+
+=cut
+sub add_to_queries {
+ my $self = shift();
+ my $query = shift();
+
+ push(@{ $self->queries() }, $query);
+}
+
+=head2 count
+
+Returns the number of queries in this Transaction
+
+=cut
+sub count {
+ my $self = shift();
+
+ return scalar(@{ $self->queries() });
+}
+
+=head2 get_sorted_queries
+
+Returns all the queries in this Transaction, sorted by elapsed time. (descending)
+
+=cut
+sub get_sorted_queries {
+ my $self = shift();
+
+ return [ reverse sort { $a->time_elapsed() <=> $b->time_elapsed() } @{ $self->queries() } ];
+}
+
+=head1 AUTHOR
+
+Cory 'G' Watson, C<< <gphat at cpan.org> >>
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Cory 'G' Watson, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+1;
\ No newline at end of file
Added: DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog.pm
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog.pm (rev 0)
+++ DBIx-Class-QueryLog/1.0/trunk/lib/DBIx/Class/QueryLog.pm 2007-08-21 16:37:53 UTC (rev 3691)
@@ -0,0 +1,278 @@
+package DBIx::Class::QueryLog;
+
+use warnings;
+use strict;
+
+use base qw(Class::Accessor);
+__PACKAGE__->mk_accessors(qw(log current_transaction current_query));
+
+use Time::HiRes;
+
+use DBIx::Class::QueryLog::Query;
+use DBIx::Class::QueryLog::Transaction;
+
+=head1 NAME
+
+DBIx::Class::QueryLog - Log queries for later analysis.
+
+=head1 VERSION
+
+Version 0.03
+
+=cut
+
+our $VERSION = '0.03';
+
+=head1 SYNOPSIS
+
+DBIx::Class::QueryLog 'logs' each transaction and query executed so you can
+analyze what happened in the 'session'. It must be installed as the debugobj
+in DBIx::Class:
+
+ use DBIx::Class::QueryLog;
+
+ my $schema = ... # Get your schema!
+ my $ql = new DBIx::Class::QueryLog();
+ $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
+
+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.
+
+See L<DBIx::Class::QueryLog::Analyzer> for options on digesting the results
+of a QueryLog session.
+
+=head1 METHODS
+
+=head2 new
+
+Create a new DBIx::Class::QueryLog.
+
+=cut
+sub new {
+ my $proto = shift();
+ my $self = $proto->SUPER::new(@_);
+
+ $self->log([]);
+
+ return $self;
+}
+
+=head2 time_elapsed
+
+Returns the total time elapsed for ALL transactions and queries in this log.
+
+=cut
+sub time_elapsed {
+ my $self = shift();
+
+ my $total = 0;
+ foreach my $t (@{ $self->log() }) {
+ $total += $t->time_elapsed();
+ }
+
+ return $total;
+}
+
+=head2 count
+
+Returns the number of queries executed in this QueryLog
+
+=cut
+sub count {
+ my $self = shift();
+
+ my $total = 0;
+ foreach my $t (@{ $self->log() }) {
+ $total += $t->count();
+ }
+
+ return $total;
+}
+
+=head2 reset
+
+Reset this QueryLog by removing all transcations and queries.
+
+=cut
+sub reset {
+ my $self = shift();
+
+ $self->log(undef);
+}
+
+=head2 add_to_log
+
+Add this provided Transaction or Query to the log.
+
+=cut
+sub add_to_log {
+ my $self = shift();
+ my $thing = shift();
+
+ push(@{ $self->log() }, $thing);
+}
+
+=head2 txn_begin
+
+Called by DBIx::Class when a transaction is begun.
+
+=cut
+
+sub txn_begin {
+ my $self = shift();
+
+ $self->current_transaction(
+ new DBIx::Class::QueryLog::Transaction({
+ start_time => Time::HiRes::time()
+ })
+ );
+}
+
+=head2 txn_commit
+
+Called by DBIx::Class when a transaction is committed.
+
+=cut
+
+sub txn_commit {
+ 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.')
+ }
+}
+
+=head2 txn_rollback
+
+Called by DBIx::Class when a transaction is rolled back.
+
+=cut
+
+sub txn_rollback {
+ 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.')
+ }
+}
+
+=head2 query_start
+
+Called by DBIx::Class when a query is begun.
+
+=cut
+
+sub query_start {
+ 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,
+ })
+ );
+}
+
+=head2 query_end
+
+Called by DBIx::Class when a query is completed.
+
+=cut
+
+sub query_end {
+ 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.');
+ }
+}
+
+=head1 AUTHOR
+
+Cory 'G' Watson, C<< <gphat at cpan.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-dbix-class-querylog at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=DBIx-Class-QueryLog>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc DBIx::Class::QueryLog
+
+You can also look for information at:
+
+=over 4
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/DBIx-Class-QueryLog>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/DBIx-Class-QueryLog>
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=DBIx-Class-QueryLog>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/DBIx-Class-QueryLog>
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Cory 'G' Watson, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of DBIx::Class::QueryLog
Added: DBIx-Class-QueryLog/1.0/trunk/t/00-load.t
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/t/00-load.t (rev 0)
+++ DBIx-Class-QueryLog/1.0/trunk/t/00-load.t 2007-08-21 16:37:53 UTC (rev 3691)
@@ -0,0 +1,9 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'DBIx::Class::QueryLog' );
+}
+
+diag( "Testing DBIx::Class::QueryLog $DBIx::Class::QueryLog::VERSION, Perl $], $^X" );
Added: DBIx-Class-QueryLog/1.0/trunk/t/01-quickies.t
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/t/01-quickies.t (rev 0)
+++ DBIx-Class-QueryLog/1.0/trunk/t/01-quickies.t 2007-08-21 16:37:53 UTC (rev 3691)
@@ -0,0 +1,40 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 10;
+
+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');
+
+$ql->query_start('SELECT * from foo');
+$ql->query_end('SELECT * from foo');
+ok(scalar(@{ $ql->log() }) == 1, 'log count w/1 query');
+
+$ql->txn_begin();
+$ql->query_start('SELECT * from foo');
+$ql->query_end('SELECT * from foo');
+$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($log->[1]->committed, 'Committed txn');
+ok(!$log->[1]->rolledback, '! Rolled back txn');
+
+$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();
+
+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');
\ No newline at end of file
Added: DBIx-Class-QueryLog/1.0/trunk/t/02-analyzer.t
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/t/02-analyzer.t (rev 0)
+++ DBIx-Class-QueryLog/1.0/trunk/t/02-analyzer.t 2007-08-21 16:37:53 UTC (rev 3691)
@@ -0,0 +1,50 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 14;
+
+BEGIN {
+ use_ok('DBIx::Class::QueryLog');
+ use_ok('DBIx::Class::QueryLog::Analyzer');
+}
+require_ok('DBIx::Class::QueryLog::Analyzer');
+
+my $ql = new DBIx::Class::QueryLog();
+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');
+
+$ql->txn_begin();
+$ql->query_start('SELECT * from foo');
+$ql->query_end('SELECT * from foo');
+
+$ql->query_start('SELECT * from bar');
+sleep(1);
+$ql->query_end('SELECT * from bar');
+
+$ql->txn_commit();
+
+my $ana = new DBIx::Class::QueryLog::Analyzer({
+ querylog => $ql
+});
+isa_ok($ana, 'DBIx::Class::QueryLog::Analyzer');
+isa_ok($ana->querylog(), 'DBIx::Class::QueryLog');
+
+cmp_ok(scalar(@{ $ana->get_sorted_queries() }), '==', 3, 'Sorted Count');
+
+my $analyzed = $ana->get_totaled_queries();
+my @keys = reverse sort {
+ $analyzed->{$a}->{'time_elapsed'} <=> $analyzed->{$b}->{'time_elapsed'}
+ } keys(%{ $ana->get_totaled_queries() });
+cmp_ok(scalar(@keys), '==', 2, '2 different queries');
+
+cmp_ok($analyzed->{$keys[0]}->{'count'}, '==', 1, '1 executions');
+
+cmp_ok($analyzed->{$keys[1]}->{'count'}, '==', 2, '2 executions');
+
+ok($analyzed->{$keys[0]}->{'time_elapsed'}, 'Total time');
+cmp_ok(scalar(@{$analyzed->{$keys[0]}->{'queries'}}), '==', 1, '1 stored queries');
+cmp_ok(scalar(@{$analyzed->{$keys[1]}->{'queries'}}), '==', 2, '2 stored queries');
\ No newline at end of file
Added: DBIx-Class-QueryLog/1.0/trunk/t/pod-coverage.t
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/t/pod-coverage.t (rev 0)
+++ DBIx-Class-QueryLog/1.0/trunk/t/pod-coverage.t 2007-08-21 16:37:53 UTC (rev 3691)
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
Added: DBIx-Class-QueryLog/1.0/trunk/t/pod.t
===================================================================
--- DBIx-Class-QueryLog/1.0/trunk/t/pod.t (rev 0)
+++ DBIx-Class-QueryLog/1.0/trunk/t/pod.t 2007-08-21 16:37:53 UTC (rev 3691)
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
More information about the Bast-commits
mailing list