From: Peter Rabbitson 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;