[Bast-commits] r3155 - in branches/DBIx-Class-Schema-Loader/current: . lib/DBIx/Class/Schema/Loader t

blblack at dev.catalyst.perl.org blblack at dev.catalyst.perl.org
Fri Mar 30 01:53:11 GMT 2007


Author: blblack
Date: 2007-03-30 01:53:01 +0100 (Fri, 30 Mar 2007)
New Revision: 3155

Modified:
   branches/DBIx-Class-Schema-Loader/current/Build.PL
   branches/DBIx-Class-Schema-Loader/current/Changes
   branches/DBIx-Class-Schema-Loader/current/TODO
   branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
   branches/DBIx-Class-Schema-Loader/current/t/22dump.t
Log:
preserve local changes to generated files by default (still needs tests)

Modified: branches/DBIx-Class-Schema-Loader/current/Build.PL
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/Build.PL	2007-03-29 22:20:10 UTC (rev 3154)
+++ branches/DBIx-Class-Schema-Loader/current/Build.PL	2007-03-30 00:53:01 UTC (rev 3155)
@@ -11,6 +11,7 @@
         'UNIVERSAL::require'            => 0.10,
         'Lingua::EN::Inflect::Number'   => 1.1,
         'Text::Balanced'                => 0,
+        'Digest::MD5'                   => 2.36,
         'Class::Accessor'               => 0.27,
         'Class::Data::Accessor'         => 0.02,
         'Class::C3'                     => 0.11,

Modified: branches/DBIx-Class-Schema-Loader/current/Changes
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/Changes	2007-03-29 22:20:10 UTC (rev 3154)
+++ branches/DBIx-Class-Schema-Loader/current/Changes	2007-03-30 00:53:01 UTC (rev 3155)
@@ -1,5 +1,7 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - Made dump_to_dir / dump_overwrite much more intelligent
+          (they now preserve customizations by default)
         - Added support for DBI's new standard "statistics_info"
           method to gather unique key info (only supported by
           DBD::Pg trunk + DBI >= 1.52 so far)

Modified: branches/DBIx-Class-Schema-Loader/current/TODO
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/TODO	2007-03-29 22:20:10 UTC (rev 3154)
+++ branches/DBIx-Class-Schema-Loader/current/TODO	2007-03-30 00:53:01 UTC (rev 3155)
@@ -2,8 +2,6 @@
 immediate stuff for 0.04:
 --------------------------
 
-dump_to_dir needs to delimit its output so that it can update on overwrite without killing added things
-
 avinash240 wants a rescan method to pick up new tables at runtime
 
 -------

Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm	2007-03-29 22:20:10 UTC (rev 3154)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm	2007-03-30 00:53:01 UTC (rev 3155)
@@ -10,6 +10,7 @@
 use Data::Dump qw/ dump /;
 use POSIX qw//;
 use File::Spec qw//;
+use Digest::MD5 qw//;
 require DBIx::Class;
 
 our $VERSION = '0.03999_01';
@@ -150,11 +151,7 @@
 
 The created schema class will have the same classname as the one on
 which you are setting this option (and the ResultSource classes will be
-based on this name as well).  Therefore it is wise to note that if you
-point the C<dump_directory> option of a schema class at the live libdir
-where that class is currently located, it will overwrite itself with a
-manual version of itself.  This might be a really good or bad thing
-depending on your situation and perspective.
+based on this name as well).
 
 Normally you wouldn't hard-code this setting in your schema class, as it
 is meant for one-time manual usage.
@@ -164,10 +161,19 @@
 
 =head2 dump_overwrite
 
-If set to a true value, the dumping code will overwrite existing files.
-The default is false, which means the dumping code will skip the already
-existing files.
+Default false.  If true, Loader will unconditionally delete any existing
+files before creating the new ones from scratch when dumping a schema to disk.
 
+The default behavior is instead to only replace the top portion of the
+file, up to and including the final stanza which contains
+C<# DO NOT MODIFY THIS OR ANYTHING ABOVE!>
+leaving any customizations you placed after that as they were.
+
+When C<dump_overwrite> is not set, if the output file already exists,
+but the aforementioned final stanza is not found, or the checksum
+contained there does not match the generated contents, Loader will
+croak and not touch the file.
+
 =head1 METHODS
 
 None of these methods are intended for direct invocation by regular
@@ -230,38 +236,44 @@
     $abs_dump_dir = File::Spec->rel2abs($self->dump_directory)
         if $self->dump_directory;
 
