Fix replicated fails introduced with 2b8cc2f2

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Schema.pm

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 3c78930..4dbe059 100644 (file)
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -11,6 +11,7 @@ use File::Spec;
 use Sub::Name 'subname';
 use Module::Find();
 use Storable();
+use B qw/svref_2object/;
 use namespace::clean;
 
 use base qw/DBIx::Class/;
@@ -586,7 +587,13 @@ source name.
 =cut
 
 sub source {
-  my ($self, $moniker) = @_;
+  my $self = shift;
+
+  $self->throw_exception("source() expects a source name")
+    unless @_;
+
+  my $moniker = shift;
+
   my $sreg = $self->source_registrations;
   return $sreg->{$moniker} if exists $sreg->{$moniker};
 
@@ -1372,6 +1379,43 @@ sub _register_source {
   $self->class_mappings(\%map);
 }
 
+{
+  my $global_phase_destroy;
+
+  # SpeedyCGI runs END blocks every cycle but keeps object instances
+  # hence we have to disable the globaldestroy hatch, and rely on the
+  # eval trap below (which appears to work, but is risky done so late)
+  END { $global_phase_destroy = 1 unless $CGI::SpeedyCGI::i_am_speedy }
+
+  sub DESTROY {
+    return if $global_phase_destroy;
+
+    my $self = shift;
+    my $srcs = $self->source_registrations;
+
+    for my $moniker (keys %$srcs) {
+      # find first source that is not about to be GCed (someone other than $self
+      # holds a reference to it) and reattach to it, weakening our own link
+      #
+      # during global destruction (if we have not yet bailed out) this will throw
+      # which will serve as a signal to not try doing anything else
+      if (ref $srcs->{$moniker} and svref_2object($srcs->{$moniker})->REFCNT > 1) {
+        local $@;
+        eval {
+          $srcs->{$moniker}->schema($self);
+          1;
+        } or do {
+          $global_phase_destroy = 1;
+          last;
+        };
+
+        weaken $srcs->{$moniker};
+        last;
+      }
+    }
+  }
+}
+
 sub _unregister_source {
     my ($self, $moniker) = @_;
     my %reg = %{$self->source_registrations};