From: Rafael Kitover Date: Tue, 29 Dec 2009 14:38:40 +0000 (+0000) Subject: load custom content from external un-singularized classes, tested for dynamic schema... X-Git-Tag: 0.04999_13~19 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-Schema-Loader.git;a=commitdiff_plain;h=ffc705f30a24e37a4bcbe81a1d26b1556232efec load custom content from external un-singularized classes, tested for dynamic schema needs a test for static schema --- diff --git a/TODO-BACKCOMPAT b/TODO-BACKCOMPAT index 1141078..fd763d6 100644 --- a/TODO-BACKCOMPAT +++ b/TODO-BACKCOMPAT @@ -2,9 +2,8 @@ SL Backcompat Plan: *** 0.04006 mode -* get custom content from un-singularized classes in _load_external, with an - appropriate comment that it's during upgrade only, for both static and - dynamic schemas +* test getting custom content from un-singularized classes in _load_external + for a static schema * make use_namespaces the default, and upgrade to it properly diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 0997ad7..516a402 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -478,39 +478,94 @@ sub _find_class_in_inc { sub _load_external { my ($self, $class) = @_; + # so that we don't load our own classes, under any circumstances + local *INC = [ grep $_ ne $self->dump_directory, @INC ]; + my $real_inc_path = $self->_find_class_in_inc($class); - return if !$real_inc_path; - - # If we make it to here, we loaded an external definition - warn qq/# Loaded external class definition for '$class'\n/ - if $self->debug; - - 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, $_); + my $old_class = $self->_upgrading_classes->{$class} + if $self->_upgrading_from; + + my $old_real_inc_path = $self->_find_class_in_inc($old_class) + if $old_class && $old_class ne $class; + + return unless $real_inc_path || $old_real_inc_path; + + if ($real_inc_path) { + # If we make it to here, we loaded an external definition + warn qq/# Loaded external class definition for '$class'\n/ + if $self->debug; + + 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' | + ); + close($fh) + or croak "Failed to close $real_inc_path: $!"; + + if ($self->dynamic) { # load the class too + # kill redefined warnings + local $SIG{__WARN__} = sub { + warn @_ unless $_[0] =~ /^Subroutine \S+ redefined/; + }; + do $real_inc_path; + die $@ if $@; + } } - $self->_ext_stmt($class, - qq|# End of lines loaded from '$real_inc_path' | - ); - close($fh) - or croak "Failed to close $real_inc_path: $!"; - if ($self->dynamic) { # load the class too - # turn off redefined warnings - local $SIG{__WARN__} = sub {}; - do $real_inc_path; - die $@ if $@; + if ($old_real_inc_path) { + open(my $fh, '<', $old_real_inc_path) + or croak "Failed to open '$old_real_inc_path' for reading: $!"; + $self->_ext_stmt($class, <<"EOF"); + +# These lines were loaded from '$old_real_inc_path', based on the Result class +# name that would have been created by an 0.04006 version of the Loader. For a +# static schema, this happens only once during upgrade. +EOF + if ($self->dynamic) { + warn <<"EOF"; + +Detected external content in '$old_real_inc_path', a class name that would have +been used by an 0.04006 version of the Loader. + +* PLEASE RENAME THIS CLASS: from '$old_class' to '$class', as that is the +new name of the Result. +EOF + # kill redefined warnings + local $SIG{__WARN__} = sub { + warn @_ unless $_[0] =~ /^Subroutine \S+ redefined/; + }; + my $code = do { + local ($/, @ARGV) = (undef, $old_real_inc_path); <> + }; + $code =~ s/$old_class/$class/g; + eval $code; + die $@ if $@; + } + + while(<$fh>) { + chomp; + $self->_ext_stmt($class, $_); + } + $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: $!"; } } @@ -608,7 +663,7 @@ sub _load_tables { $self->{quiet} = 0; # Remove that temp dir from INC so it doesn't get reloaded - @INC = grep { $_ ne $self->{dump_directory} } @INC; + @INC = grep $_ ne $self->dump_directory, @INC; } $self->_load_external($_) @@ -797,11 +852,15 @@ sub _write_classfile { my $old_filename = $self->_get_dump_filename($old_class); my ($old_custom_content) = $self->_get_custom_content( - $old_class, $old_filename + $old_class, $old_filename, 0 # do not add default comment ); - $custom_content .= "\n" . $old_custom_content - if $old_custom_content; + $old_custom_content =~ s/\n\n# You can replace.*\n1;\n//; + + if ($old_custom_content) { + $custom_content = + "\n" . $old_custom_content . "\n" . $custom_content; + } unlink $old_filename; } @@ -851,7 +910,9 @@ sub _default_custom_content { } sub _get_custom_content { - my ($self, $class, $filename) = @_; + my ($self, $class, $filename, $add_default) = @_; + + $add_default = 1 unless defined $add_default; return ($self->_default_custom_content) if ! -f $filename; @@ -887,7 +948,7 @@ sub _get_custom_content { if !$md5; # Default custom content: - $buffer ||= $self->_default_custom_content; + $buffer ||= $self->_default_custom_content if $add_default; return ($buffer, $md5, $ver, $ts); } @@ -1195,6 +1256,13 @@ sub _quote_table_name { sub _is_case_sensitive { 0 } +# remove the dump dir from @INC on destruction +sub DESTROY { + my $self = shift; + + @INC = grep $_ ne $self->dump_directory, @INC; +} + =head2 monikers Returns a hashref of loaded table to moniker mappings. There will diff --git a/t/25backcompat_v4.t b/t/25backcompat_v4.t index c67c7fb..b4a6f74 100644 --- a/t/25backcompat_v4.t +++ b/t/25backcompat_v4.t @@ -3,6 +3,8 @@ use warnings; use Test::More; use File::Path qw/rmtree make_path/; use Class::Unload; +use File::Temp qw/tempfile tempdir/; +use IO::File; use lib qw(t/lib); use make_dbictest_db2; @@ -59,7 +61,9 @@ sub run_v4_tests { [qw/Foos Bar Bazs Quuxs/], 'correct monikers in 0.04006 mode'; - ok my $bar = eval { $schema->resultset('Bar')->find(1) }; + isa_ok ((my $bar = eval { $schema->resultset('Bar')->find(1) }), + $res->{classes}{bar}, + 'found a bar'); isa_ok eval { $bar->foo_id }, $res->{classes}{foos}, 'correct rel name in 0.04006 mode'; @@ -130,6 +134,41 @@ sub run_v5_tests { run_v5_tests($res); } +# test upgraded dynamic schema with external content loaded +{ + my $temp_dir = tempdir; + push @INC, $temp_dir; + + my $external_result_dir = join '/', $temp_dir, split /::/, $SCHEMA_CLASS; + make_path $external_result_dir; + + IO::File->new(">$external_result_dir/Quuxs.pm")->print(<<"EOF"); +package ${SCHEMA_CLASS}::Quuxs; +sub a_method { 'hlagh' } +1; +EOF + + my $res = run_loader(naming => 'current'); + my $schema = $res->{schema}; + + is scalar @{ $res->{warnings} }, 1, +'correct nummber of warnings for upgraded dynamic schema with external ' . +'content for unsingularized Result.'; + + my $warning = $res->{warnings}[0]; + like $warning, qr/Detected external content/i, + 'detected external content warning'; + + is eval { $schema->resultset('Quux')->find(1)->a_method }, 'hlagh', +'external custom content for unsingularized Result was loaded by upgraded ' . +'dynamic Schema'; + + run_v5_tests($res); + + rmtree $temp_dir; + pop @INC; +} + # test running against v4 schema without upgrade { # write out the 0.04006 Schema.pm we have in __DATA__ @@ -153,6 +192,9 @@ sub run_v5_tests { like $warning, qr/DBIx::Class::Schema::Loader::Manual::UpgradingFromV4/, 'refers to upgrading doc'; + is scalar @{ $res->{warnings} }, 3, + '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 @@ -201,7 +243,9 @@ sub run_v5_tests { done_testing; -END { rmtree $DUMP_DIR } +END { + rmtree $DUMP_DIR unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}; +} # a Schema.pm made with 0.04006