Lazy-load as many of the non-essential modules as possible

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

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 8270c27..3c2df0a 100644 (file)
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -7,11 +7,8 @@ use DBIx::Class::Exception;
 use Carp::Clan qw/^DBIx::Class|^Try::Tiny/;
 use Try::Tiny;
 use Scalar::Util 'weaken';
-use File::Spec;
 use Sub::Name 'subname';
-use Module::Find();
-use Storable();
-use B qw/svref_2object/;
+use B 'svref_2object';
 use namespace::clean;
 
 use base qw/DBIx::Class/;
@@ -169,6 +166,7 @@ sub _findallmod {
   my $proto = shift;
   my $ns = shift || ref $proto || $proto;
 
+  require Module::Find;
   my @mods = Module::Find::findallmod($ns);
 
   # try to untaint module names. mods where this fails
@@ -240,9 +238,9 @@ sub load_namespaces {
 
   my @to_register;
   {
-    no warnings 'redefine';
-    local *Class::C3::reinitialize = sub { };
-    use warnings 'redefine';
+    no warnings qw/redefine/;
+    local *Class::C3::reinitialize = sub { } if DBIx::Class::_ENV_::OLD_MRO;
+    use warnings qw/redefine/;
 
     # ensure classes are loaded and attached in inheritance order
     for my $res (values %results) {
@@ -295,7 +293,8 @@ sub load_namespaces {
       . 'corresponding Result class';
   }
 
-  Class::C3->reinitialize;
+  Class::C3->reinitialize if DBIx::Class::_ENV_::OLD_MRO;
+
   $class->register_class(@$_) for (@to_register);
 
   return;
@@ -378,7 +377,9 @@ sub load_classes {
   my @to_register;
   {
     no warnings qw/redefine/;
-    local *Class::C3::reinitialize = sub { };
+    local *Class::C3::reinitialize = sub { } if DBIx::Class::_ENV_::OLD_MRO;
+    use warnings qw/redefine/;
+
     foreach my $prefix (keys %comps_for) {
       foreach my $comp (@{$comps_for{$prefix}||[]}) {
         my $comp_class = "${prefix}::${comp}";
@@ -395,7 +396,7 @@ sub load_classes {
       }
     }
   }
-  Class::C3->reinitialize;
+  Class::C3->reinitialize if DBIx::Class::_ENV_::OLD_MRO;
 
   foreach my $to (@to_register) {
     $class->register_class(@$to);
@@ -587,7 +588,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};
 
@@ -901,8 +908,10 @@ sub compose_namespace {
   my $schema = $self->clone;
   {
     no warnings qw/redefine/;
+    local *Class::C3::reinitialize = sub { } if DBIx::Class::_ENV_::OLD_MRO;
+    use warnings qw/redefine/;
+
     no strict qw/refs/;
-#    local *Class::C3::reinitialize = sub { };
     foreach my $moniker ($schema->sources) {
       my $source = $schema->source($moniker);
       my $target_class = "${target}::${moniker}";
@@ -921,7 +930,7 @@ sub compose_namespace {
      $schema->register_source($moniker, $source);
     }
   }
-#  Class::C3->reinitialize();
+  Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;
   {
     no strict 'refs';
     no warnings 'redefine';
@@ -1178,6 +1187,8 @@ format.
 sub ddl_filename {
   my ($self, $type, $version, $dir, $preversion) = @_;
 
+  require File::Spec;
+
   my $filename = ref($self);
   $filename =~ s/::/-/g;
   $filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
@@ -1197,6 +1208,7 @@ reference to any schema, so are rather useless.
 sub thaw {
   my ($self, $obj) = @_;
   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
+  require Storable;
   return Storable::thaw($obj);
 }
 
@@ -1208,6 +1220,7 @@ provided here for symmetry.
 =cut
 
 sub freeze {
+  require Storable;
   return Storable::nfreeze($_[1]);
 }
 
@@ -1230,6 +1243,7 @@ objects so their references to the schema object
 sub dclone {
   my ($self, $obj) = @_;
   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
+  require Storable;
   return Storable::dclone($obj);
 }
 
@@ -1376,7 +1390,10 @@ sub _register_source {
 {
   my $global_phase_destroy;
 
-  END { $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;
@@ -1387,8 +1404,19 @@ sub _register_source {
     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) {
-        $srcs->{$moniker}->schema($self);
+        local $@;
+        eval {
+          $srcs->{$moniker}->schema($self);
+          1;
+        } or do {
+          $global_phase_destroy = 1;
+          last;
+        };
+
         weaken $srcs->{$moniker};
         last;
       }