fix silly bug
[dbsrgits/DBIx-Class-DeploymentHandler.git] / lib / DBIx / Class / DeploymentHandler / DeployMethod / SQL / Translator.pm
index 1a1fda8..45ad608 100644 (file)
@@ -31,6 +31,12 @@ has ignore_ddl => (
   default  => undef,
 );
 
+has force_overwrite => (
+  isa      => 'Bool',
+  is       => 'ro',
+  default  => undef,
+);
+
 has schema => (
   isa      => 'DBIx::Class::Schema',
   is       => 'ro',
@@ -296,7 +302,7 @@ sub deploy {
   my $sql;
   if ($self->ignore_ddl) {
      $sql = $self->_sql_from_yaml({},
-       '_ddl_protoschema_produce_filename', $sqlt_type
+       '_ddl_protoschema_deploy_consume_filenames', $sqlt_type
      );
   }
   return $self->_run_sql_and_perl($self->_ddl_schema_consume_filenames(
@@ -413,19 +419,25 @@ method _sql_from_yaml($sqltargs, $from_file, $db) {
   my $schema    = $self->schema;
   my $version   = $self->schema_version;
 
-  my $sqlt = SQL::Translator->new({
-    add_drop_table          => 0,
-    parser                  => 'SQL::Translator::Parser::YAML',
-    %{$sqltargs},
-    producer => $db,
-  });
+  my @sql;
 
-  my $yaml_filename = $self->$from_file($version);
-
-  my @sql = $sqlt->translate($yaml_filename);
-  if(!@sql) {
-    carp("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
-    return undef;
+  my $actual_file = $self->$from_file($version);
+  for my $yaml_filename (@{
+     DlogS_trace { "generating SQL from Serialized SQL Files: $_" }
+        (ref $actual_file?$actual_file:[$actual_file])
+  }) {
+     my $sqlt = SQL::Translator->new({
+       add_drop_table          => 0,
+       parser                  => 'SQL::Translator::Parser::YAML',
+       %{$sqltargs},
+       producer => $db,
+     });
+
+     push @sql, $sqlt->translate($yaml_filename);
+     if(!@sql) {
+       carp("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
+       return undef;
+     }
   }
   return \@sql;
 }
@@ -444,8 +456,12 @@ sub _prepare_install {
 
     my $filename = $self->$to_file($db, $version, $dir);
     if (-e $filename ) {
-      carp "Overwriting existing DDL file - $filename";
-      unlink $filename;
+      if ($self->force_overwrite) {
+         carp "Overwriting existing DDL file - $filename";
+         unlink $filename;
+      } else {
+         die "Cannot overwrite '$filename', either enable force_overwrite or delete it"
+      }
     }
     open my $file, q(>), $filename;
     print {$file} join ";\n", @$sql;
@@ -477,8 +493,10 @@ sub _resultsource_protoschema_filename {
 
 sub install_resultsource {
   my ($self, $args) = @_;
-  my $source          = $args->{result_source};
-  my $version         = $args->{version};
+  my $source          = $args->{result_source}
+    or die 'result_source must be passed to install_resultsource';
+  my $version         = $args->{version}
+    or die 'version must be passed to install_resultsource';
   log_info { 'installing_resultsource ' . $source->source_name . ", version $version" };
   my $rs_install_file =
     $self->_resultsource_install_filename($source->source_name);
@@ -550,8 +568,12 @@ method _prepare_changegrade($from_version, $to_version, $version_set, $direction
   foreach my $db (@$databases) {
     my $diff_file = $self->$diff_file_method($db, $version_set, $dir );
     if(-e $diff_file) {
-      carp("Overwriting existing $direction-diff file - $diff_file");
-      unlink $diff_file;
+      if ($self->force_overwrite) {
+         carp("Overwriting existing $direction-diff file - $diff_file");
+         unlink $diff_file;
+      } else {
+         die "Cannot overwrite '$diff_file', either enable force_overwrite or delete it"
+      }
     }
 
     open my $file, q(>), $diff_file;
@@ -639,8 +661,12 @@ sub prepare_protoschema {
     unless $yml;
 
   if (-e $filename ) {
-    carp "Overwriting existing DDL-YML file - $filename";
-    unlink $filename;
+    if ($self->force_overwrite) {
+       carp "Overwriting existing DDL-YML file - $filename";
+       unlink $filename;
+    } else {
+       die "Cannot overwrite '$filename', either enable force_overwrite or delete it"
+    }
   }
 
   open my $file, q(>), $filename;
@@ -840,6 +866,12 @@ instead of any pregenerated SQL.  If you have a development server this is
 probably the best plan of action as you will not be putting as many generated
 files in your version control.  Goes well with with C<databases> of C<[]>.
 
+=attr force_overwrite
+
+When this attribute is true generated files will be overwritten when the
+methods which create such files are run again.  The default is false, in which
+case the program will die with a message saying which file needs to be deleted.
+
 =attr schema
 
 The L<DBIx::Class::Schema> (B<required>) that is used to talk to the database