From: Rafael Kitover Date: Sun, 29 Nov 2009 04:30:08 +0000 (+0000) Subject: backcompat common tests now pass X-Git-Tag: 0.04999_13~23^2~11 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=106a976aec1e51c87f260bd9a31de3692a8f3301;p=dbsrgits%2FDBIx-Class-Schema-Loader.git backcompat common tests now pass --- diff --git a/TODO-BACKCOMPAT b/TODO-BACKCOMPAT index 96bf2ad..8990e2d 100644 --- a/TODO-BACKCOMPAT +++ b/TODO-BACKCOMPAT @@ -9,23 +9,14 @@ SL Backcompat Plan: * use the detector and compat relbuilder ilmari already wrote for static schemas * add a loud warning that says that we're running in backcompat mode, and refers - to the ::Manual::UpgradingFrom4006 POD. + to the ::Manual::UpgradingFrom0.04006 POD. -*** 0.04006 tests +*** naming accessor -* are in t/backcompat/0.04006 -* have their own lib/ -* should only run with the SCHEMA_LOADER_TESTS_BACKCOMPAT=1 env var -* need tests_recursive (or whatever) in Makefile.PL -* need to run in 0.04006 mode (by seeding with a Schema.pm generated by - 0.04006, activation of backcompat mode should be minimally invasive.) +* class data for Loader +* passed to _loader->new -*** Schema::Loader::Base - -* 'naming' accessor should be a Class::Accessor::Grouped 'inherited' type - accessor, doc is written - -*** Write ::Manual::UpgradingFrom4006 POD +*** Write ::Manual::UpgradingFrom0.04006 POD *** Catalyst Helper diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 3e93db4..33dff58 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -48,6 +48,7 @@ __PACKAGE__->mk_ro_accessors(qw/ _tables classes monikers + dynamic /); __PACKAGE__->mk_accessors(qw/ @@ -336,7 +337,7 @@ sub _check_back_compat { my ($self) = @_; # dynamic schemas will always be in 0.04006 mode - if ($self->{dynamic}) { + if ($self->dynamic) { no strict 'refs'; my $class = ref $self || $self; require DBIx::Class::Schema::Loader::Compat::v0_040; @@ -436,6 +437,10 @@ sub _load_external { ); close($fh) or croak "Failed to close $real_inc_path: $!"; + +# load the class too + do $real_inc_path; + die $@ if $@; } =head2 load @@ -518,7 +523,7 @@ sub _load_tables { # The relationship loader needs a working schema $self->{quiet} = 1; local $self->{dump_directory} = $self->{temp_directory}; - $self->_reload_classes(@tables); + $self->_reload_classes(\@tables); $self->_load_relationships($_) for @tables; $self->{quiet} = 0; @@ -529,7 +534,9 @@ sub _load_tables { $self->_load_external($_) for map { $self->classes->{$_} } @tables; - $self->_reload_classes(@tables); + # Reload without unloading first to preserve any symbols from external + # packages. + $self->_reload_classes(\@tables, 0); # Drop temporary cache delete $self->{_cache}; @@ -538,7 +545,10 @@ sub _load_tables { } sub _reload_classes { - my ($self, @tables) = @_; + my ($self, $tables, $unload) = @_; + + my @tables = @$tables; + $unload = 1 unless defined $unload; # so that we don't repeat custom sections @INC = grep $_ ne $self->dump_directory, @INC; @@ -560,7 +570,7 @@ sub _reload_classes { local *Class::C3::reinitialize = sub {}; use warnings; - Class::Unload->unload($class); + Class::Unload->unload($class) if $unload; my ($source, $resultset_class); if ( ($source = $have_source{$moniker}) @@ -568,10 +578,10 @@ sub _reload_classes { && ($resultset_class ne 'DBIx::Class::ResultSet') ) { my $has_file = Class::Inspector->loaded_filename($resultset_class); - Class::Unload->unload($resultset_class); - $self->ensure_class_loaded($resultset_class) if $has_file; + Class::Unload->unload($resultset_class) if $unload; + $self->_reload_class($resultset_class) if $has_file; } - $self->ensure_class_loaded($class); + $self->_reload_class($class); } push @to_register, [$moniker, $class]; } @@ -582,6 +592,16 @@ sub _reload_classes { } } +# We use this instead of ensure_class_loaded when there are package symbols we +# want to preserve. +sub _reload_class { + my ($self, $class) = @_; + + my $class_path = $self->_class_path($class); + delete $INC{ $class_path }; + eval "require $class;"; +} + sub _get_dump_filename { my ($self, $class) = (@_);