From: Rafael Kitover Date: Sun, 3 Jan 2010 11:24:56 +0000 (+0000) Subject: rewrite un-singularized classnames in custom and external content when upgrading X-Git-Tag: 0.04999_13~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b24cb177faf706a17d5e7425515132fd1c0a814a;p=dbsrgits%2FDBIx-Class-Schema-Loader.git rewrite un-singularized classnames in custom and external content when upgrading --- diff --git a/TODO-BACKCOMPAT b/TODO-BACKCOMPAT index 17a46d3..08eda1c 100644 --- a/TODO-BACKCOMPAT +++ b/TODO-BACKCOMPAT @@ -1,8 +1,5 @@ SL Backcompat Plan: -* rewrite un-singularized class names (in e.g. custom relationships) in both - preserved custom content and external content from un-singularized classes - * make use_namespaces the default, and upgrade to it properly *** Catalyst Helper diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 5b334ff..420728a 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -460,7 +460,7 @@ EOF my ($v) = $real_ver =~ /([1-9])/; $v = "v$v"; - last if $v eq CURRENT_V || $real_ver =~ /^0\.04999/; + last if $v eq CURRENT_V || $real_ver =~ /^0\.\d\d999/; if (not %{ $self->naming }) { warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT}; @@ -518,6 +518,21 @@ sub _find_class_in_inc { return $self->_find_file_in_inc($self->_class_path($class)); } +sub _rewrite_old_classnames { + my ($self, $code) = @_; + + return $code unless $self->_upgrading_from; + + my %old_classes = reverse %{ $self->_upgrading_classes }; + + my $re = join '|', keys %old_classes; + $re = qr/\b($re)\b/; + + $code =~ s/$re/$old_classes{$1}/eg; + + return $code; +} + sub _load_external { my ($self, $class) = @_; @@ -543,23 +558,10 @@ sub _load_external { open(my $fh, '<', $real_inc_path) or croak "Failed to open '$real_inc_path' for reading: $!"; - $self->_ext_stmt($class, - qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n| - .qq|# They are now part of the custom portion of this file\n| - .qq|# for you to hand-edit. If you do not either delete\n| - .qq|# this section or remove that file from \@INC, this section\n| - .qq|# will be repeated redundantly when you re-create this\n| - .qq|# file again via Loader!\n| - ); - while(<$fh>) { - chomp; - $self->_ext_stmt($class, $_); - } - $self->_ext_stmt($class, - qq|# End of lines loaded from '$real_inc_path' | - ); + my $code = do { local $/; <$fh> }; close($fh) or croak "Failed to close $real_inc_path: $!"; + $code = $self->_rewrite_old_classnames($code); if ($self->dynamic) { # load the class too # kill redefined warnings @@ -568,9 +570,23 @@ sub _load_external { $warn_handler->(@_) unless $_[0] =~ /^Subroutine \S+ redefined/; }; - do $real_inc_path; + eval $code; die $@ if $@; } + + $self->_ext_stmt($class, + qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n| + .qq|# They are now part of the custom portion of this file\n| + .qq|# for you to hand-edit. If you do not either delete\n| + .qq|# this section or remove that file from \@INC, this section\n| + .qq|# will be repeated redundantly when you re-create this\n| + .qq|# file again via Loader!\n| + ); + chomp $code; + $self->_ext_stmt($class, $code); + $self->_ext_stmt($class, + qq|# End of lines loaded from '$real_inc_path' | + ); } if ($old_real_inc_path) { @@ -583,6 +599,12 @@ sub _load_external { # version of the Loader. For a static schema, this happens only once during # upgrade. EOF + + my $code = do { + local ($/, @ARGV) = (undef, $old_real_inc_path); <> + }; + $code = $self->_rewrite_old_classnames($code); + if ($self->dynamic) { warn <<"EOF"; @@ -598,25 +620,15 @@ EOF $warn_handler->(@_) unless $_[0] =~ /^Subroutine \S+ redefined/; }; - my $code = do { - local ($/, @ARGV) = (undef, $old_real_inc_path); <> - }; - $code =~ s/\b$old_class\b/$class/g; eval $code; die $@ if $@; } - while(<$fh>) { - chomp; - s/\b$old_class\b/$class/g; - $self->_ext_stmt($class, $_); - } + chomp $code; + $self->_ext_stmt($class, $code); $self->_ext_stmt($class, qq|# End of lines loaded from '$old_real_inc_path' | ); - - close($fh) - or croak "Failed to close $old_real_inc_path: $!"; } } @@ -921,6 +933,8 @@ sub _write_classfile { } } + $custom_content = $self->_rewrite_old_classnames($custom_content); + $text .= qq|$_\n| for @{$self->{_dump_storage}->{$class} || []}; diff --git a/t/25backcompat_v4.t b/t/25backcompat_v4.t index 993d128..384fe96 100644 --- a/t/25backcompat_v4.t +++ b/t/25backcompat_v4.t @@ -1,6 +1,7 @@ use strict; use warnings; use Test::More; +use Test::Exception; use File::Path qw/rmtree make_path/; use Class::Unload; use File::Temp qw/tempfile tempdir/; @@ -61,9 +62,24 @@ my $SCHEMA_CLASS = 'DBIXCSL_Test::Schema'; my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS; make_path $external_result_dir; + # make external content for Result that will be singularized IO::File->new(">$external_result_dir/Quuxs.pm")->print(<<"EOF"); package ${SCHEMA_CLASS}::Quuxs; sub a_method { 'hlagh' } + +__PACKAGE__->has_one('bazrel', 'DBIXCSL_Test::Schema::Bazs', + { 'foreign.baz_num' => 'self.baz_id' }); + +1; +EOF + + # make external content for Result that will NOT be singularized + IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF"); +package ${SCHEMA_CLASS}::Bar; + +__PACKAGE__->has_one('foorel', 'DBIXCSL_Test::Schema::Foos', + { 'foreign.fooid' => 'self.foo_id' }); + 1; EOF @@ -78,10 +94,19 @@ EOF like $warning, qr/Detected external content/i, 'detected external content warning'; - is eval { $schema->resultset('Quux')->find(1)->a_method }, 'hlagh', + lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'hlagh' } 'external custom content for unsingularized Result was loaded by upgraded ' . 'dynamic Schema'; + lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel, + $res->{classes}{bazs} } + 'unsingularized class names in external content are translated'; + + lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel, + $res->{classes}{foos} } +'unsingularized class names in external content from unchanged Result class ' . +'names are translated'; + run_v5_tests($res); rmtree $temp_dir; @@ -96,9 +121,24 @@ EOF my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS; make_path $external_result_dir; + # make external content for Result that will be singularized IO::File->new(">$external_result_dir/Quuxs.pm")->print(<<"EOF"); package ${SCHEMA_CLASS}::Quuxs; sub a_method { 'dongs' } + +__PACKAGE__->has_one('bazrel2', 'DBIXCSL_Test::Schema::Bazs', + { 'foreign.baz_num' => 'self.baz_id' }); + +1; +EOF + + # make external content for Result that will NOT be singularized + IO::File->new(">$external_result_dir/Bar.pm")->print(<<"EOF"); +package ${SCHEMA_CLASS}::Bar; + +__PACKAGE__->has_one('foorel2', 'DBIXCSL_Test::Schema::Foos', + { 'foreign.fooid' => 'self.foo_id' }); + 1; EOF @@ -109,10 +149,19 @@ EOF run_v5_tests($res); - is eval { $schema->resultset('Quux')->find(1)->a_method }, 'dongs', + lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'dongs' } 'external custom content for unsingularized Result was loaded by upgraded ' . 'static Schema'; + lives_and { isa_ok $schema->resultset('Quux')->find(1)->bazrel2, + $res->{classes}{bazs} } + 'unsingularized class names in external content are translated'; + + lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel2, + $res->{classes}{foos} } +'unsingularized class names in external content from unchanged Result class ' . +'names are translated in static schema'; + my $file = $schema->_loader->_get_dump_filename($res->{classes}{quuxs}); my $code = do { local ($/, @ARGV) = (undef, $file); <> }; @@ -126,7 +175,7 @@ EOF pop @INC; } -# test running against v4 schema without upgrade +# test running against v4 schema without upgrade, twice, then upgrade { write_v4_schema_pm(); @@ -155,7 +204,12 @@ EOF while (<>) { if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) { print; - print "sub a_method { 'mtfnpy' }\n"; + print <has_one('bazrel3', 'DBIXCSL_Test::Schema::Bazs', + { 'foreign.baz_num' => 'self.baz_id' }); +EOF } else { print; @@ -163,6 +217,11 @@ EOF } } + # Rerun the loader in backcompat mode to make sure it's still in backcompat + # mode. + $res = run_loader(dump_directory => $DUMP_DIR); + run_v4_tests($res); + # now upgrade the schema $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current'); $schema = $res->{schema}; @@ -186,8 +245,69 @@ EOF 'un-singularized results were replaced during upgrade'; # check that custom content was preserved - is eval { $schema->resultset('Quux')->find(1)->a_method }, 'mtfnpy', + 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 upgrading an already singular result with custom content that refers to +# old class names. +{ + write_v4_schema_pm(); + my $res = run_loader(dump_directory => $DUMP_DIR); + my $schema = $res->{schema}; + run_v4_tests($res); + + # add some custom content to a Result that will be replaced + my $bar_pm = $schema->_loader + ->_get_dump_filename($res->{classes}{bar}); + { + local ($^I, @ARGV) = ('', $bar_pm); + while (<>) { + if (/DO NOT MODIFY THIS OR ANYTHING ABOVE/) { + print; + print <has_one('foorel3', 'DBIXCSL_Test::Schema::Foos', + { 'foreign.fooid' => 'self.foo_id' }); +EOF + } + else { + print; + } + } + } + + # now upgrade the schema + $res = run_loader(dump_directory => $DUMP_DIR, naming => 'current'); + $schema = $res->{schema}; + run_v5_tests($res); + + # check that custom content was preserved + lives_and { is $schema->resultset('Bar')->find(1)->a_method, 'lalala' } + 'custom content was preserved from Result pre-upgrade'; + + lives_and { isa_ok $schema->resultset('Bar')->find(1)->foorel3, + $res->{classes}{foos} } +'unsingularized class names in custom content from Result with unchanged ' . +'name are translated'; + + my $file = $schema->_loader->_get_dump_filename($res->{classes}{bar}); + my $code = do { local ($/, @ARGV) = (undef, $file); <> }; + + like $code, qr/sub a_method { 'lalala' }/, +'custom content from Result with unchanged name loaded into static dump ' . +'correctly'; } done_testing; diff --git a/t/lib/make_dbictest_db2.pm b/t/lib/make_dbictest_db2.pm index 5a00179..f927da6 100644 --- a/t/lib/make_dbictest_db2.pm +++ b/t/lib/make_dbictest_db2.pm @@ -20,7 +20,7 @@ $dbh->do($_) for ( )|, q|CREATE TABLE bar ( barid INTEGER PRIMARY KEY, - foo_id INTEGER REFERENCES foos (fooid) + foo_id INTEGER NOT NULL REFERENCES foos (fooid) )|, q|CREATE TABLE bazs ( bazid INTEGER PRIMARY KEY,