From: Cory G Watson <gphat@cpan.org>
Date: Tue, 7 Aug 2007 13:07:06 +0000 (+0000)
Subject: Refactor Statistics to clean up printing of debug info and to avoid crashing on
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=70f3927877ba6b7aac2565bc1933daaf82361308;p=dbsrgits%2FDBIx-Class-Historic.git

Refactor Statistics to clean up printing of debug info and to avoid crashing on
a closed STDERR...
---

diff --git a/Changes b/Changes
index 787c0d6..d04a54d 100644
--- a/Changes
+++ b/Changes
@@ -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)
diff --git a/lib/DBIx/Class/Manual/Cookbook.pod b/lib/DBIx/Class/Manual/Cookbook.pod
index bb33261..fbe9e0a 100644
--- a/lib/DBIx/Class/Manual/Cookbook.pod
+++ b/lib/DBIx/Class/Manual/Cookbook.pod
@@ -964,7 +964,7 @@ mechanism:
     my $sql = shift();
     my $params = @_;
 
-    print "Executing $sql: ".join(', ', @params)."\n";
+    $self->print("Executing $sql: ".join(', ', @params)."\n");
     $start = time();
   }
 
@@ -973,7 +973,8 @@ mechanism:
     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 @@ mechanism:
 
 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 @@ array:
 
 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
 
diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm
index 6966e5b..8b86e7a 100644
--- a/lib/DBIx/Class/Schema/Versioned.pm
+++ b/lib/DBIx/Class/Schema/Versioned.pm
@@ -205,9 +205,9 @@ sub run_upgrade
 
     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;
diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm
index f590b36..a1c551e 100644
--- a/lib/DBIx/Class/Storage.pm
+++ b/lib/DBIx/Class/Storage.pm
@@ -61,20 +61,11 @@ sub new {
   $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;
diff --git a/lib/DBIx/Class/Storage/Statistics.pm b/lib/DBIx/Class/Storage/Statistics.pm
index 5d0ba47..e94203e 100644
--- a/lib/DBIx/Class/Storage/Statistics.pm
+++ b/lib/DBIx/Class/Storage/Statistics.pm
@@ -45,6 +45,35 @@ be an IO::Handle compatible object (only the C<print> method is used). Initially
 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 @@ Called when a transaction begins.
 sub txn_begin {
   my $self = shift;
 
-  $self->debugfh->print("BEGIN WORK\n");
+  $self->print("BEGIN WORK\n");
 }
 
 =head2 txn_rollback
@@ -64,7 +93,7 @@ Called when a transaction is rolled back.
 sub txn_rollback {
   my $self = shift;
 
-  $self->debugfh->print("ROLLBACK\n");
+  $self->print("ROLLBACK\n");
 }
 
 =head2 txn_commit
@@ -75,7 +104,7 @@ Called when a transaction is committed.
 sub txn_commit {
   my $self = shift;
 
-  $self->debugfh->print("COMMIT\n");
+  $self->print("COMMIT\n");
 }
 
 =head2 query_start
@@ -95,7 +124,7 @@ sub query_start {
     return;
   }
 
-  $self->debugfh->print($message);
+  $self->print($message);
 }
 
 =head2 query_end
diff --git a/t/91debug.t b/t/91debug.t
index 4f9d1d9..2ea1016 100644
--- a/t/91debug.t
+++ b/t/91debug.t
@@ -7,7 +7,7 @@ use DBICTest;
 
 my $schema = DBICTest->init_schema();
 
-plan tests => 2;
+plan tests => 5;
 
 ok ( $schema->storage->debug(1), 'debug' );
 ok ( defined(
@@ -18,4 +18,33 @@ ok ( defined(
      '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;