[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