From: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
Date: Tue, 22 Oct 2013 00:05:21 +0000 (+0100)
Subject: Use sigwarn_silencer() everywhere appropriate
X-Git-Tag: 0.07036_03~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ff4b0152ac81e80600a8d52a30a56538c563f2c4;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

Use sigwarn_silencer() everywhere appropriate
---

diff --git a/lib/DBIx/Class/Schema/Loader/DBI/ADO/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Schema/Loader/DBI/ADO/Microsoft_SQL_Server.pm
index 0348a25..8ff60e2 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/ADO/Microsoft_SQL_Server.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/ADO/Microsoft_SQL_Server.pm
@@ -7,6 +7,9 @@ use base qw/
     DBIx::Class::Schema::Loader::DBI::MSSQL
 /;
 use mro 'c3';
+use DBIx::Class::Schema::Loader::Utils qw/sigwarn_silencer/;
+
+use namespace::clean;
 
 our $VERSION = '0.07036_02';
 
@@ -26,10 +29,7 @@ See L<DBIx::Class::Schema::Loader::Base> for usage information.
 # Silence ADO "Changed database context" warnings
 sub _switch_db {
     my $self = shift;
-    my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
-    local $SIG{__WARN__} = sub {
-        $warn_handler->(@_) unless $_[0] =~ /Changed database context/;
-    };
+    local $SIG{__WARN__} = sigwarn_silencer(qr/Changed database context/);
     return $self->next::method(@_);
 }
 
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm b/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
index 29b791e..72d41c4 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
@@ -5,6 +5,7 @@ use warnings;
 use base 'DBIx::Class::Schema::Loader::DBI::Component::QuotedDefault';
 use mro 'c3';
 use Try::Tiny;
+use DBIx::Class::Schema::Loader::Utils qw/sigwarn_silencer/;
 use namespace::clean;
 
 our $VERSION = '0.07036_02';
@@ -69,11 +70,9 @@ sub _filter_tables {
     my $self = shift;
 
     # silence a warning from older DBD::Oracles in tests
-    my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
-    local $SIG{__WARN__} = sub {
-        $warn_handler->(@_)
-        unless $_[0] =~ /^Field \d+ has an Oracle type \(\d+\) which is not explicitly supported/;
-    };
+    local $SIG{__WARN__} = sigwarn_silencer(
+        qr/^Field \d+ has an Oracle type \(\d+\) which is not explicitly supported/
+    );
 
     return $self->next::method(@_);
 }
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
index adc2fba..5372d07 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
@@ -9,6 +9,7 @@ use List::Util 'first';
 use List::MoreUtils 'any';
 use Try::Tiny;
 use Scalar::Util 'blessed';
+use DBIx::Class::Schema::Loader::Utils qw/sigwarn_silencer/;
 use namespace::clean;
 use DBIx::Class::Schema::Loader::Table ();
 
