From: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
Date: Thu, 17 Sep 2015 22:12:51 +0000 (+0100)
Subject: THROWAWAY: Don't load unmodified generated external classes
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bac32da1dfa1d3cf12ba439a210421f722ce43dd;hp=c2ecce69c18f38fd94402e3ad235fbc25a0a8a00;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

THROWAWAY: Don't load unmodified generated external classes

Loading external classes is only useful in dynamic mode, or when
transitioning to static mode, and loading code we generated ourselves is
never useful.

However, mst pointed out a better approach on IRC, so this commit is
only so I can pick it up from elsewhere and change it to this approach:

> I would argue that if the installed thing has a Schema::Loader md5 in
> it, you should ignore it, and you should only bring custom code in if
> you're writing new files.

> That should handle the dynamic->static transition case, and then you can
> just output a warning or something if you see an extra file but ignore
> it, with a note of "turn option X on if you really wanted this".
---

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 3b14622..0e3c555 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -158,6 +158,9 @@ of relationships.
 Skip loading of other classes in @INC. The default is to merge all other classes
 with the same name found in @INC into the schema file we are creating.
 
+Even if this is not set, code generated by this module and not
+subsequently modified is never included.
+
 =head2 naming
 
 Static schemas (ones dumped to disk) will, by default, use the new-style
@@ -1561,24 +1564,34 @@ sub _load_external {
 
         my $code = $self->_rewrite_old_classnames(slurp_file $real_inc_path);
 
-        if ($self->dynamic) { # load the class too
-            eval_package_without_redefine_warnings($class, $code);
+        if (my ($gen, $real_md5, $ver, $ts, $custom) = try {
+            local $self->{overwrite_modifications} = 0;
+            $self->_parse_generated_code($real_inc_path, $code);
+        }) {
+            # Ignore unmodified generated code.
+            $code = $custom eq $self->_default_custom_content ? '' : $custom;
         }
 
-        $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!  See skip_load_external to disable\n|
-           .qq|# this feature.\n|
-        );
-        chomp $code;
-        $self->_ext_stmt($class, $code);
-        $self->_ext_stmt($class,
-            qq|# End of lines loaded from '$real_inc_path'|
-        );
+        if ($code) {
+            if ($self->dynamic) { # load the class too
+                eval_package_without_redefine_warnings($class, $code);
+            }
+
+            $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!  See skip_load_external to disable\n|
+               .qq|# this feature.\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) {
@@ -2228,43 +2241,33 @@ sub _parse_generated_file {
 
     return unless -f $fn;
 
-    open(my $fh, '<:encoding(UTF-8)', $fn)
-        or croak "Cannot open '$fn' for reading: $!";
-
-    my $mark_re =
-        qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\r?\n};
-
-    my ($real_md5, $ts, $ver, $gen);
-    local $_;
-    while(<$fh>) {
-        if(/$mark_re/) {
-            my $pre_md5 = $1;
-            my $mark_md5 = $2;
-
-            # Pull out the version and timestamp from the line above
-            ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader( v[\d.]+)?( @ [\d-]+ [\d:]+)?\r?\Z/m;
-            $ver =~ s/^ v// if $ver;
-            $ts =~ s/^ @ // if $ts;
-
-            $gen .= $pre_md5;
-            $real_md5 = Digest::MD5::md5_base64(encode 'UTF-8', $gen);
-            croak "Checksum mismatch in '$fn', the auto-generated part of the file has been modified outside of this loader.  Aborting.\nIf you want to overwrite these modifications, set the 'overwrite_modifications' loader option.\n"
-                if !$self->overwrite_modifications && $real_md5 ne $mark_md5;
-
-            last;
-        }
-        else {
-            $gen .= $_;
-        }
-    }
-
-    my $custom = do { local $/; <$fh> }
-        if $real_md5;
-
-    $custom ||= '';
-    $custom =~ s/$CRLF|$LF/\n/g;
-
-    close $fh;
+    return $self->_parse_generated_code($fn, slurp_file $fn);
+}
+
+sub _parse_generated_code {
+    my ($self, $fn, $code) = @_;
+
+    my ($gen, $ver, $ts, $mark_md5, $custom) = (
+        $code =~ m{
+            \A
+            (
+                .*                   # generated code
+                ^\# \Q Created by DBIx::Class::Schema::Loader\E
+                (\ v [\d.]+ )? (\ @\ [\d-]+\ [\d:]+)?\r?\n # verison/time stamp
+                ^\# \Q DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:\E
+            )
+            ([A-Za-z0-9/+]{22})\r?\n # checksum
+            (.*)                     # custom code
+            \z
+        }xms
+    ) or return;
+
+    $ver =~ s/^ v// if $ver;
+    $ts =~ s/^ @ // if $ts;
+
+    my $real_md5 = Digest::MD5::md5_base64(encode 'UTF-8', $gen);
+    croak "Checksum mismatch in '$fn', the auto-generated part of the file has been modified outside of this loader.  Aborting.\nIf you want to overwrite these modifications, set the 'overwrite_modifications' loader option.\n"
+        if !$self->overwrite_modifications && $real_md5 ne $mark_md5;
 
     return ($gen, $real_md5, $ver, $ts, $custom);
 }
diff --git a/t/23dumpmore.t b/t/23dumpmore.t
index 82c731d..8e03420 100644
--- a/t/23dumpmore.t
+++ b/t/23dumpmore.t
@@ -5,6 +5,7 @@ use DBIx::Class::Schema::Loader::Utils qw/slurp_file write_file/;
 use namespace::clean;
 use File::Temp ();
 use lib qw(t/lib);
+use dbixcsl_test_dir '$tdir';
 use dbixcsl_dumper_tests;
 my $t = 'dbixcsl_dumper_tests';
 
@@ -640,5 +641,38 @@ $t->dump_test(
     },
 );
 
