[Bast-commits] r3652 - in DBIx-Class/0.08/trunk: . lib/DBIx/Class
lib/DBIx/Class/Manual lib/DBIx/Class/Schema lib/DBIx/Class/Storage t
gphat at dev.catalyst.perl.org
gphat at dev.catalyst.perl.org
Tue Aug 7 14:07:07 GMT 2007
Author: gphat
Date: 2007-08-07 14:07:06 +0100 (Tue, 07 Aug 2007)
New Revision: 3652
Modified:
DBIx-Class/0.08/trunk/Changes
DBIx-Class/0.08/trunk/lib/DBIx/Class/Manual/Cookbook.pod
DBIx-Class/0.08/trunk/lib/DBIx/Class/Schema/Versioned.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/Statistics.pm
DBIx-Class/0.08/trunk/t/91debug.t
Log:
Refactor Statistics to clean up printing of debug info and to avoid crashing on
a closed STDERR...
Modified: DBIx-Class/0.08/trunk/Changes
===================================================================
--- DBIx-Class/0.08/trunk/Changes 2007-08-06 19:36:27 UTC (rev 3651)
+++ DBIx-Class/0.08/trunk/Changes 2007-08-07 13:07:06 UTC (rev 3652)
@@ -1,5 +1,9 @@
Revision history for DBIx::Class
+ - refactor Statistics to create debugging filehandle to fix bug with
+ closed STDERR, update docs and modify Versioned to use Statistics
+ (original fix from diz)
+
0.08004 2007-08-06 19:00:00
- fix storage connect code to not trigger bug via auto-viv
(test from aherzog)
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Manual/Cookbook.pod
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Manual/Cookbook.pod 2007-08-06 19:36:27 UTC (rev 3651)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Manual/Cookbook.pod 2007-08-07 13:07:06 UTC (rev 3652)
@@ -964,7 +964,7 @@
my $sql = shift();
my $params = @_;
- print "Executing $sql: ".join(', ', @params)."\n";
+ $self->print("Executing $sql: ".join(', ', @params)."\n");
$start = time();
}
@@ -973,7 +973,8 @@
my $sql = shift();
my @params = @_;
- printf("Execution took %0.4f seconds.\n", time() - $start);
+ my $elapsed = sprintf("%0.4f", time() - $start);
+ $self->print("Execution took $elapsed seconds.\n");
$start = undef;
}
@@ -981,8 +982,8 @@
You can then install that class as the debugging object:
- __PACKAGE__->storage()->debugobj(new My::Profiler());
- __PACKAGE__->storage()->debug(1);
+ __PACKAGE__->storage->debugobj(new My::Profiler());
+ __PACKAGE__->storage->debug(1);
A more complicated example might involve storing each execution of SQL in an
array:
@@ -1001,6 +1002,7 @@
You could then create average, high and low execution times for an SQL
statement and dig down to see if certain parameters cause aberrant behavior.
+You might want to check out L<DBIx::Class::QueryLog> as well.
=head2 Getting the value of the primary key for the last database insert
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Schema/Versioned.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Schema/Versioned.pm 2007-08-06 19:36:27 UTC (rev 3651)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Schema/Versioned.pm 2007-08-07 13:07:06 UTC (rev 3652)
@@ -205,9 +205,9 @@
for (@statements)
{
- $self->storage->debugfh->print("$_\n") if $self->storage->debug;
-# print "Running \n>>$_<<\n";
+ $self->storage->debugobj->query_start($_) if $self->storage->debug;
$self->storage->dbh->do($_) or warn "SQL was:\n $_";
+ $self->storage->debugobj->query_end($_) if $self->storage->debug;
}
return 1;
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/Statistics.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/Statistics.pm 2007-08-06 19:36:27 UTC (rev 3651)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/Statistics.pm 2007-08-07 13:07:06 UTC (rev 3652)
@@ -45,6 +45,35 @@
should be set to STDERR - although see information on the
L<DBIC_TRACE> environment variable.
+=head2 print
+
+Prints the specified string to our debugging filehandle, which we will attempt
+to open if we haven't yet. Provided to save our methods the worry of how
+to display the message.
+
+=cut
+sub print {
+ my ($self, $msg) = @_;
+
+ if(!defined($self->debugfh())) {
+ my $fh;
+ my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
+ || $ENV{DBIC_TRACE};
+ if (defined($debug_env) && ($debug_env =~ /=(.+)$/)) {
+ $fh = IO::File->new($1, 'w')
+ or die("Cannot open trace file $1");
+ } else {
+ $fh = IO::File->new('>&STDERR')
+ or die('Duplication of STDERR for debug output failed (perhaps your STDERR is closed?)');
+ }
+
+ $fh->autoflush();
+ $self->debugfh($fh);
+ }
+
+ $self->debugfh->print($msg);
+}
+
=head2 txn_begin
Called when a transaction begins.
@@ -53,7 +82,7 @@
sub txn_begin {
my $self = shift;
- $self->debugfh->print("BEGIN WORK\n");
+ $self->print("BEGIN WORK\n");
}
=head2 txn_rollback
@@ -64,7 +93,7 @@
sub txn_rollback {
my $self = shift;
- $self->debugfh->print("ROLLBACK\n");
+ $self->print("ROLLBACK\n");
}
=head2 txn_commit
@@ -75,7 +104,7 @@
sub txn_commit {
my $self = shift;
- $self->debugfh->print("COMMIT\n");
+ $self->print("COMMIT\n");
}
=head2 query_start
@@ -95,7 +124,7 @@
return;
}
- $self->debugfh->print($message);
+ $self->print($message);
}
=head2 query_end
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage.pm 2007-08-06 19:36:27 UTC (rev 3651)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage.pm 2007-08-07 13:07:06 UTC (rev 3652)
@@ -61,20 +61,11 @@
$new->set_schema($schema);
$new->debugobj(new DBIx::Class::Storage::Statistics());
- my $fh;
+ #my $fh;
my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
|| $ENV{DBIC_TRACE};
- if (defined($debug_env) && ($debug_env =~ /=(.+)$/)) {
- $fh = IO::File->new($1, 'w')
- or $new->throw_exception("Cannot open trace file $1");
- } else {
- $fh = IO::File->new('>&STDERR');
- }
-
- $fh->autoflush(1);
- $new->debugfh($fh);
$new->debug(1) if $debug_env;
$new;
Modified: DBIx-Class/0.08/trunk/t/91debug.t
===================================================================
--- DBIx-Class/0.08/trunk/t/91debug.t 2007-08-06 19:36:27 UTC (rev 3651)
+++ DBIx-Class/0.08/trunk/t/91debug.t 2007-08-07 13:07:06 UTC (rev 3652)
@@ -7,7 +7,7 @@
my $schema = DBICTest->init_schema();
-plan tests => 2;
+plan tests => 5;
ok ( $schema->storage->debug(1), 'debug' );
ok ( defined(
@@ -18,4 +18,33 @@
'debugfh'
);
+my $rs = $schema->resultset('CD')->search({});
+$rs->count();
+
+my $log = new IO::File('t/var/sql.log', 'r') or die($!);
+my $line = <$log>;
+$log->close();
+ok($line =~ /^SELECT COUNT/, 'Log success');
+
+$schema->storage->debugfh(undef);
+$ENV{'DBIC_TRACE'} = '=t/var/foo.log';
+$rs = $schema->resultset('CD')->search({});
+$rs->count();
+$log = new IO::File('t/var/foo.log', 'r') or die($!);
+$line = <$log>;
+$log->close();
+ok($line =~ /^SELECT COUNT/, 'Log success');
+
+$schema->storage->debugobj->debugfh(undef);
+delete($ENV{'DBIC_TRACE'});
+open(STDERRCOPY, '>&STDERR');
+stat(STDERRCOPY); # nop to get warnings quiet
+close(STDERR);
+eval {
+ $rs = $schema->resultset('CD')->search({});
+ $rs->count();
+};
+ok($@, 'Died on closed FH');
+open(STDERR, '>&STDERRCOPY');
+
1;
More information about the Bast-commits
mailing list