From: Henry Van Styn <vanstyn@intellitree.com>
Date: Tue, 16 Jan 2018 18:12:13 +0000 (-0500)
Subject: Fix use of merge() to work with newer Hash::Merge
X-Git-Tag: 0.07048~3
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7ba9582abe39fb8ffc961c2ddd2bf3df8dc263f4;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

Fix use of merge() to work with newer Hash::Merge

Fix provided by @ribasushi -- recent versions of Hash::Merge involved
breaking changes due to different default clone behavior. Update call to
merge() to set explicit options to get back to the original behavior
(and still work with older versions of Hash::Merge)
---

diff --git a/lib/DBIx/Class/Schema/Loader.pm b/lib/DBIx/Class/Schema/Loader.pm
index 97050bc..9d67414 100644
--- a/lib/DBIx/Class/Schema/Loader.pm
+++ b/lib/DBIx/Class/Schema/Loader.pm
@@ -8,9 +8,8 @@ use mro 'c3';
 use Carp::Clan qw/^DBIx::Class/;
 use Scalar::Util 'weaken';
 use Sub::Util 'set_subname';
-use DBIx::Class::Schema::Loader::Utils 'array_eq';
+use DBIx::Class::Schema::Loader::Utils qw/array_eq sigwarn_silencer/;
 use Try::Tiny;
-use Hash::Merge 'merge';
 use curry;
 use namespace::clean;
 
@@ -233,13 +232,28 @@ sub _merge_state_from {
 
     $self->_copy_state_from($from);
 
-    $self->class_mappings(merge($orig_class_mappings, $self->class_mappings))
+    $self->class_mappings(__merge($orig_class_mappings, $self->class_mappings))
         if $orig_class_mappings;
 
-    $self->source_registrations(merge($orig_source_registrations, $self->source_registrations))
+    $self->source_registrations(__merge($orig_source_registrations, $self->source_registrations))
         if $orig_source_registrations;
 }
 
+my $merger;
+sub __merge {
+
+  local $SIG{__WARN__} = sigwarn_silencer(qr/Arguments for _merge_hashes must be hash references/);
+
+  ( $merger ||= do {
+    require Hash::Merge;
+    my $m = Hash::Merge->new('LEFT_PRECEDENT');
+    $m->set_clone_behavior(0);
+    $m;
+  } )->merge(
+    $_[0], $_[1]
+  );
+}
+
 sub _copy_state_from {
     my $self = shift;
     my ($from) = @_;