+my $copy = $t->copy_class('DBICTest::DumpMore::1::Foo', 'dump_copy');
+diag $copy;
+unshift @INC, "$tdir/dump_copy";
+
+$t->dump_test(
+    classname => 'DBICTest::DumpMore::1',
+    neg_regexes => {
+        Foo => [
+            qr/^# These lines were loaded from/m,
+        ],
+    },
+);
+
+$t->append_to_class('DBICTest::DumpMore::1::Foo', qq{# XXX This is my external custom content\n}, 'dump_copy');
+
+$t->dump_test(
+    classname => 'DBICTest::DumpMore::1',
+    options => {
+        really_erase_my_files => 1,
+    },
+    regexes => {
+        Foo => [
+            qr/^# XXX This is my external custom content/m,
+        ],
+    },
+    neg_regexes => {
+        Foo => [
+            qr/^# These lines were loaded from.*^# Created by DBIx::Class::Schema::Loader/,
+        ],
+    },
+);
+
+
 done_testing;
 # vim:et sts=4 sw=4 tw=0:
diff --git a/t/lib/dbixcsl_dumper_tests.pm b/t/lib/dbixcsl_dumper_tests.pm
index 912cb17..c0e0bdf 100644
--- a/t/lib/dbixcsl_dumper_tests.pm
+++ b/t/lib/dbixcsl_dumper_tests.pm
@@ -3,6 +3,8 @@ package dbixcsl_dumper_tests;
 use strict;
 use warnings;
 use Test::More;
+use File::Basename;
+use File::Copy;
 use File::Path;
 use IPC::Open3;
 use IO::Handle;
@@ -14,25 +16,29 @@ use namespace::clean;
 
 use dbixcsl_test_dir '$tdir';
 
-my $DUMP_PATH = "$tdir/dump";
+my $SUB_DIR = 'dump';
+my $DUMP_PATH = "$tdir/$SUB_DIR";
 
 sub cleanup {
     rmtree($DUMP_PATH, 1, 1);
 }
 
 sub class_file {
-    my ($self, $class) = @_;
+    my ($self, $class, $subdir) = @_;
+
+    my $path = $DUMP_PATH;
+    $path =~ s/\Q$SUB_DIR\E\z/$subdir/ if $subdir;
 
     $class =~ s{::}{/}g;
-    $class = $DUMP_PATH . '/' . $class . '.pm';
+    $class = $path . '/' . $class . '.pm';
 
     return $class;
 }
 
 sub append_to_class {
-    my ($self, $class, $string) = @_;
+    my ($self, $class, $string, $destdir) = @_;
 
-    $class = $self->class_file($class);
+    $class = $self->class_file($class, $destdir);
 
     open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!";
 
@@ -41,6 +47,17 @@ sub append_to_class {
     close($appendfh);
 }
 
+sub copy_class {
+    my ($self, $class, $destdir) = @_;
+
+    my $srcfile = $self->class_file($class);
+    my $destfile = $self->class_file($class, $destdir);
+    mkpath(dirname $destfile);
+
+    copy($srcfile, $destfile) or die "Failed to copy '$srcfile' to '$destfile': $!";
+    return $destfile;
+}
+
 sub dump_test {
     my ($self, %tdata) = @_;