From: Peter Rabbitson <ribasushi@cpan.org>
Date: Tue, 22 Feb 2011 16:20:41 +0000 (+0100)
Subject: Lazy-load as many of the non-essential modules as possible
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3b80fa31b60050d4c8df91457ba6fd51b579a7a6;p=dbsrgits%2FDBIx-Class-Historic.git

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

diff --git a/Changes b/Changes
index 1d06025..d18dea6 100644
--- a/Changes
+++ b/Changes
@@ -24,6 +24,8 @@ Revision history for DBIx::Class
 
     * Misc
         - Only load Class::C3 and friends if necessary ($] < 5.010)
+        - Greatly reduced loading of non-essential modules to aid startup
+          time (mainly benefiting CGI users)
 
 0.08127 2011-01-19 16:40 (UTC)
     * New Features / Changes
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 02bceb7..fab2a27 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -5,13 +5,9 @@ use warnings;
 use base qw/DBIx::Class/;
 use Carp::Clan qw/^DBIx::Class/;
 use DBIx::Class::Exception;
-use Data::Page;
 use DBIx::Class::ResultSetColumn;
-use DBIx::Class::ResultSourceHandle;
-use Hash::Merge ();
 use Scalar::Util qw/blessed weaken/;
 use Try::Tiny;
-use Storable qw/nfreeze thaw/;
 
 # not importing first() as it will clash with our own method
 use List::Util ();
