$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;
-
+ if ($real_md5 ne $mark_md5) {
+ if ($self->overwrite_modifications) {
+ # Setting this to something that is not a valid MD5 forces
+ # the file to be rewritten.
+ $real_md5 = 'not an MD5';
+ }
+ else {
+ 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";
+ }
+ }
last;
}
else {
ok( -f $foopm, 'looks like it dumped' );
# now modify one of the files
-{
- open my $in, '<', $foopm or die "$! reading $foopm";
- my ($tfh,$temp) = tempfile( UNLINK => 1);
- while(<$in>) {
- s/"bars"/"somethingelse"/;
- print $tfh $_;
- }
- close $tfh;
- copy( $temp, $foopm );
-}
+rewrite_file($foopm, qr{"bars"}, q{"somethingelse"});
# and dump again without overwrites
throws_ok {
dump_schema( overwrite_modifications => 1 );
} 'does not throw when dumping with overwrite_modifications';
+# Replace the md5 with a bad MD5 in Foo.pm
+my $foopm_content = slurp_file($foopm);
+my ($md5) = $foopm_content =~/md5sum:(.+)$/m;
+# This cannot be just any arbitrary value, it has to actually look like an MD5
+# value or DBICSL doesn't even see it as an MD5 at all (which makes sense).
+my $bad_md5 = reverse $md5;
+rewrite_file($foopm, qr{md5sum:.+$}, "md5sum:$bad_md5");
+
+# and dump again without overwrites
+throws_ok {
+ dump_schema();
+} qr/mismatch/, 'throws error dumping without overwrite_modifications';
-unlike slurp_file $foopm, qr/"somethingelse"/, "Modifications actually overwritten";
+$foopm_content = slurp_file($foopm);
+like(
+ $foopm_content,
+ qr/\Q$bad_md5/,
+ 'bad MD5 is not rewritten when overwrite_modifications is false'
+);
+
+# and then dump with overwrite
+lives_ok {
+ dump_schema( overwrite_modifications => 1 );
+} 'does not throw when dumping with overwrite_modifications';
+
+$foopm_content = slurp_file($foopm);
+unlike(
+ $foopm_content,
+ qr/\Q$bad_md5/,
+ 'bad MD5 is rewritten when overwrite_modifications is true'
+);
sub dump_schema {
{ dump_directory => $tempdir, @$args },
[ $make_dbictest_db::dsn ],
);
- } [qr/^Dumping manual schema/, qr/^Schema dump completed/ ];
+ } [qr/^Dumping manual schema/, qr/^Schema dump completed/ ],
+ 'schema was dumped with expected warnings';
+}
+
+sub rewrite_file {
+ my ($file, $match, $replace) = @_;
+
+ open my $in, '<', $file or die "$! reading $file";
+ my ($tfh, $temp) = tempfile( UNLINK => 1 );
+ while(<$in>) {
+ s/$match/$replace/;
+ print $tfh $_;
+ }
+ close $tfh;
+ copy( $temp, $file );
}
done_testing();