From: Rafael Kitover Date: Wed, 13 Jan 2010 11:11:32 +0000 (+0000) Subject: backcompat stuff done X-Git-Tag: 0.04999_14~4 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=540a814964244f410b94708162d3d0c26c51d29a;p=dbsrgits%2FDBIx-Class-Schema-Loader.git backcompat stuff done --- diff --git a/Changes b/Changes index 9a99ed6..c359dac 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,6 @@ Revision history for Perl extension DBIx::Class::Schema::Loader + - use_namespaces now default, with upgrade/downgrade support - filter out un-selectable tables/views - fix NUMERIC/DECIMAL size column_info for postgres - now mentions skip_load_external feature in comments (jhannah) diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index d4d2436..3d293d4 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -38,7 +38,6 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/ dump_directory dump_overwrite really_erase_my_files - result_namespace resultset_namespace default_resultset_class schema_base_class @@ -63,7 +62,9 @@ __PACKAGE__->mk_group_accessors('simple', qw/ _upgrading_from _upgrading_from_load_classes _downgrading_to_load_classes + _rewriting_result_namespace use_namespaces + result_namespace /); =head1 NAME @@ -468,13 +469,14 @@ EOF open(my $fh, '<', $filename) or croak "Cannot open '$filename' for reading: $!"; - my $load_classes = 0; - my $result_namespace; + my $load_classes = 0; + my $result_namespace = ''; while (<$fh>) { if (/^__PACKAGE__->load_classes;/) { $load_classes = 1; - } elsif (($result_namespace) = /result_namespace => '([^']+)'/) { + } elsif (/result_namespace => '([^']+)'/) { + $result_namespace = $1; } elsif (my ($real_ver) = /^# Created by DBIx::Class::Schema::Loader v(\d+\.\d+)/) { @@ -494,11 +496,23 @@ EOF elsif ($load_classes && $self->use_namespaces) { $self->_upgrading_from_load_classes(1); } - elsif ((not $load_classes) && (not $self->use_namespaces)) { + elsif ((not $load_classes) && defined $self->use_namespaces + && (not $self->use_namespaces)) { $self->_downgrading_to_load_classes( $result_namespace || 'Result' ); } + elsif ((not defined $self->use_namespaces) + || $self->use_namespaces) { + if (not $self->result_namespace) { + $self->result_namespace($result_namespace || 'Result'); + } + elsif ($result_namespace ne $self->result_namespace) { + $self->_rewriting_result_namespace( + $result_namespace || 'Result' + ); + } + } # XXX when we go past .0 this will need fixing my ($v) = $real_ver =~ /([1-9])/; @@ -568,7 +582,9 @@ sub _rewriting { return $self->_upgrading_from || $self->_upgrading_from_load_classes - || $self->_downgrading_to_load_classes; + || $self->_downgrading_to_load_classes + || $self->_rewriting_result_namespace + ; } sub _rewrite_old_classnames { @@ -943,16 +959,12 @@ sub _dump_to_dir { # remove Result dir if downgrading from use_namespaces, and there are no # files left. if (my $result_ns = $self->_downgrading_to_load_classes) { - my $result_class; - - if ($result_ns =~ /^\+(.*)/) { - $result_class = $1; - } - else { - $result_class = "${schema_class}::${result_ns}"; - } + my $result_namespace = $self->_result_namespace( + $schema_class, + $result_ns, + ); - (my $result_dir = $result_class) =~ s{::}{/}g; + (my $result_dir = $result_namespace) =~ s{::}{/}g; $result_dir = $self->dump_directory . '/' . $result_dir; unless (my @files = glob "$result_dir/*") { @@ -1112,6 +1124,22 @@ sub _inject { $self->_raw_stmt($target, "use base qw/ $blist /;") if @_; } +sub _result_namespace { + my ($self, $schema_class, $ns) = @_; + my @result_namespace; + + if ($ns =~ /^\+(.*)/) { + # Fully qualified namespace + @result_namespace = ($1) + } + else { + # Relative namespace + @result_namespace = ($schema_class, $ns); + } + + return wantarray ? @result_namespace : join '::', @result_namespace; +} + # Create class with applicable bases, setup monikers, etc sub _make_src_class { my ($self, $table) = @_; @@ -1123,14 +1151,10 @@ sub _make_src_class { my @result_namespace = ($schema_class); if ($self->use_namespaces) { my $result_namespace = $self->result_namespace || 'Result'; - if ($result_namespace =~ /^\+(.*)/) { - # Fully qualified namespace - @result_namespace = ($1) - } - else { - # Relative namespace - push @result_namespace, $result_namespace; - } + @result_namespace = $self->_result_namespace( + $schema_class, + $result_namespace, + ); } my $table_class = join(q{::}, @result_namespace, $table_moniker); @@ -1144,14 +1168,16 @@ sub _make_src_class { @result_namespace = ($schema_class); } elsif (my $ns = $self->_downgrading_to_load_classes) { - if ($ns =~ /^\+(.*)/) { - # Fully qualified namespace - @result_namespace = ($1) - } - else { - # Relative namespace - @result_namespace = ($schema_class, $ns); - } + @result_namespace = $self->_result_namespace( + $schema_class, + $ns, + ); + } + elsif ($ns = $self->_rewriting_result_namespace) { + @result_namespace = $self->_result_namespace( + $schema_class, + $ns, + ); } my $old_class = join(q{::}, @result_namespace, diff --git a/t/25backcompat_v4.t b/t/25backcompat_v4.t index 0d2ebf4..1d9fe55 100644 --- a/t/25backcompat_v4.t +++ b/t/25backcompat_v4.t @@ -33,25 +33,14 @@ my $SCHEMA_CLASS = 'DBIXCSL_Test::Schema'; # we're setting it to 'v4' .) { my $res = run_loader(naming => 'v4'); - is_deeply $res->{warnings}, [], 'no warnings with naming attribute set'; - run_v4_tests($res); } # test upgraded dynamic schema { my $res = run_loader(naming => 'current'); - -# to dump a schema for debugging... -# { -# mkdir '/tmp/HLAGH'; -# $schema->_loader->{dump_directory} = '/tmp/HLAGH'; -# $schema->_loader->_dump_to_dir(values %{ $res->{classes} }); -# } - is_deeply $res->{warnings}, [], 'no warnings with naming attribute set'; - run_v5_tests($res); } @@ -450,6 +439,9 @@ EOF } } + is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quuxs', + 'use_namespaces in backcompat mode'; + # now upgrade the schema to v5 but downgrade to load_classes $res = run_loader( dump_directory => $DUMP_DIR, @@ -481,6 +473,9 @@ EOF ok ((not -d "$result_dir/Result"), 'Result dir was removed for load_classes downgrade'); + is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux', + 'load_classes in upgraded mode'; + # 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'; @@ -496,6 +491,440 @@ EOF 'custom content from unsingularized Result loaded into static dump correctly'; } +# test a regular schema with use_namespaces => 0 upgraded to +# use_namespaces => 1 +{ + rmtree $DUMP_DIR; + mkdir $DUMP_DIR; + + my $res = run_loader( + dump_directory => $DUMP_DIR, + use_namespaces => 0, + ); + + like $res->{warnings}[0], qr/Dumping manual schema/i, +'correct warnings on dumping static schema with use_namespaces => 0'; + + like $res->{warnings}[1], qr/dump completed/i, +'correct warnings on dumping static schema with use_namespaces => 0'; + + is scalar @{ $res->{warnings} }, 2, +'correct number of warnings on dumping static schema with use_namespaces => 0' + or diag @{ $res->{warnings} }; + + run_v5_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 <has_one('bazrel7', 'DBIXCSL_Test::Schema::Baz', + { 'foreign.baz_num' => 'self.baz_id' }); +EOF + } + else { + print; + } + } + } + + # test that with no use_namespaces option, there is a warning and + # load_classes is preserved + $res = run_loader(dump_directory => $DUMP_DIR); + + like $res->{warnings}[0], qr/load_classes/i, +'correct warnings on re-dumping static schema with load_classes'; + + like $res->{warnings}[1], qr/Dumping manual schema/i, +'correct warnings on re-dumping static schema with load_classes'; + + like $res->{warnings}[2], qr/dump completed/i, +'correct warnings on re-dumping static schema with load_classes'; + + is scalar @{ $res->{warnings} }, 3, +'correct number of warnings on re-dumping static schema with load_classes' + or diag @{ $res->{warnings} }; + + is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux', + 'load_classes preserved on re-dump'; + + run_v5_tests($res); + + # now upgrade the schema to use_namespaces + $res = run_loader( + dump_directory => $DUMP_DIR, + use_namespaces => 1, + ); + $schema = $res->{schema}; + + like $res->{warnings}[0], qr/Dumping manual schema/i, +'correct warnings on upgrading to use_namespaces'; + + like $res->{warnings}[1], qr/dump completed/i, +'correct warnings on upgrading to use_namespaces'; + + is scalar @{ $res->{warnings} }, 2, +'correct number of warnings on upgrading to use_namespaces' + or diag @{ $res->{warnings} }; + + run_v5_tests($res); + + (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g; + my @schema_files = glob "$schema_dir/*"; + + is 1, (scalar @schema_files), + "schema dir $schema_dir contains only 1 entry"; + + like $schema_files[0], qr{/Result\z}, + "schema dir contains only a Result/ directory"; + + # check that custom content was preserved + lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' } + 'custom content was carried over during use_namespaces upgrade'; + + lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel7, + $res->{classes}{bazs} } + 'un-namespaced 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 un-namespaced Result loaded into static dump correctly'; +} + +# test a regular schema with default use_namespaces => 1, redump, and downgrade +# to load_classes +{ + rmtree $DUMP_DIR; + mkdir $DUMP_DIR; + + my $res = run_loader(dump_directory => $DUMP_DIR); + + like $res->{warnings}[0], qr/Dumping manual schema/i, +'correct warnings on dumping static schema'; + + like $res->{warnings}[1], qr/dump completed/i, +'correct warnings on dumping static schema'; + + is scalar @{ $res->{warnings} }, 2, +'correct number of warnings on dumping static schema' + or diag @{ $res->{warnings} }; + + run_v5_tests($res); + + is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quux', + 'defaults to use_namespaces on regular dump'; + + # 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 <has_one('bazrel8', 'DBIXCSL_Test::Schema::Result::Baz', + { 'foreign.baz_num' => 'self.baz_id' }); +EOF + } + else { + print; + } + } + } + + # test that with no use_namespaces option, use_namespaces is preserved + $res = run_loader(dump_directory => $DUMP_DIR); + + like $res->{warnings}[0], qr/Dumping manual schema/i, +'correct warnings on re-dumping static schema'; + + like $res->{warnings}[1], qr/dump completed/i, +'correct warnings on re-dumping static schema'; + + is scalar @{ $res->{warnings} }, 2, +'correct number of warnings on re-dumping static schema' + or diag @{ $res->{warnings} }; + + is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quux', + 'use_namespaces preserved on re-dump'; + + run_v5_tests($res); + + # now downgrade the schema to load_classes + $res = run_loader( + dump_directory => $DUMP_DIR, + use_namespaces => 0, + ); + $schema = $res->{schema}; + + like $res->{warnings}[0], qr/Dumping manual schema/i, +'correct warnings on downgrading to load_classes'; + + like $res->{warnings}[1], qr/dump completed/i, +'correct warnings on downgrading to load_classes'; + + is scalar @{ $res->{warnings} }, 2, +'correct number of warnings on downgrading to load_classes' + or diag @{ $res->{warnings} }; + + run_v5_tests($res); + + is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux', + 'load_classes downgrade correct'; + + (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g; + my $result_count =()= glob "$result_dir/*"; + + is $result_count, 4, +'correct number of Results after upgrade and Result dir removed'; + + ok ((not -d "$result_dir/Result"), + 'Result dir was removed for load_classes downgrade'); + + # check that custom content was preserved + lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' } + 'custom content was carried over during load_classes downgrade'; + + lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel8, + $res->{classes}{bazs} } +'namespaced class names in custom content are translated during load_classes '. +'downgrade'; + + 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 namespaced Result loaded into static dump correctly '. +'during load_classes downgrade'; +} + +# test a regular schema with use_namespaces => 1 and a custom result_namespace +# downgraded to load_classes +{ + rmtree $DUMP_DIR; + mkdir $DUMP_DIR; + + my $res = run_loader( + dump_directory => $DUMP_DIR, + result_namespace => 'MyResult', + ); + + like $res->{warnings}[0], qr/Dumping manual schema/i, +'correct warnings on dumping static schema'; + + like $res->{warnings}[1], qr/dump completed/i, +'correct warnings on dumping static schema'; + + is scalar @{ $res->{warnings} }, 2, +'correct number of warnings on dumping static schema' + or diag @{ $res->{warnings} }; + + run_v5_tests($res); + + is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux', + 'defaults to use_namespaces and uses custom result_namespace'; + + # 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 <has_one('bazrel9', 'DBIXCSL_Test::Schema::MyResult::Baz', + { 'foreign.baz_num' => 'self.baz_id' }); +EOF + } + else { + print; + } + } + } + + # test that with no use_namespaces option, use_namespaces is preserved, and + # the custom result_namespace is preserved + $res = run_loader(dump_directory => $DUMP_DIR); + + like $res->{warnings}[0], qr/Dumping manual schema/i, +'correct warnings on re-dumping static schema'; + + like $res->{warnings}[1], qr/dump completed/i, +'correct warnings on re-dumping static schema'; + + is scalar @{ $res->{warnings} }, 2, +'correct number of warnings on re-dumping static schema' + or diag @{ $res->{warnings} }; + + is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux', + 'use_namespaces and custom result_namespace preserved on re-dump'; + + run_v5_tests($res); + + # now downgrade the schema to load_classes + $res = run_loader( + dump_directory => $DUMP_DIR, + use_namespaces => 0, + ); + $schema = $res->{schema}; + + like $res->{warnings}[0], qr/Dumping manual schema/i, +'correct warnings on downgrading to load_classes'; + + like $res->{warnings}[1], qr/dump completed/i, +'correct warnings on downgrading to load_classes'; + + is scalar @{ $res->{warnings} }, 2, +'correct number of warnings on downgrading to load_classes' + or diag @{ $res->{warnings} }; + + run_v5_tests($res); + + is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux', + 'load_classes downgrade correct'; + + (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s{::}{/}g; + my $result_count =()= glob "$result_dir/*"; + + is $result_count, 4, +'correct number of Results after upgrade and Result dir removed'; + + ok ((not -d "$result_dir/MyResult"), + 'Result dir was removed for load_classes downgrade'); + + # check that custom content was preserved + lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' } + 'custom content was carried over during load_classes downgrade'; + + lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel9, + $res->{classes}{bazs} } +'namespaced class names in custom content are translated during load_classes '. +'downgrade'; + + 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 namespaced Result loaded into static dump correctly '. +'during load_classes downgrade'; +} + +# rewrite from one result_namespace to another +{ + rmtree $DUMP_DIR; + mkdir $DUMP_DIR; + + my $res = run_loader(dump_directory => $DUMP_DIR); + + # 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 <has_one('bazrel10', 'DBIXCSL_Test::Schema::Result::Baz', + { 'foreign.baz_num' => 'self.baz_id' }); +EOF + } + else { + print; + } + } + } + + # Rewrite implicit 'Result' to 'MyResult' + $res = run_loader( + dump_directory => $DUMP_DIR, + result_namespace => 'MyResult', + ); + $schema = $res->{schema}; + + is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux', + 'using new result_namespace'; + + (my $result_dir = "$DUMP_DIR/$SCHEMA_CLASS/MyResult") =~ s{::}{/}g; + my $result_count =()= glob "$result_dir/*"; + + is $result_count, 4, +'correct number of Results after rewritten result_namespace'; + + ok ((not -d "$result_dir/Result"), + 'original Result dir was removed when rewriting result_namespace'); + + # check that custom content was preserved + lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' } + 'custom content was carried over when rewriting result_namespace'; + + lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel10, + $res->{classes}{bazs} } +'class names in custom content are translated when rewriting result_namespace'; + + 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 namespaced Result loaded into static dump correctly '. +'when rewriting result_namespace'; + + # Now rewrite 'MyResult' to 'Mtfnpy' + $res = run_loader( + dump_directory => $DUMP_DIR, + result_namespace => 'Mtfnpy', + ); + $schema = $res->{schema}; + + is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Mtfnpy::Quux', + 'using new result_namespace'; + + ($result_dir = "$DUMP_DIR/$SCHEMA_CLASS/Mtfnpy") =~ s{::}{/}g; + $result_count =()= glob "$result_dir/*"; + + is $result_count, 4, +'correct number of Results after rewritten result_namespace'; + + ok ((not -d "$result_dir/MyResult"), + 'original Result dir was removed when rewriting result_namespace'); + + # check that custom content was preserved + lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'mtfnpy' } + 'custom content was carried over when rewriting result_namespace'; + + lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel10, + $res->{classes}{bazs} } +'class names in custom content are translated when rewriting result_namespace'; + + $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs}); + $code = do { local ($/, @ARGV) = (undef, $file); <> }; + + like $code, qr/sub a_method { 'mtfnpy' }/, +'custom content from namespaced Result loaded into static dump correctly '. +'when rewriting result_namespace'; +} + # test upgrading a v4 schema, the check that the version string is correct { write_v4_schema_pm();