* 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
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 ();
### 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},
sub _merge_attr {
$hm ||= do {
+ require Hash::Merge;
my $hm = Hash::Merge->new;
$hm->specify_behavior({
# 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;
}
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/;
}
}
-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
use base qw/DBIx::Class/;
-use Storable qw/nfreeze thaw/;
use DBIx::Class::Exception;
use Try::Tiny;
: $self->{_detached_source}->result_class
;
- nfreeze($to_serialize);
+ Storable::nfreeze($to_serialize);
}
=head2 STORABLE_thaw
sub STORABLE_thaw {
my ($self, $cloning, $ice) = @_;
- %$self = %{ thaw($ice) };
+ %$self = %{ Storable::thaw($ice) };
my $from_class = delete $self->{_frozen_from_class};
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/;
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
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");
sub thaw {
my ($self, $obj) = @_;
local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
+ require Storable;
return Storable::thaw($obj);
}
=cut
sub freeze {
+ require Storable;
return Storable::nfreeze($_[1]);
}
sub dclone {
my ($self, $obj) = @_;
local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
+ require Storable;
return Storable::dclone($obj);
}
use DBIx::Class::Exception;
use Scalar::Util 'weaken';
-use IO::File;
use DBIx::Class::Storage::TxnScopeGuard;
use Try::Tiny;
use namespace::clean;
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;
$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)
- },
+ }),
}
);
};
$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) } ),
);
}
} 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')
);
}
--- /dev/null
+# 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;
sub _populate_dbh {
my $self = shift;
+
my $death = $self->_dbi_connect_info->[3]{die};
die "storage test died: $death" if $death eq 'before_populate';
}
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;
projects / dbsrgits/DBIx-Class-Historic.git / commitdiff