X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-DeploymentHandler.git;a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FDeploymentHandler%2FDeployMethod%2FSQL%2FTranslator.pm;h=45ad60844c4848ea578704f9dca5c7167a40fade;hp=de4f33e63ae294714e0c8c97b73d205112449910;hb=ba99ba446d9681700bccaa7816959af3600b5cb9;hpb=6776a6d4c94d12eedde6b8c28e5274e7f7cf8f44

diff --git a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
index de4f33e..45ad608 100644
--- a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
+++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
@@ -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',
@@ -135,6 +141,19 @@ method _ddl_schema_consume_filenames($type, $version) {
   $self->__ddl_consume_with_prefix($type, [ $version ], 'deploy')
 }
 
+method _ddl_protoschema_deploy_consume_filenames($version) {
+  my $base_dir = $self->script_directory;
+
+  my $dir = catfile( $base_dir, '_source', 'deploy', $version);
+  return [] unless -d $dir;
+
+  opendir my($dh), $dir;
+  my %files = map { $_ => "$dir/$_" } grep { /\.yml$/ && -f "$dir/$_" } readdir $dh;
+  closedir $dh;
+
+  return [@files{sort keys %files}]
+}
+
 method _ddl_protoschema_upgrade_consume_filenames($versions) {
   my $base_dir = $self->script_directory;
 
@@ -283,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(
@@ -400,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 $yaml_filename = $self->$from_file($version);
+  my @sql;
 
-  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;
 }
@@ -431,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;
@@ -455,7 +484,7 @@ sub _resultsource_protoschema_filename {
   my ($self, $source_name) = @_;
   return sub {
     my ($self, $version) = @_;
-    my $dirname = catfile( $self->script_directory, '_source', $version );
+    my $dirname = catfile( $self->script_directory, '_source', 'deploy', $version );
     mkpath($dirname) unless -d $dirname;
 
     return catfile( $dirname, "001-auto-$source_name.yml" );
@@ -464,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);
@@ -537,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;
@@ -626,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;
@@ -827,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