[Bast-commits] r5256 - in branches/DBIx-Class-Schema-Loader/no-rewrite: lib/DBIx/Class/Schema/Loader t

acmoore at dev.catalyst.perl.org acmoore at dev.catalyst.perl.org
Fri Dec 19 18:31:10 GMT 2008


Author: acmoore
Date: 2008-12-19 18:31:10 +0000 (Fri, 19 Dec 2008)
New Revision: 5256

Modified:
   branches/DBIx-Class-Schema-Loader/no-rewrite/lib/DBIx/Class/Schema/Loader/Base.pm
   branches/DBIx-Class-Schema-Loader/no-rewrite/t/23dumpmore.t
Log:
Prevent Schema::Loader from overwriting unchanged schema files

previously, the make_schema_at feature of Schema::Loader would overwrite
files in the dump_to_dir regardless of whether the underlying database
schema had changed or not. This patch causes Schema::Loader to check
the contents of the current file with the newly created schema from the
database. The file is only overwritten if the two differ. This means
that the old timestamp and creation date are preserved.


Modified: branches/DBIx-Class-Schema-Loader/no-rewrite/lib/DBIx/Class/Schema/Loader/Base.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/no-rewrite/lib/DBIx/Class/Schema/Loader/Base.pm	2008-12-19 18:25:21 UTC (rev 5255)
+++ branches/DBIx-Class-Schema-Loader/no-rewrite/lib/DBIx/Class/Schema/Loader/Base.pm	2008-12-19 18:31:10 UTC (rev 5256)
@@ -502,6 +502,13 @@
 
     my $custom_content = $self->_get_custom_content($class, $filename);
 
+    # only re-write the file if new content ($text) is different from old ($custom_content)
+    if ( $custom_content ) {
+        my $no_timestamp = $custom_content;
+        $no_timestamp =~ s/^# Created by DBIx::Class::Schema::Loader.*//;
+        return if ($no_timestamp eq $text);
+    }
+
     $custom_content ||= qq|\n\n# You can replace this text with custom|
         . qq| content, and it will be preserved on regeneration|
         . qq|\n1;\n|;

Modified: branches/DBIx-Class-Schema-Loader/no-rewrite/t/23dumpmore.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/no-rewrite/t/23dumpmore.t	2008-12-19 18:25:21 UTC (rev 5255)
+++ branches/DBIx-Class-Schema-Loader/no-rewrite/t/23dumpmore.t	2008-12-19 18:31:10 UTC (rev 5256)
@@ -7,7 +7,7 @@
 
 $^O eq 'MSWin32'
     ? plan(skip_all => "ActiveState perl produces additional warnings, and this test uses unix paths")
-    : plan(tests => 82);
+    : plan(tests => 91);
 
 my $DUMP_PATH = './t/_dump';
 
@@ -52,6 +52,34 @@
         my $src_file = $schema_path . '/' . $src . '.pm';
         dump_file_not_like($src_file, @{$file_neg_regexes->{$src}});
     }
+
+    my $current_md5sums = {}; # keep track of the md5sums we make so we can return them.
+    my $file_md5sum_equals = $tdata{md5sum_equals} || {};
+    foreach my $src (keys %$file_md5sum_equals) {
+        my $src_file;
+        if ($src eq 'schema' ) {
+            $src_file = $schema_path . '.pm';
+        } else {
+            $src_file = $schema_path . '/' . $src . '.pm';
+        }
+        my $current_md5sum = get_md5sum_from_dump_file($src_file);
+        is( $current_md5sum, $file_md5sum_equals->{$src}, "found the same md5sum ($current_md5sum) for file $src_file" );
+        $current_md5sums->{$src} = $current_md5sum;
+    }
+
+    my $file_md5sum_ne = $tdata{md5sum_ne} || {};
+    foreach my $src (keys %$file_md5sum_ne) {
+        my $src_file;
+        if ($src eq 'schema' ) {
+            $src_file = $schema_path . '.pm';
+        } else {
+            $src_file = $schema_path . '/' . $src . '.pm';
+        }
+        my $current_md5sum = get_md5sum_from_dump_file($src_file);
+        isnt( $current_md5sum, $file_md5sum_equals->{$src}, "found different md5sum ($current_md5sum) for file $src_file" );
+        $current_md5sums->{$src} = $current_md5sum;
+    }
+    return { md5sums => $current_md5sums };
 }
 
 sub dump_file_like {
@@ -79,9 +107,20 @@
     close($appendfh);
 }
 
+sub get_md5sum_from_dump_file {
+    my $path = shift;
+    open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
+    my $contents = do { local $/; <$dumpfh>; };
+    close($dumpfh);
+    if ( $contents =~ /md5sum:([^\s]+)/ ) {
+        return $1;
+    }
+    return;
+}
+
 rmtree($DUMP_PATH, 1, 1);
 
-do_dump_test(
+my $dumped = do_dump_test(
     classname => 'DBICTest::DumpMore::1',
     options => { },
     error => '',
@@ -105,11 +144,16 @@
             qr/1;\n$/,
         ],
     },
+    md5sum_ne => {
+                  schema => '',
+                  Foo    => '',
+                  Bar    => '',
+              },
 );
 
 append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX});
 
-do_dump_test(
+$dumped = do_dump_test(
     classname => 'DBICTest::DumpMore::1',
     options => { },
     error => '',
@@ -133,9 +177,10 @@
             qr/1;\n$/,
         ],
     },
+    md5sum_equals => $dumped->{'md5sums'},
 );
 
-do_dump_test(
+$dumped = do_dump_test(
     classname => 'DBICTest::DumpMore::1',
     options => { really_erase_my_files => 1 },
     error => '',
@@ -167,6 +212,7 @@
             qr/# XXX This is my custom content XXX/,
         ],
     },
+    md5sum_ne => $dumped->{'md5sums'},
 );
 
 do_dump_test(




More information about the Bast-commits mailing list