[Bast-commits] r8285 - in
branches/DBIx-Class-Schema-Loader/current: .
lib/DBIx/Class/Schema/Loader t t/backcompat/0.04006/lib t/lib
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Tue Jan 12 06:44:50 GMT 2010
Author: caelum
Date: 2010-01-12 06:44:49 +0000 (Tue, 12 Jan 2010)
New Revision: 8285
Modified:
branches/DBIx-Class-Schema-Loader/current/TODO
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
branches/DBIx-Class-Schema-Loader/current/t/25backcompat_v4.t
branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm
branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm
Log:
use_namespaces upgrade is fully tested, need to implement downgrade
Modified: branches/DBIx-Class-Schema-Loader/current/TODO
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/TODO 2010-01-11 22:43:43 UTC (rev 8284)
+++ branches/DBIx-Class-Schema-Loader/current/TODO 2010-01-12 06:44:49 UTC (rev 8285)
@@ -23,3 +23,5 @@
Re-scan relations/tables after initial relation setup to find ->many_to_many() relations to be set up?
While scanning for many-to-many, scan for implied rels as well? (if foo->belongs_to('bar') and baz->belongs_to('bar'), does that impliy foo->might_have('baz') and the reverse?)
...
+
+unregister sources for dropped tables on rescan
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm 2010-01-11 22:43:43 UTC (rev 8284)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm 2010-01-12 06:44:49 UTC (rev 8285)
@@ -478,7 +478,7 @@
if ($load_classes && (not defined $self->use_namespaces)) {
warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
-'load_classes;' static schema detected, turning off use_namespaces.
+'load_classes;' static schema detected, turning off 'use_namespaces'.
Set the 'use_namespaces' attribute or the SCHEMA_LOADER_BACKCOMPAT environment
variable to disable this warning.
@@ -489,7 +489,6 @@
$self->use_namespaces(0);
}
elsif ($load_classes && $self->use_namespaces) {
- $self->use_namespaces(1);
$self->_upgrading_from_load_classes(1);
}
@@ -521,8 +520,6 @@
$self->schema_version_to_dump($real_ver);
- $self->use_namespaces(0) unless defined $self->use_namespaces;
-
last;
}
}
Modified: branches/DBIx-Class-Schema-Loader/current/t/25backcompat_v4.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/25backcompat_v4.t 2010-01-11 22:43:43 UTC (rev 8284)
+++ branches/DBIx-Class-Schema-Loader/current/t/25backcompat_v4.t 2010-01-12 06:44:49 UTC (rev 8285)
@@ -240,7 +240,7 @@
{
write_v4_schema_pm();
my $res = run_loader(dump_directory => $DUMP_DIR);
- my $warning = $res->{warnings}[0];
+ my $warning = $res->{warnings}[1];
like $warning, qr/static schema/i,
'static schema in backcompat mode detected';
@@ -249,7 +249,7 @@
like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/,
'refers to upgrading doc';
- is scalar @{ $res->{warnings} }, 3,
+ is scalar @{ $res->{warnings} }, 4,
'correct number of warnings for static schema in backcompat mode';
run_v4_tests($res);
@@ -282,7 +282,11 @@
run_v4_tests($res);
# now upgrade the schema
- $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current');
+ $res = run_loader(
+ dump_directory => $DUMP_DIR,
+ naming => 'current',
+ use_namespaces => 1
+ );
$schema = $res->{schema};
like $res->{warnings}[0], qr/Dumping manual schema/i,
@@ -297,6 +301,93 @@
run_v5_tests($res);
+ (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS/Result") =~ s{::}{/}g;
+ my $result_count =()= glob "$result_dir/*";
+
+ is $result_count, 4,
+ 'un-singularized results were replaced during upgrade';
+
+ # check that custom content was preserved
+ lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' }
+ 'custom content was carried over from un-singularized Result';
+
+ lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel3,
+ $res->{classes}{bazs} }
+ 'unsingularized class names in custom content are translated';
+
+ my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs});
+ my $code = do { local ($/, @ARGV) = (undef, $file); <> };
+
+ like $code, qr/sub a_method { 'mtfnpy' }/,
+'custom content from unsingularized Result loaded into static dump correctly';
+}
+
+# test running against v4 schema without upgrade, then upgrade with
+# use_namespaces not explicitly set
+{
+ write_v4_schema_pm();
+ my $res = run_loader(dump_directory => $DUMP_DIR);
+ my $warning = $res->{warnings}[1];
+
+ like $warning, qr/static schema/i,
+ 'static schema in backcompat mode detected';
+ like $warning, qr/0.04006/,
+ 'correct version detected';
+ like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/,
+ 'refers to upgrading doc';
+
+ is scalar @{ $res->{warnings} }, 4,
+ 'correct number of warnings for static schema in backcompat mode';
+
+ run_v4_tests($res);
+
+ # add some custom content to a Result that will be replaced
+ my $schema = $res->{schema};
+ my $quuxs_pm = $schema->_loader
+ ->_get_dump_filename($res->{classes}{quuxs});
+ {
+ local ($^I, @ARGV) = ('', $quuxs_pm);
+ while (<>) {
+ if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) {
+ print;
+ print <<EOF;
+sub a_method { 'mtfnpy' }
+
+__PACKAGE__->has_one('bazrel3', 'DBIXCSL_Test::Schema::Bazs',
+ { 'foreign.baz_num' => 'self.baz_id' });
+EOF
+ }
+ else {
+ print;
+ }
+ }
+ }
+
+ # now upgrade the schema
+ $res = run_loader(
+ dump_directory => $DUMP_DIR,
+ naming => 'current'
+ );
+ $schema = $res->{schema};
+
+ like $res->{warnings}[0], qr/load_classes/i,
+'correct warnings on upgrading static schema (with "naming" set and ' .
+'use_namespaces not set)';
+
+ like $res->{warnings}[1], qr/Dumping manual schema/i,
+'correct warnings on upgrading static schema (with "naming" set and ' .
+'use_namespaces not set)';
+
+ like $res->{warnings}[2], qr/dump completed/i,
+'correct warnings on upgrading static schema (with "naming" set and ' .
+'use_namespaces not set)';
+
+ is scalar @{ $res->{warnings} }, 3,
+'correct number of warnings on upgrading static schema (with "naming" set)'
+ or diag @{ $res->{warnings} };
+
+ run_v5_tests($res);
+
(my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g;
my $result_count =()= glob "$result_dir/*";
@@ -395,9 +486,6 @@
sub run_loader {
my %loader_opts = @_;
- $loader_opts{use_namespaces} = 0
- unless exists $loader_opts{use_namespaces};
-
eval {
foreach my $source_name ($SCHEMA_CLASS->clone->sources) {
Class::Unload->unload("${SCHEMA_CLASS}::${source_name}");
Modified: branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm 2010-01-11 22:43:43 UTC (rev 8284)
+++ branches/DBIx-Class-Schema-Loader/current/t/backcompat/0.04006/lib/dbixcsl_common_tests.pm 2010-01-12 06:44:49 UTC (rev 8285)
@@ -184,10 +184,7 @@
can_ok( $class1, 'dbix_class_testcomponent' ) or $skip_tcomp = 1;
can_ok( $class1, 'loader_test1_classmeth' ) or $skip_cmeth = 1;
- TODO: {
- local $TODO = "Not yet supported by ResultSetManger code";
- can_ok( $rsobj1, 'loader_test1_rsmeth' ) or $skip_rsmeth = 1;
- }
+ can_ok( $rsobj1, 'loader_test1_rsmeth' ) or $skip_rsmeth = 1;
SKIP: {
skip "Pre-requisite test failed", 1 if $skip_tab;
Modified: branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm 2010-01-11 22:43:43 UTC (rev 8284)
+++ branches/DBIx-Class-Schema-Loader/current/t/lib/dbixcsl_common_tests.pm 2010-01-12 06:44:49 UTC (rev 8285)
@@ -123,7 +123,8 @@
my $expected_count = 34;
- $expected_count += @{ $self->{extra}{create} || [] };
+ $expected_count += grep /CREATE (?:TABLE|VIEW)/i,
+ @{ $self->{extra}{create} || [] };
$expected_count -= grep /CREATE TABLE/, @statements_inline_rels
if $self->{no_inline_rels};
More information about the Bast-commits
mailing list