better logging of sql

[dbsrgits/DBIx-Class-DeploymentHandler.git] / lib / DBIx / Class / DeploymentHandler / DeployMethod / SQL / Translator.pm

diff --git a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
index 6f183fc..cb07a89 100644 (file)
--- a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
+++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
@@ -76,7 +76,7 @@ has schema_version => (
 
 # this will probably never get called as the DBICDH
 # will be passing down a schema_version normally, which
-# is built the same way
+# is built the same way, but we leave this in place
 method _build_schema_version { $self->schema->schema_version }
 
 method __ddl_consume_with_prefix($type, $versions, $prefix) {
@@ -97,7 +97,7 @@ method __ddl_consume_with_prefix($type, $versions, $prefix) {
   }
 
   opendir my($dh), $dir;
-  my %files = map { $_ => "$dir/$_" } grep { /\.(?:sql|pl)$/ && -f "$dir/$_" } readdir $dh;
+  my %files = map { $_ => "$dir/$_" } grep { /\.(?:sql|pl|sql-\w+)$/ && -f "$dir/$_" } readdir $dh;
   closedir $dh;
 
   if (-d $common) {
@@ -153,49 +153,74 @@ method _ddl_schema_down_produce_filename($type, $versions, $dir) {
   return catfile( $dirname, '001-auto.sql');
 }
 
-method _run_sql_and_perl($filenames) {
-  my @files = @{$filenames};
+method _run_sql_array($sql) {
   my $storage = $self->storage;
 
+  log_trace { '[DBICDH] Running SQL ' . Dumper($sql) };
+  foreach my $line (@{$sql}) {
+    $storage->_query_start($line);
+    try {
+      # do a dbh_do cycle here, as we need some error checking in
+      # place (even though we will ignore errors)
+      $storage->dbh_do (sub { $_[1]->do($line) });
+    }
+    catch {
+      carp "$_ (running '${line}')"
+    }
+    $storage->_query_end($line);
+  }
+  return join "\n", @$sql
+}
 
-  my $guard = $self->schema->txn_scope_guard if $self->txn_wrap;
+method _run_sql($filename) {
+  log_debug { "[DBICDH] Running SQL from $filename" };
+  return $self->_run_sql_array($self->_read_sql_file($filename));
+}
 
-  my $sql;
-  for my $filename (@files) {
-    if ($filename =~ /\.sql$/) {
-      log_debug { "[DBICDH] Running SQL from $filename" };
-      my @sql = @{$self->_read_sql_file($filename)};
-      $sql .= join "\n", @sql;
-      log_trace { "[DBICDH] Running SQL $sql" };
-
-      foreach my $line (@sql) {
-        $storage->_query_start($line);
-        try {
-          # do a dbh_do cycle here, as we need some error checking in
-          # place (even though we will ignore errors)
-          $storage->dbh_do (sub { $_[1]->do($line) });
-        }
-        catch {
-          carp "$_ (running '${line}')"
-        }
-        $storage->_query_end($line);
-      }
-    } elsif ( $filename =~ /^(.+)\.pl$/ ) {
-      log_debug { "[DBICDH] Running Perl from $filename" };
-      my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
+method _run_perl($filename) {
+  log_debug { "[DBICDH] Running Perl from $filename" };
+  my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
 
-      no warnings 'redefine';
-      my $fn = eval "$filedata";
-      use warnings;
-      log_trace { '[DBICDH] Running Perl ' . Dumper($fn) };
+  no warnings 'redefine';
+  my $fn = eval "$filedata";
+  use warnings;
+  log_trace { '[DBICDH] Running Perl ' . Dumper($fn) };
 
-      if ($@) {
-        carp "$filename failed to compile: $@";
-      } elsif (ref $fn eq 'CODE') {
-        $fn->($self->schema)
+  if ($@) {
+    carp "$filename failed to compile: $@";
+  } elsif (ref $fn eq 'CODE') {
+    $fn->($self->schema)
+  } else {
+    carp "$filename should define an anonymouse sub that takes a schema but it didn't!";
+  }
+}
+{
+   my $json;
+
+   method _run_serialized_sql($filename, $type) {
+      if ($type eq 'json') {
+         require JSON;
+         $json ||= JSON->new->pretty;
+         my @sql = @{$json->decode($filename)};
       } else {
-        carp "$filename should define an anonymouse sub that takes a schema but it didn't!";
+         croak "A file ($filename) got to deploy that wasn't sql or perl!";
       }
+   }
+
+}
+
+method _run_sql_and_perl($filenames) {
+  my @files   = @{$filenames};
+  my $guard   = $self->schema->txn_scope_guard if $self->txn_wrap;
+
+  my $sql = '';
+  for my $filename (@files) {
+    if ($filename =~ /\.sql$/) {
+       $sql .= $self->_run_sql($filename)
+    } elsif ( $filename =~ /\.sql-(\w+)$/ ) {
+       $sql .= $self->_run_serialized_sql($filename, $1)
+    } elsif ( $filename =~ /\.pl$/ ) {
+       $self->_run_perl($filename)
     } else {
       croak "A file ($filename) got to deploy that wasn't sql or perl!";
     }