From: Peter Rabbitson Date: Tue, 8 Jul 2014 00:05:04 +0000 (+0200) Subject: Switch DBIC::Storage::Statistics to Moo (for trial purposes) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=68b8ba54;p=dbsrgits%2FDBIx-Class-Historic.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. =head1 METHODS -=cut - =head2 new Returns a new L 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 {