@@ -2194,6 +2190,7 @@ sub pager {
 ### necessary for future development of DBIx::DS. Do *NOT* change this code
 ### before talking to ribasushi/mst
 
+  require Data::Page;
   my $pager = Data::Page->new(
     0,  #start with an empty set
     $attrs->{rows},
@@ -3558,6 +3555,7 @@ sub _merge_joinpref_attr {
 
   sub _merge_attr {
     $hm ||= do {
+      require Hash::Merge;
       my $hm = Hash::Merge->new;
 
       $hm->specify_behavior({
@@ -3647,14 +3645,14 @@ sub STORABLE_freeze {
   # A cursor in progress can't be serialized (and would make little sense anyway)
   delete $to_serialize->{cursor};
 
-  nfreeze($to_serialize);
+  Storable::nfreeze($to_serialize);
 }
 
 # need this hook for symmetry
 sub STORABLE_thaw {
   my ($self, $cloning, $serialized) = @_;
 
-  %$self = %{ thaw($serialized) };
+  %$self = %{ Storable::thaw($serialized) };
 
   $self;
 }
diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index a8c2e85..8b291e1 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -11,7 +11,6 @@ use Carp::Clan qw/^DBIx::Class/;
 use Try::Tiny;
 use List::Util 'first';
 use Scalar::Util qw/weaken isweak/;
-use Storable qw/nfreeze thaw/;
 use namespace::clean;
 
 use base qw/DBIx::Class/;
@@ -1837,11 +1836,11 @@ sub handle {
   }
 }
 
-sub STORABLE_freeze { nfreeze($_[0]->handle) }
+sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
 
 sub STORABLE_thaw {
   my ($self, $cloning, $ice) = @_;
-  %$self = %{ (thaw $ice)->resolve };
+  %$self = %{ (Storable::thaw($ice))->resolve };
 }
 
 =head2 throw_exception
diff --git a/lib/DBIx/Class/ResultSourceHandle.pm b/lib/DBIx/Class/ResultSourceHandle.pm
index 0c7e4db..690fe21 100644
--- a/lib/DBIx/Class/ResultSourceHandle.pm
+++ b/lib/DBIx/Class/ResultSourceHandle.pm
@@ -5,7 +5,6 @@ use warnings;
 
 use base qw/DBIx::Class/;
 
-use Storable qw/nfreeze thaw/;
 use DBIx::Class::Exception;
 use Try::Tiny;
 
@@ -93,7 +92,7 @@ sub STORABLE_freeze {
     : $self->{_detached_source}->result_class
   ;
 
-  nfreeze($to_serialize);
+  Storable::nfreeze($to_serialize);
 }
 
 =head2 STORABLE_thaw
@@ -106,7 +105,7 @@ C<< $schema->thaw($ice) >> which handles this for you.
 
 sub STORABLE_thaw {
   my ($self, $cloning, $ice) = @_;
-  %$self = %{ thaw($ice) };
+  %$self = %{ Storable::thaw($ice) };
 
   my $from_class = delete $self->{_frozen_from_class};
 
diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index fbfd15b..3c2df0a 100644
--- 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
@@ -1189,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");
@@ -1208,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);
 }
 
@@ -1219,6 +1220,7 @@ provided here for symmetry.
 =cut
 
 sub freeze {
+  require Storable;
   return Storable::nfreeze($_[1]);
 }
 
@@ -1241,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);
 }
 
diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm
index db8c267..edfef85 100644
--- a/lib/DBIx/Class/Storage.pm
+++ b/lib/DBIx/Class/Storage.pm
@@ -8,7 +8,6 @@ use mro 'c3';
 
 use DBIx::Class::Exception;
 use Scalar::Util 'weaken';
-use IO::File;
 use DBIx::Class::Storage::TxnScopeGuard;
 use Try::Tiny;
 use namespace::clean;
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 99befac..1448bc3 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -12,10 +12,8 @@ use DBI;
 use DBIx::Class::Storage::DBI::Cursor;
 use Scalar::Util qw/refaddr weaken reftype blessed/;
 use List::Util qw/first/;
-use Data::Dumper::Concise 'Dumper';
 use Sub::Name 'subname';
 use Try::Tiny;
-use File::Path 'make_path';
 use overload ();
 use namespace::clean;
 
@@ -1778,10 +1776,11 @@ sub insert_bulk {
       $msg,
       $cols->[$col_idx],
       do {
+        require Data::Dumper::Concise;
         local $Data::Dumper::Maxdepth = 1; # don't dump objects, if any
-        Dumper {
+        Data::Dumper::Concise::Dumper ({
           map { $cols->[$_] => $data->[$slice_idx][$_] } (0 .. $#$cols)
-        },
+        }),
       }
     );
   };
@@ -1922,9 +1921,10 @@ sub _execute_array {
     $self->throw_exception("Unexpected populate error: $err")
       if ($i > $#$tuple_status);
 
+    require Data::Dumper::Concise;
     $self->throw_exception(sprintf "%s for populate slice:\n%s",
       ($tuple_status->[$i][1] || $err),
-      Dumper { map { $cols->[$_] => $data->[$i][$_] } (0 .. $#$cols) },
+      Data::Dumper::Concise::Dumper( { map { $cols->[$_] => $data->[$i][$_] } (0 .. $#$cols) } ),
     );
   }
 
@@ -2574,10 +2574,10 @@ sub create_ddl_dir {
   } else {
       -d $dir
         or
-      make_path ("$dir")  # make_path does not like objects (i.e. Path::Class::Dir)
+      (require File::Path and File::Path::make_path ("$dir"))  # make_path does not like objects (i.e. Path::Class::Dir)
         or
       $self->throw_exception(
-        "Failed to create '$dir': " . ($! || $@ || 'error unknow')
+        "Failed to create '$dir': " . ($! || $@ || 'error unknown')
       );
   }
 
diff --git a/t/53lean_startup.t b/t/53lean_startup.t
new file mode 100644
index 0000000..3bc55e9
--- /dev/null
+++ b/t/53lean_startup.t
@@ -0,0 +1,90 @@
+# Use a require override instead of @INC munging (less common)
+# Do the override as early as possible so that CORE::require doesn't get compiled away
+# We will replace $req_override in a bit
+
+my $test_hook;
+BEGIN {
+  $test_hook = sub {}; # noop at first
+  *CORE::GLOBAL::require = sub {
+    $test_hook->(@_);
+    CORE::require($_[0]);
+  };
+}
+
+use strict;
+use warnings;
+use Test::More;
+
+use Carp;
+
+BEGIN {
+  my $core_modules = { map { $_ => 1 } qw/
+    strict
+    warnings
+    vars
+
+    base
+    parent
+    mro
+    overload
+
+    B
+    locale
+
+    namespace::clean
+    Try::Tiny
+    Sub::Name
+
+    Scalar::Util
+    List::Util
+    Hash::Merge
+
+    DBI
+
+    Carp
+    Carp::Clan
+
+    Class::Accessor::Grouped
+    Class::C3::Componentised
+
+    SQL::Abstract
+  /, $] < 5.010 ? 'MRO::Compat' : () };
+
+  $test_hook = sub {
+
+    my $req = $_[0];
+    $req =~ s/\.pm$//;
+    $req =~ s/\//::/g;
+
+    return if $req =~ /^DBIx::Class|^DBICTest::Schema/;
+
+    my $up = 1;
+    my @caller;
+    do { @caller = caller($up++) } while (
+      @caller and (
+        $caller[0] =~ /^ (?: base | parent | Class::C3::Componentised | Module::Inspector) $/x
+          or
+        $caller[1] =~ / \( eval \s \d+ \) /x
+      )
+    );
+
+    if ( $caller[0] =~ /^DBIx::Class/) {
+      fail ("Unexpected require of '$req' by $caller[0] ($caller[1] line $caller[2])")
+        unless $core_modules->{$req};
+    }
+  };
+}
+
+use lib 't/lib';
+use DBICTest;
+
+# these envvars bring in more stuff
+delete $ENV{$_} for qw/
+  DBICTEST_SQLT_DEPLOY
+  DBIC_TRACE
+/;
+
+my $schema = DBICTest->init_schema;
+is ($schema->resultset('Artist')->next->name, 'Caterwauler McCrae');
+
+done_testing;
diff --git a/t/storage/exception.t b/t/storage/exception.t
index 9a14af3..d96e336 100644
--- a/t/storage/exception.t
+++ b/t/storage/exception.t
@@ -19,6 +19,7 @@ use DBICTest::Schema;
 
   sub _populate_dbh {
     my $self = shift;
+
     my $death = $self->_dbi_connect_info->[3]{die};
 
     die "storage test died: $death" if $death eq 'before_populate';
@@ -30,12 +31,12 @@ use DBICTest::Schema;
 }
 
 for (qw/before_populate after_populate/) {
-  dies_ok (sub {
+  throws_ok (sub {
     my $schema = DBICTest::Schema->clone;
     $schema->storage_type ('Dying::Storage');
     $schema->connection (DBICTest->_database, { die => $_ });
     $schema->storage->ensure_connected;
-  }, "$_ exception found");
+  }, qr/$_/, "$_ exception found");
 }
 
 done_testing;