@@ -321,8 +322,9 @@ sub _extra_column_info {
 sub _dbh_column_info {
     my $self = shift;
 
-    local $SIG{__WARN__} = sub { warn @_
-        unless $_[0] =~ /^column_info: unrecognized column type/ };
+    local $SIG{__WARN__} = sigwarn_silencer(
+        qr/^column_info: unrecognized column type/
+    );
 
     $self->next::method(@_);
 }
diff --git a/t/10_06sybase_common.t b/t/10_06sybase_common.t
index fe110f6..645fc6c 100644
--- a/t/10_06sybase_common.t
+++ b/t/10_06sybase_common.t
@@ -5,6 +5,7 @@ use Test::Exception;
 use Try::Tiny;
 use File::Path 'rmtree';
 use DBIx::Class::Schema::Loader 'make_schema_at';
+use DBIx::Class::Schema::Loader::Utils qw/sigwarn_silencer/;
 use namespace::clean;
 use DBI ();
 
@@ -131,11 +132,9 @@ my $tester = dbixcsl_common_tests->new(
                 };
 
                 try {
-                    my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
-                    local $SIG{__WARN__} = sub {
-                        $warn_handler->(@_)
-                            unless $_[0] =~ /^Password correctly set\.$|^Account unlocked\.$|^New login created\.$|^New user added\.$/;
-                    };
+                    local $SIG{__WARN__} = sigwarn_silencer(
+                        qr/^Password correctly set\.$|^Account unlocked\.$|^New login created\.$|^New user added\.$/
+                    );
 
                     $dbh->do("sp_addlogin dbicsl_user1, dbicsl, [dbicsl_test1]");
                     $dbh->do("sp_addlogin dbicsl_user2, dbicsl, [dbicsl_test2]");
@@ -158,11 +157,9 @@ my $tester = dbixcsl_common_tests->new(
 
                 my ($dbh1, $dbh2);
                 {
-                    my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
-                    local $SIG{__WARN__} = sub {
-                        $warn_handler->(@_) unless $_[0] =~ /can't change context/;
-                    };
-
+                    local $SIG{__WARN__} = sigwarn_silencer(
+                        qr/can't change context/
+                    );
                     $dbh1 = DBI->connect($dsn, 'dbicsl_user1', 'dbicsl', {
                         RaiseError => 1,
                         PrintError => 0,
@@ -446,11 +443,9 @@ END {
 
             foreach my $login (qw/dbicsl_user1 dbicsl_user2/) {
                 try {
-                    my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
-                    local $SIG{__WARN__} = sub {
-                        $warn_handler->(@_)
-                            unless $_[0] =~ /^Account locked\.$|^Login dropped\.$/;
-                    };
+                    local $SIG{__WARN__} = sigwarn_silencer(
+                        qr/^Account locked\.$|^Login dropped\.$/
+                    );
 
                     $dbh->do("sp_droplogin $login");
                 }
diff --git a/t/10_07mssql_common.t b/t/10_07mssql_common.t
index 6382fc6..4a84e69 100644
--- a/t/10_07mssql_common.t
+++ b/t/10_07mssql_common.t
@@ -2,7 +2,7 @@ use strict;
 use warnings;
 use Test::More;
 use Test::Exception;
-use DBIx::Class::Schema::Loader::Utils 'warnings_exist_silent';
+use DBIx::Class::Schema::Loader::Utils qw/warnings_exist_silent sigwarn_silencer/;
 use Try::Tiny;
 use File::Path 'rmtree';
 use DBIx::Class::Schema::Loader 'make_schema_at';
@@ -527,10 +527,9 @@ EOF
 
             SKIP: {
                 # for ADO
-                my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
-                local $SIG{__WARN__} = sub {
-                    $warn_handler->(@_) unless $_[0] =~ /Changed database context/;
-                };
+                local $SIG{__WARN__} = sigwarn_silencer(
+                    qr/Changed database context/
+                );
 
                 my $dbh = $schema->storage->dbh;
 
@@ -758,10 +757,9 @@ sub cleanup_databases {
     return if $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP};
 
     # for ADO
-    my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
-    local $SIG{__WARN__} = sub {
-        $warn_handler->(@_) unless $_[0] =~ /Changed database context/;
-    };
+    local $SIG{__WARN__} = sigwarn_silencer(
+        qr/Changed database context/
+    );
 
     my $dbh = $schema->storage->dbh;
 
diff --git a/t/10_09firebird_common.t b/t/10_09firebird_common.t
index 39fc849..cedd461 100644
--- a/t/10_09firebird_common.t
+++ b/t/10_09firebird_common.t
@@ -2,6 +2,7 @@ use strict;
 use warnings;
 use Test::More;
 use Scope::Guard ();
+use DBIx::Class::Schema::Loader::Utils qw/sigwarn_silencer/;
 use lib qw(t/lib);
 use dbixcsl_common_tests;
 
@@ -207,8 +208,9 @@ if (not ($dbd_firebird_dsn || $dbd_interbase_dsn || $odbc_dsn)) {
 else {
     # get rid of stupid warning from InterBase/GetInfo.pm
     if ($dbd_interbase_dsn) {
-        local $SIG{__WARN__} = sub { warn @_
-            unless $_[0] =~ m{^Use of uninitialized value in sprintf at \S+DBD/InterBase/GetInfo\.pm line \d+\.$|^Missing argument in sprintf at \S+DBD/InterBase/GetInfo.pm line \d+\.$} };
+        local $SIG{__WARN__} = sigwarn_silencer(
+            qr{^Use of uninitialized value in sprintf at \S+DBD/InterBase/GetInfo\.pm line \d+\.$|^Missing argument in sprintf at \S+DBD/InterBase/GetInfo.pm line \d+\.$}
+        );
         require DBD::InterBase;
         require DBD::InterBase::GetInfo;
     }
diff --git a/t/20invocations.t b/t/20invocations.t
index 059eda1..f282d86 100644
--- a/t/20invocations.t
+++ b/t/20invocations.t
@@ -2,6 +2,7 @@ use strict;
 use Test::More;
 use Test::Warn;
 use DBIx::Class::Schema::Loader::Optional::Dependencies;
+use DBIx::Class::Schema::Loader::Utils qw/sigwarn_silencer/;
 use lib qw(t/lib);
 use make_dbictest_db;
 
@@ -173,9 +174,9 @@ while(@invocations) {
     my $cref = shift @invocations;
 
     my $schema = do {
-      local $SIG{__WARN__} = sub {
-        warn $_[0] unless $_[0] =~ /Deleting existing file .+ due to 'really_erase_my_files' setting/
-      };
+      local $SIG{__WARN__} = sigwarn_silencer(
+        qr/Deleting existing file .+ due to 'really_erase_my_files' setting/
+      );
       $cref->();
     };
 
diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index 9c92e07..037a805 100644
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -12,7 +12,7 @@ use DBI;
 use Digest::MD5;
 use File::Find 'find';
 use Class::Unload ();
-use DBIx::Class::Schema::Loader::Utils qw/dumper_squashed slurp_file/;
+use DBIx::Class::Schema::Loader::Utils qw/dumper_squashed slurp_file sigwarn_silencer/;
 use List::MoreUtils 'apply';
 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
 use Try::Tiny;
@@ -1094,7 +1094,7 @@ qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
 
         # relname is preserved when another fk is added
         {
-            local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /invalidates \d+ active statement/ };
+            local $SIG{__WARN__} = sigwarn_silencer(qr/invalidates \d+ active statement/);
             $conn->storage->disconnect; # for mssql and access
         }
 
@@ -1264,12 +1264,10 @@ TODO: {
 
         my $guard = $conn->txn_scope_guard;
 
-        my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
-        local $SIG{__WARN__} = sub {
-            $warn_handler->(@_)
-                unless $_[0] =~ RESCAN_WARNINGS
-                    || $_[0] =~ /commit ineffective with AutoCommit enabled/; # FIXME
-        };
+        my $rescan_warnings = RESCAN_WARNINGS;
+        local $SIG{__WARN__} = sigwarn_silencer(
+            qr/$rescan_warnings|commit ineffective with AutoCommit enabled/ # FIXME
+        );
 
         my $schema_from = DBIx::Class::Schema::Loader::make_schema_at(
             "TestSchemaFromAnother", \%opts, [ sub { $conn->storage->dbh } ]
@@ -2307,7 +2305,7 @@ sub setup_data_type_tests {
 sub rescan_without_warnings {
     my ($self, $conn) = @_;
 
-    local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ RESCAN_WARNINGS };
+    local $SIG{__WARN__} = sigwarn_silencer(RESCAN_WARNINGS);
     return $conn->rescan;
 }