Versioning! With tests! Woo!

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI.pm

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index a0a34a8..4b63c4f 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -62,7 +62,6 @@ use Scalar::Util 'blessed';
 sub _find_syntax {
   my ($self, $syntax) = @_;
   my $dbhname = blessed($syntax) ?  $syntax->{Driver}{Name} : $syntax;
-#  print STDERR "Found DBH $syntax >$dbhname< ", $syntax->{Driver}->{Name}, "\n";
   if(ref($self) && $dbhname && $dbhname eq 'DB2') {
     return 'RowNumberOver';
   }
@@ -839,7 +838,7 @@ sub _execute {
     $self->throw_exception("'$sql' did not generate a statement.");
   }
   if ($self->debug) {
-      my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind; 
+      my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
       $self->debugobj->query_end($sql, @debug_bind);
   }
   return (wantarray ? ($rv, $sth, @bind) : $rv);
@@ -1080,7 +1079,7 @@ sub sqlt_type { shift->dbh->{Driver}->{Name} }
 
 =over 4
 
-=item Arguments: $schema \@databases, $version, $directory, $sqlt_args
+=item Arguments: $schema \@databases, $version, $directory, $preversion, $sqlt_args
 
 =back
 
@@ -1094,7 +1093,7 @@ across all databases, or fully handle complex relationships.
 
 sub create_ddl_dir
 {
-  my ($self, $schema, $databases, $version, $dir, $sqltargs) = @_;
+  my ($self, $schema, $databases, $version, $dir, $preversion, $sqltargs) = @_;
 
   if(!$dir || !-d $dir)
   {
@@ -1107,14 +1106,18 @@ sub create_ddl_dir
   $sqltargs = { ( add_drop_table => 1 ), %{$sqltargs || {}} };
 
   eval "use SQL::Translator";
-  $self->throw_exception("Can't deploy without SQL::Translator: $@") if $@;
+  $self->throw_exception("Can't create a ddl file without SQL::Translator: $@") if $@;
 
-  my $sqlt = SQL::Translator->new($sqltargs);
+  my $sqlt = SQL::Translator->new({
+#      debug => 1,
+      add_drop_table => 1,
+  });
   foreach my $db (@$databases)
   {
     $sqlt->reset();
     $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
 #    $sqlt->parser_args({'DBIx::Class' => $schema);
+    $sqlt = $self->configure_sqlt($sqlt, $db);
     $sqlt->data($schema);
     $sqlt->producer($db);
 
@@ -1122,24 +1125,97 @@ sub create_ddl_dir
     my $filename = $schema->ddl_filename($db, $dir, $version);
     if(-e $filename)
     {
-      $self->throw_exception("$filename already exists, skipping $db");
+      warn("$filename already exists, skipping $db");
       next;
     }
-    open($file, ">$filename") 
-      or $self->throw_exception("Can't open $filename for writing ($!)");
+
     my $output = $sqlt->translate;
-#use Data::Dumper;
-#    print join(":", keys %{$schema->source_registrations});
-#    print Dumper($sqlt->schema);
     if(!$output)
     {
-      $self->throw_exception("Failed to translate to $db. (" . $sqlt->error . ")");
+      warn("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
       next;
     }
+    if(!open($file, ">$filename"))
+    {
+        $self->throw_exception("Can't open $filename for writing ($!)");
+        next;
+    }
     print $file $output;
     close($file);
+
+    if($preversion)
+    {
+      eval "use SQL::Translator::Diff";
+      if($@)
+      {
+        warn("Can't diff versions without SQL::Translator::Diff: $@");
+        next;
+      }
+
+      my $prefilename = $schema->ddl_filename($db, $dir, $preversion);
+      print "Previous version $prefilename\n";
+      if(!-e $prefilename)
+      {
+        warn("No previous schema file found ($prefilename)");
+        next;
+      }
+      #### We need to reparse the SQLite file we just wrote, so that 
+      ##   Diff doesnt get all confoosed, and Diff is *very* confused.
+      ##   FIXME: rip Diff to pieces!
+#      my $target_schema = $sqlt->schema;
+#      unless ( $target_schema->name ) {
+#        $target_schema->name( $filename );
+#      }
+      my @input;
+      push @input, {file => $prefilename, parser => $db};
+      push @input, {file => $filename, parser => $db};
+      my ( $source_schema, $source_db, $target_schema, $target_db ) = map {
+        my $file   = $_->{'file'};
+        my $parser = $_->{'parser'};
+
+        my $t = SQL::Translator->new;
+        $t->debug( 0 );
+        $t->trace( 0 );
+        $t->parser( $parser )            or die $t->error;
+        my $out = $t->translate( $file ) or die $t->error;
+        my $schema = $t->schema;
+        unless ( $schema->name ) {
+          $schema->name( $file );
+        }
+        ($schema, $parser);
+      } @input;
+
+      my $diff = SQL::Translator::Diff::schema_diff($source_schema, $db,
+                                                    $target_schema, $db,
+                                                    {}
+                                                   );
+      my $difffile = $schema->ddl_filename($db, $dir, $version, $preversion);
+      print STDERR "Diff: $difffile: $db, $dir, $version, $preversion \n";
+      if(-e $difffile)
+      {
+        warn("$difffile already exists, skipping");
+        next;
+      }
+      if(!open $file, ">$difffile")
+      { 
+        $self->throw_exception("Can't write to $difffile ($!)");
+        next;
+      }
+      print $file $diff;
+      close($file);
+    }
   }
+}
 
+sub configure_sqlt() {
+  my $self = shift;
+  my $tr = shift;
+  my $db = shift || $self->sqlt_type;
+  if ($db eq 'PostgreSQL') {
+    $tr->quote_table_names(0);
+    $tr->quote_field_names(0);
+  }
+  return $tr;
 }
 
 =head2 deployment_statements
@@ -1172,6 +1248,17 @@ sub deployment_statements {
   $type ||= $self->sqlt_type;
   $version ||= $schema->VERSION || '1.x';
   $dir ||= './';
+  my $filename = $schema->ddl_filename($type, $dir, $version);
+  if(-f $filename)
+  {
+      my $file;
+      open($file, "<$filename") 
+        or $self->throw_exception("Can't open $filename ($!)");
+      my @rows = <$file>;
+      close($file);
+      return join('', @rows);
+  }
+
   eval "use SQL::Translator";
   if(!$@)
   {
@@ -1184,21 +1271,9 @@ sub deployment_statements {
     return "SQL::Translator::Producer::${type}"->can('produce')->($tr);
   }
 
-  my $filename = $schema->ddl_filename($type, $dir, $version);
-  if(!-f $filename)
-  {
-#      $schema->create_ddl_dir([ $type ], $version, $dir, $sqltargs);
-      $self->throw_exception("No SQL::Translator, and no Schema file found, aborting deploy");
-      return;
-  }
-  my $file;
-  open($file, "<$filename") 
-      or $self->throw_exception("Can't open $filename ($!)");
-  my @rows = <$file>;
-  close($file);
-
-  return join('', @rows);
-  
+  $self->throw_exception("No SQL::Translator, and no Schema file found, aborting deploy");
+  return;
+
 }
 
 sub deploy {