From: Peter Rabbitson <ribasushi@cpan.org>
Date: Mon, 7 Jul 2014 22:57:20 +0000 (+0200)
Subject: IFF debug goes to STDERR by default - silence possible wide-char warnings
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9d522a4e02ee0bc2278f69605ccfea6b046e9b40;p=dbsrgits%2FDBIx-Class-Historic.git

IFF debug goes to STDERR by default - silence possible wide-char warnings
---

diff --git a/Changes b/Changes
index 57e6135..5284c01 100644
--- a/Changes
+++ b/Changes
@@ -36,6 +36,8 @@ Revision history for DBIx::Class
           savepoints on DBD::SQLite < 1.39
 
     * Misc
+        - IFF DBIC_TRACE output defaults to STDERR we now silence the possible
+          wide-char warnings if the trace happens to contain unicode
         - Stop explicitly stringifying objects before passing them to DBI,
           instead assume that the DBI/DBD combo will take care of things
         - Remove ::ResultSource::resolve_condition - the underlying machinery
diff --git a/lib/DBIx/Class/Storage/Statistics.pm b/lib/DBIx/Class/Storage/Statistics.pm
index 1ee5299..ec47c54 100644
--- a/lib/DBIx/Class/Storage/Statistics.pm
+++ b/lib/DBIx/Class/Storage/Statistics.pm
@@ -3,9 +3,10 @@ use strict;
 use warnings;
 
 use base qw/DBIx::Class/;
+use DBIx::Class::_Util 'sigwarn_silencer';
 use namespace::clean;
 
-__PACKAGE__->mk_group_accessors(simple => qw/callback _debugfh silence/);
+__PACKAGE__->mk_group_accessors(simple => qw/callback _debugfh _defaulted_to_stderr silence/);
 
 =head1 NAME
 
@@ -55,6 +56,7 @@ sub debugfh {
 
   if (@_) {
     $self->_debugfh($_[0]);
+    $self->_defaulted_to_stderr(undef);
   } elsif (!defined($self->_debugfh())) {
     my $fh;
     my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
@@ -65,6 +67,7 @@ sub debugfh {
     } 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);
@@ -84,7 +87,13 @@ sub print {
 
   return if $self->silence;
 
-  $self->debugfh->printflush($msg);
+  my $fh = $self->debugfh;
+
+  # not using 'no warnings' here because all of this can change at runtime
+  local $SIG{__WARN__} = sigwarn_silencer(qr/^Wide character in print/)
+    if $self->_defaulted_to_stderr;
+
+  $fh->printflush($msg);
 }
 
 =head2 silence
diff --git a/t/storage/debug.t b/t/storage/debug.t
index 77f7e42..ffcb21f 100644
--- a/t/storage/debug.t
+++ b/t/storage/debug.t
@@ -5,6 +5,7 @@ no warnings 'once';
 use Test::More;
 use Test::Exception;
 use Try::Tiny;
+use File::Spec;
 use lib qw(t/lib);
 use DBICTest;
 use Path::Class qw/file/;
@@ -67,6 +68,25 @@ my $exception = try {
 
 like $exception, qr/\QDuplication of STDERR for debug output failed (perhaps your STDERR is closed?)/;
 
+my @warnings;
+$exception = try {
+  local $SIG{__WARN__} = sub { push @warnings, @_ if $_[0] =~ /character/i };
+  close STDERR;
+  open(STDERR, '>', File::Spec->devnull) or die $!;
+  $schema->resultset('CD')->search({ title => "\x{1f4a9}" })->count;
+  '';
+} catch {
+  $_;
+} finally {
+  # restore STDERR
+  close STDERR;
+  open(STDERR, '>&STDERRCOPY');
+};
+
+die "How did that fail... $exception"
+  if $exception;
+
+is_deeply(\@warnings, [], 'No warnings with unicode on STDERR');
 
 
 # test debugcb and debugobj protocol