add create_ddl_dir for creating versioned sql statements from schema, and make DBICTe...

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 5bd741e..319379a 100644 (file)
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -714,6 +714,25 @@ sub deploy {
   $self->storage->deploy($self, undef, $sqltargs);
 }
 
+sub create_ddl_dir
+{
+  my $self = shift;
+
+  $self->throw_exception("Can't create_ddl_dir without storage") unless $self->storage;
+  $self->storage->create_ddl_dir($self, @_);
+}
+
+sub ddl_filename
+{
+    my ($self, $type, $dir, $version) = @_;
+
+    my $filename = ref($self);
+    $filename =~ s/^.*:://;
+    $filename = "$dir$filename-$version-$type.sql";
+
+    return $filename;
+}
+
 1;
 
 =head1 AUTHORS

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 78d7321..dcc4177 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1,4 +1,5 @@
 package DBIx::Class::Storage::DBI;
+# -*- mode: cperl; cperl-indent-level: 2 -*-
 
 use base 'DBIx::Class::Storage';
 
@@ -557,7 +558,7 @@ sub _execute {
   my ($sql, @bind) = $self->sql_maker->$op($ident, @args);
   unshift(@bind, @$extra_bind) if $extra_bind;
   if ($self->debug) {
-      my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
+      my @debug_bind = map { defined $_ ? qq{'$_'} : q{'NULL'} } @bind;
       $self->debugfh->print("$sql: " . join(', ', @debug_bind) . "\n");
   }
   my $sth = eval { $self->sth($sql,$op) };
@@ -714,24 +715,97 @@ sub last_insert_id {
 
 sub sqlt_type { shift->dbh->{Driver}->{Name} }
 
-sub deployment_statements {
-  my ($self, $schema, $type, $sqltargs) = @_;
-  $type ||= $self->sqlt_type;
+sub create_ddl_dir
+{
+  my ($self, $schema, $databases, $version, $dir, $sqltargs) = @_;
+
+  if(!$dir || !-d $dir)
+  {
+    warn "No directory given, using ./\n";
+    $dir = "./";
+  }
+  $databases ||= ['MySQL', 'SQLite', 'PostgreSQL'];
+  $databases = [ $databases ] if(ref($databases) ne 'ARRAY');
+  $version ||= $schema->VERSION || '1.x';
+
   eval "use SQL::Translator";
   $self->throw_exception("Can't deploy without SQL::Translator: $@") if $@;
-  eval "use SQL::Translator::Parser::DBIx::Class;";
-  $self->throw_exception($@) if $@;
-  eval "use SQL::Translator::Producer::${type};";
-  $self->throw_exception($@) if $@;
-  my $tr = SQL::Translator->new(%$sqltargs);
-  SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema );
-  return "SQL::Translator::Producer::${type}"->can('produce')->($tr);
+
+  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->data($schema);
+    $sqlt->producer($db);
+
+    my $file;
+    my $filename = $schema->ddl_filename($db, $dir, $version);
+    if(-e $filename)
+    {
+      $self->throw_exception("$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 . ")");
+      next;
+    }
+    print $file $output;
+    close($file);
+  }
+
+}
+
+sub deployment_statements {
+  my ($self, $schema, $type, $version, $dir, $sqltargs) = @_;
+  $type ||= $self->sqlt_type;
+  $version ||= $schema->VERSION || '1.x';
+  $dir ||= './';
+#   eval "use SQL::Translator";
+#   $self->throw_exception("Can't deploy without SQL::Translator: $@") if $@;
+#   eval "use SQL::Translator::Parser::DBIx::Class;";
+#   $self->throw_exception($@) if $@;
+#   eval "use SQL::Translator::Producer::${type};";
+#   $self->throw_exception($@) if $@;
+#   my $tr = SQL::Translator->new(%$sqltargs);
+#   SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema );
+#   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);
+  }
+  my $file;
+  open($file, "<$filename") 
+      or $self->throw_exception("Can't open $filename ($!)");
+  my @rows = <$file>;
+  close($file);
+
+  return join('', @rows);
+  
 }
 
 sub deploy {
   my ($self, $schema, $type, $sqltargs) = @_;
-  foreach my $statement ( $self->deployment_statements($schema, $type, $sqltargs) ) {
+  foreach my $statement ( $self->deployment_statements($schema, $type, undef, undef, $sqltargs) ) {
     for ( split(";\n", $statement)) {
+      next if($_ =~ /^--/);
+      next if(!$_);
+#      next if($_ =~ /^DROP/m);
+      next if($_ =~ /^BEGIN TRANSACTION/m);
+      next if($_ =~ /^COMMIT/m);
       $self->debugfh->print("$_\n") if $self->debug;
       $self->dbh->do($_) or warn "SQL was:\n $_";
     }

diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm
index 628696a..5ffdf90 100755 (executable)
--- a/t/lib/DBICTest.pm
+++ b/t/lib/DBICTest.pm
@@ -13,9 +13,13 @@ sub initialise {
   unlink($db_file . "-journal") if -e $db_file . "-journal";
   mkdir("t/var") unless -d "t/var";
   
-  my $dsn = "dbi:SQLite:${db_file}";
+  my $dsn = $ENV{"DBICTEST_DSN"} || "dbi:SQLite:${db_file}";
+  my $dbuser = $ENV{"DBICTEST_DBUSER"} || '';
+  my $dbpass = $ENV{"DBICTEST_DBPASS"} || '';
+
+#  my $dsn = "dbi:SQLite:${db_file}";
   
-  return DBICTest::Schema->compose_connection('DBICTest' => $dsn);
+  return DBICTest::Schema->compose_connection('DBICTest' => $dsn, $dbuser, $dbpass);
 }
   
 1;

diff --git a/t/lib/DBICTest/Setup.pm b/t/lib/DBICTest/Setup.pm
index fb08fce..8bdd756 100755 (executable)
--- a/t/lib/DBICTest/Setup.pm
+++ b/t/lib/DBICTest/Setup.pm
@@ -4,7 +4,7 @@ use DBICTest;
 
 my $schema = DBICTest->initialise;
 
-$schema->storage->on_connect_do([ "PRAGMA synchronous = OFF" ]);
+# $schema->storage->on_connect_do([ "PRAGMA synchronous = OFF" ]);
 
 my $dbh = $schema->storage->dbh;