-    foreach my $table_class (values %{$self->classes}) {
-        $table_class->require;
+    foreach my $class ($self->schema_class, values %{$self->classes}) {
+        $class->require;
         if($@ && $@ !~ /^Can't locate /) {
             croak "Failed to load external class definition"
-                  . " for '$table_class': $@";
+                  . " for '$class': $@";
         }
         next if $@; # "Can't locate" error
 
         # If we make it to here, we loaded an external definition
-        warn qq/# Loaded external class definition for '$table_class'\n/
+        warn qq/# Loaded external class definition for '$class'\n/
             if $self->debug;
 
         if($abs_dump_dir) {
-            my $class_path = $table_class;
+            my $class_path = $class;
             $class_path =~ s{::}{/}g;
             $class_path .= '.pm';
             my $filename = File::Spec->rel2abs($INC{$class_path});
             croak 'Failed to locate actual external module file for '
-                  . "'$table_class'"
+                  . "'$class'"
                       if !$filename;
+            # XXX this should be done MUCH EARLIER, do not require dump_dir files!!!
             next if($filename =~ /^$abs_dump_dir/);
             open(my $fh, '<', $filename)
                 or croak "Failed to open $filename for reading: $!";
-            $self->_raw_stmt($table_class,
-                q|# These lines loaded from user-supplied external file: |
+            $self->_ext_stmt($class,
+                qq|# These lines were loaded from '$filename' found in \@INC.|
+                .q|# They are now part of the custom portion of this file|
+                .q|# for you to hand-edit.  If you do not either delete|
+                .q|# this section or remove that file from @INC, this section|
+                .q|# will be repeated redundantly when you re-create this|
+                .q|# file again via Loader!|
             );
             while(<$fh>) {
                 chomp;
-                $self->_raw_stmt($table_class, $_);
+                $self->_ext_stmt($class, $_);
             }
-            $self->_raw_stmt($table_class,
-                q|# End of lines loaded from user-supplied external file |
+            $self->_ext_stmt($class,
+                q|# End of lines loaded from '$filename' |
             );
             close($fh)
                 or croak "Failed to close $filename: $!";
@@ -304,11 +316,12 @@
                      # which is a filename
 
     my $dir = $self->dump_directory;
-    foreach (@name_parts) {
-        $dir = File::Spec->catdir($dir,$_);
-        if(! -d $dir) {
+    while (1) {
+        if(!-d $dir) {
             mkdir($dir) or croak "mkdir('$dir') failed: $!";
         }
+        last if !@name_parts;
+        $dir = File::Spec->catdir($dir, shift @name_parts);
     }
 }
 
@@ -323,52 +336,100 @@
 
     warn "Dumping manual schema for $schema_class to directory $target_dir ...\n";
 
-    if(! -d $target_dir) {
-        mkdir($target_dir) or croak "mkdir('$target_dir') failed: $!";
+    my $schema_text =
+          qq|package $schema_class;\n\n|
+        . qq|use strict;\nuse warnings;\n\n|
+        . qq|use base 'DBIx::Class::Schema';\n\n|
+        . qq|__PACKAGE__->load_classes;\n|;
+
+    $self->_write_classfile($schema_class, $schema_text);
+
+    foreach my $src_class (sort keys %{$self->{_dump_storage}}) {
+        my $src_text = 
+              qq|package $src_class;\n\n|
+            . qq|use strict;\nuse warnings;\n\n|
+            . qq|use base 'DBIx::Class';\n\n|;
+
+        $self->_write_classfile($src_class, $src_text);
     }
 
-    my $verstr = $DBIx::Class::Schema::Loader::VERSION;
-    my $datestr = POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime);
-    my $tagline = qq|# Created by DBIx::Class::Schema::Loader v$verstr @ $datestr|;
+    warn "Schema dump completed.\n";
+}
 
-    $self->_ensure_dump_subdirs($schema_class);
+sub _write_classfile {
+    my ($self, $class, $text) = @_;
 
-    my $schema_fn = $self->_get_dump_filename($schema_class);
-    if (-f $schema_fn && !$self->dump_overwrite) {
-        warn "$schema_fn exists, will not overwrite\n";
+    my $filename = $self->_get_dump_filename($class);
+    $self->_ensure_dump_subdirs($class);
+
+    if (-f $filename && $self->dump_overwrite) {
+        warn "Deleting existing file '$filename' due to "
+            . "'dump_overwrite' setting\n";
+        unlink($filename);
+    }    
+
+    my $custom_content = (-f $filename)
+        ? $self->_get_custom_content($filename)
+        : undef;
+
+    $custom_content ||= qq|\n# You can replace this text with custom|
+        . qq| content, and it will be preserved on regeneration|
+        . qq|\n1;\n|;
+
+    $text .= qq|$_\n|
+        for @{$self->{_dump_storage}->{$class} || []};
+
+    $text .= qq|\n\n# Created by DBIx::Class::Schema::Loader|
+        . qq| v| . $DBIx::Class::Schema::Loader::VERSION
+        . q| @ | . POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
+        . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
+
+    open(my $fh, '>', $filename)
+        or croak "Cannot open '$filename' for writing: $!";
+
+    # Write the top half and its MD5 sum
+    print $fh $text . Digest::MD5::md5_base64($text) . "\n\n";
+
+    # Write out anything loaded via external partial class file in @INC
+    print $fh qq|$_\n|
+        for @{$self->{_ext_storage}->{$class} || []};
+
+    print $fh $custom_content;
+
+    close($fh)
+        or croak "Cannot close '$filename': $!";
+}
+
+sub _get_custom_content {
+    my ($self, $class, $filename) = @_;
+
+    return if ! -f $filename;
+    open(my $fh, '<', $filename)
+        or croak "Cannot open '$filename' for reading: $!";
+
+    my $mark_re = 
+        /^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\n/;
+
+    my $found = 0;
+    my $buffer = '';
+    while(<$fh>) {
+        if(!$found && /$mark_re/) {
+            $found = 1;
+            $buffer .= $1;
+            $checksum = $2;
+            croak "Checksum mismatch in '$filename'"
+                if Digest::MD5::md5_base64($buffer) ne $checksum;
+
+            $buffer = '';
+        }
+        else {
+            $buffer .= $_;
+        }
     }
-    else {
-        open(my $schema_fh, '>', $schema_fn)
-            or croak "Cannot open $schema_fn for writing: $!";
-        print $schema_fh qq|package $schema_class;\n\n$tagline\n\n|;
-        print $schema_fh qq|use strict;\nuse warnings;\n\n|;
-        print $schema_fh qq|use base 'DBIx::Class::Schema';\n\n|;
-        print $schema_fh qq|__PACKAGE__->load_classes;\n|;
-        print $schema_fh qq|\n1;\n\n|;
-        close($schema_fh)
-            or croak "Cannot close $schema_fn: $!";
-    }
 
-    foreach my $src_class (sort keys %{$self->{_dump_storage}}) {
-        $self->_ensure_dump_subdirs($src_class);
-        my $src_fn = $self->_get_dump_filename($src_class);
-        if (-f $src_fn && !$self->dump_overwrite) {
-            warn "$src_fn exists, will not overwrite\n";
-            next;
-        }    
-        open(my $src_fh, '>', $src_fn)
-            or croak "Cannot open $src_fn for writing: $!";
-        print $src_fh qq|package $src_class;\n\n$tagline\n\n|;
-        print $src_fh qq|use strict;\nuse warnings;\n\n|;
-        print $src_fh qq|use base 'DBIx::Class';\n\n|;
-        print $src_fh qq|$_\n|
-            for @{$self->{_dump_storage}->{$src_class}};
-        print $src_fh qq|\n1;\n\n|;
-        close($src_fh)
-            or croak "Cannot close $src_fn: $!";
+    if(!$found) {
     }
-
-    warn "Schema dump completed.\n";
+    return $buffer;
 }
 
 sub _use {
@@ -589,6 +650,12 @@
     push(@{$self->{_dump_storage}->{$class}}, $stmt) if $self->dump_directory;
 }
 
+# Like above, but separately for the externally loaded stuff
+sub _ext_stmt {
+    my ($self, $class, $stmt) = @_;
+    push(@{$self->{_ext_storage}->{$class}}, $stmt) if $self->dump_directory;
+}
+
 =head2 monikers
 
 Returns a hashref of loaded table to moniker mappings.  There will

Modified: branches/DBIx-Class-Schema-Loader/current/t/22dump.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/22dump.t	2007-03-29 22:20:10 UTC (rev 3154)
+++ branches/DBIx-Class-Schema-Loader/current/t/22dump.t	2007-03-30 00:53:01 UTC (rev 3155)
@@ -25,7 +25,7 @@
     );
 }
 
-plan tests => 8;
+plan tests => 5;
 
 rmtree($dump_path, 1, 1);
 
@@ -45,7 +45,6 @@
   }
   my @warnings_regexes = (
       qr|Dumping manual schema|,
-      (qr|DBICTest/Schema/1.*?.pm exists, will not overwrite|) x 3,
       qr|Schema dump completed|,
   );
 
@@ -63,4 +62,4 @@
 ok(!$@, 'no death with dump_directory set (overwrite2)')
     or diag "Dump failed: $@";
 
-END { rmtree($dump_path, 1, 1); }
+# END { rmtree($dump_path, 1, 1); }




More information about the Bast-commits mailing list