From: Peter Rabbitson <ribasushi@cpan.org>
Date: Tue, 8 Jul 2014 00:05:04 +0000 (+0200)
Subject: Switch DBIC::Storage::Statistics to Moo (for trial purposes)
X-Git-Tag: v0.082800~152
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=68b8ba54e535ba5e68e044b3bedec73b20500b72;p=dbsrgits%2FDBIx-Class.git

Switch DBIC::Storage::Statistics to Moo (for trial purposes)

This is a component which has some subclassing in the wild, use it as a
canary to highlight any remaining issues Moo might have within DBIC
---

diff --git a/lib/DBIx/Class/Storage/Statistics.pm b/lib/DBIx/Class/Storage/Statistics.pm
index ec47c54..0248936 100644
--- a/lib/DBIx/Class/Storage/Statistics.pm
+++ b/lib/DBIx/Class/Storage/Statistics.pm
@@ -2,12 +2,22 @@ package DBIx::Class::Storage::Statistics;
 use strict;
 use warnings;
 
-use base qw/DBIx::Class/;
+# DO NOT edit away without talking to riba first, he will just put it back
+# BEGIN pre-Moo2 import block
+BEGIN {
+  require warnings;
+  my $initial_fatal_bits = (${^WARNING_BITS}||'') & $warnings::DeadBits{all};
+  local $ENV{PERL_STRICTURES_EXTRA} = 0;
+  require Moo; Moo->import;
+  require Sub::Quote; Sub::Quote->import('quote_sub');
+  ${^WARNING_BITS} &= ( $initial_fatal_bits | ~ $warnings::DeadBits{all} );
+}
+# END pre-Moo2 import block
+
+extends 'DBIx::Class';
 use DBIx::Class::_Util 'sigwarn_silencer';
 use namespace::clean;
 
-__PACKAGE__->mk_group_accessors(simple => qw/callback _debugfh _defaulted_to_stderr silence/);
-
 =head1 NAME
 
 DBIx::Class::Storage::Statistics - SQL Statistics
@@ -26,20 +36,10 @@ for collecting the statistics as discussed in L<DBIx::Class::Manual::Cookbook>.
 
 =head1 METHODS
 
-=cut
-
 =head2 new
 
 Returns a new L<DBIx::Class::Storage::Statistics> object.
 
-=cut
-sub new {
-  my $self = {};
-  bless $self, (ref($_[0]) || $_[0]);
-
-  return $self;
-}
-
 =head2 debugfh
 
 Sets or retrieves the filehandle used for trace/debug output.  This should
@@ -51,31 +51,45 @@ As getter it will lazily open a filehandle for you if one is not already set.
 
 =cut
 
+# FIXME - there ought to be a way to fold this into _debugfh itself
+# having the undef re-trigger the builder (or better yet a default
+# which can be folded in as a qsub)
 sub debugfh {
   my $self = shift;
 
-  if (@_) {
-    $self->_debugfh($_[0]);
-    $self->_defaulted_to_stderr(undef);
-  } elsif (!defined($self->_debugfh())) {
-    my $fh;
-    my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
-                  || $ENV{DBIC_TRACE};
-    if (defined($debug_env) && ($debug_env =~ /=(.+)$/)) {
-      open ($fh, '>>', $1)
-        or die("Cannot open trace file $1: $!");
-    } else {
-      open ($fh, '>&STDERR')
-        or die("Duplication of STDERR for debug output failed (perhaps your STDERR is closed?): $!");
-      $self->_defaulted_to_stderr(1);
-    }
-
-    $self->_debugfh($fh);
+  return $self->_debugfh(@_) if @_;
+  $self->_debugfh || $self->_build_debugfh;
+}
+
+has _debugfh => (
+  is => 'rw',
+  lazy => 1,
+  trigger => quote_sub( '$_[0]->_defaulted_to_stderr(undef)' ),
+  builder => '_build_debugfh',
+);
+
+sub _build_debugfh {
+  my $fh;
+
+  my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} || $ENV{DBIC_TRACE};
+
+  if (defined($debug_env) and ($debug_env =~ /=(.+)$/)) {
+    open ($fh, '>>', $1)
+      or die("Cannot open trace file $1: $!\n");
+  }
+  else {
+    open ($fh, '>&STDERR')
+      or die("Duplication of STDERR for debug output failed (perhaps your STDERR is closed?): $!\n");
+    $_[0]->_defaulted_to_stderr(1);
   }
 
-  $self->_debugfh;
+  $fh;
 }
 
+has [qw(_defaulted_to_stderr silence callback)] => (
+  is => 'rw',
+);
+
 =head2 print
 
 Prints the specified string to our debugging filehandle.  Provided to save our
diff --git a/t/storage/debug.t b/t/storage/debug.t
index ffcb21f..f28d4b5 100644
--- a/t/storage/debug.t
+++ b/t/storage/debug.t
@@ -55,9 +55,11 @@ END {
 
 open(STDERRCOPY, '>&STDERR');
 
+my $exception_line_number;
 # STDERR will be closed, no T::B diag in blocks
 my $exception = try {
   close(STDERR);
+  $exception_line_number = __LINE__ + 1;  # important for test, do not reformat
   $schema->resultset('CD')->search({})->count;
 } catch {
   $_
@@ -66,7 +68,11 @@ my $exception = try {
   open(STDERR, '>&STDERRCOPY');
 };
 
-like $exception, qr/\QDuplication of STDERR for debug output failed (perhaps your STDERR is closed?)/;
+like $exception, qr/
+  \QDuplication of STDERR for debug output failed (perhaps your STDERR is closed?)\E
+    .+
+  \Qat @{[__FILE__]} line $exception_line_number\E$
+/xms;
 
 my @warnings;
 $exception = try {