X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FDeploymentHandler%2FDeployMethod%2FSQL%2FTranslator.pm;h=e9c4aff9f54f49ad9979343bc16e17a447cfa4ff;hb=09bc35e3b405fbac725a45739e15cf30543d7f77;hp=affcf5695647323e25a59dea15b4d3e1b55fa7c5;hpb=0824f31fb9814cf3bbecf8720e4e8de7cf252b8e;p=dbsrgits%2FDBIx-Class-DeploymentHandler.git

diff --git a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
index affcf56..e9c4aff 100644
--- a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
+++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
@@ -5,11 +5,11 @@ use Moose;
 
 use autodie;
 use Carp qw( carp croak );
-use Log::Contextual::WarnLogger;
-use Log::Contextual qw(:log :dlog), -default_logger => Log::Contextual::WarnLogger->new({
-   env_prefix => 'DBICDH'
-});
-use Data::Dumper::Concise;
+use DBIx::Class::DeploymentHandler::Logger;
+use Log::Contextual qw(:log :dlog), -default_logger =>
+  DBIx::Class::DeploymentHandler::Logger->new({
+    env_prefix => 'DBICDH'
+  });
 
 use Method::Signatures::Simple;
 use Try::Tiny;
@@ -79,13 +79,6 @@ has schema_version => (
 # is built the same way, but we leave this in place
 method _build_schema_version { $self->schema->schema_version }
 
-has _json => (
-  is => 'ro',
-  lazy_build => 1,
-);
-
-sub _build__json { require JSON; JSON->new->pretty }
-
 method __ddl_consume_with_prefix($type, $versions, $prefix) {
   my $base_dir = $self->script_directory;
 
@@ -132,7 +125,7 @@ method _ddl_schema_produce_filename($type, $version) {
   my $dirname = catfile( $self->script_directory, $type, 'schema', $version );
   mkpath($dirname) unless -d $dirname;
 
-  return catfile( $dirname, '001-auto.sql-json' );
+  return catfile( $dirname, '001-auto.sql' );
 }
 
 method _ddl_schema_up_consume_filenames($type, $versions) {
@@ -149,14 +142,15 @@ method _ddl_schema_up_produce_filename($type, $versions) {
   my $dirname = catfile( $dir, $type, 'up', join q(-), @{$versions});
   mkpath($dirname) unless -d $dirname;
 
-  return catfile( $dirname, '001-auto.sql-json' );
+  return catfile( $dirname, '001-auto.sql'
+  );
 }
 
 method _ddl_schema_down_produce_filename($type, $versions, $dir) {
   my $dirname = catfile( $dir, $type, 'down', join q(-), @{$versions} );
   mkpath($dirname) unless -d $dirname;
 
-  return catfile( $dirname, '001-auto.sql-json');
+  return catfile( $dirname, '001-auto.sql');
 }
 
 method _run_sql_array($sql) {
@@ -170,16 +164,15 @@ method _run_sql_array($sql) {
     join '', grep { !/^--/ } split /\n/ # remove comments
   } @$sql];
 
-  log_trace { '[DBICDH] Running SQL ' . Dumper($sql) };
+  Dlog_trace { "Running SQL $_" } $sql;
   foreach my $line (@{$sql}) {
     $storage->_query_start($line);
+    # the whole reason we do this is so that we can see the line that was run
     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}')"
+      die "$_ (running line '$line')"
     }
     $storage->_query_end($line);
   }
@@ -187,18 +180,18 @@ method _run_sql_array($sql) {
 }
 
 method _run_sql($filename) {
-  log_debug { "[DBICDH] Running SQL from $filename" };
+  log_debug { "Running SQL from $filename" };
   return $self->_run_sql_array($self->_read_sql_file($filename));
 }
 
 method _run_perl($filename) {
-  log_debug { "[DBICDH] Running Perl from $filename" };
+  log_debug { "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) };
+  Dlog_trace { "Running Perl $_" } $fn;
 
   if ($@) {
     carp "$filename failed to compile: $@";
@@ -208,15 +201,19 @@ method _run_perl($filename) {
     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 {
+         croak "A file ($filename) got to deploy that wasn't sql or perl!";
+      }
+   }
 
-method _run_serialized_sql($filename, $type) {
-  if (lc $type eq 'json') {
-    return $self->_run_sql_array($self->_json->decode(
-      do { local( @ARGV, $/ ) = $filename; <> } # slurp
-    ))
-  } else {
-    croak "$type is not one of the supported serialzed types"
-  }
 }
 
 method _run_sql_and_perl($filenames) {
@@ -244,7 +241,7 @@ method _run_sql_and_perl($filenames) {
 sub deploy {
   my $self = shift;
   my $version = (shift @_ || {})->{version} || $self->schema_version;
-  log_info { "[DBICDH] deploying version $version" };
+  log_info { "deploying version $version" };
 
   return $self->_run_sql_and_perl($self->_ddl_schema_consume_filenames(
     $self->storage->sqlt_type,
@@ -256,7 +253,7 @@ sub preinstall {
   my $self         = shift;
   my $args         = shift;
   my $version      = $args->{version}      || $self->schema_version;
-  log_info { "[DBICDH] preinstalling version $version" };
+  log_info { "preinstalling version $version" };
   my $storage_type = $args->{storage_type} || $self->storage->sqlt_type;
 
   my @files = @{$self->_ddl_preinstall_consume_filenames(
@@ -296,7 +293,6 @@ sub _prepare_install {
   my $version   = $self->schema_version;
 
   my $sqlt = SQL::Translator->new({
-    no_comments             => 1,
     add_drop_table          => 1,
     ignore_constraint_names => 1,
     ignore_index_names      => 1,
@@ -318,22 +314,17 @@ sub _prepare_install {
       unlink $filename;
     }
 
-    my $sql = $self->_generate_final_sql($sqlt);
-    if(!$sql) {
+    my $output = $sqlt->translate;
+    if(!$output) {
       carp("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
       next;
     }
     open my $file, q(>), $filename;
-    print {$file} $sql;
+    print {$file} $output;
     close $file;
   }
 }
 
-method _generate_final_sql($sqlt) {
-  my @output = $sqlt->translate;
-  $self->_json->encode(\@output);
-}
-
 sub _resultsource_install_filename {
   my ($self, $source_name) = @_;
   return sub {
@@ -341,7 +332,7 @@ sub _resultsource_install_filename {
     my $dirname = catfile( $self->script_directory, $type, 'schema', $version );
     mkpath($dirname) unless -d $dirname;
 
-    return catfile( $dirname, "001-auto-$source_name.sql-json" );
+    return catfile( $dirname, "001-auto-$source_name.sql" );
   }
 }
 
@@ -349,7 +340,7 @@ sub install_resultsource {
   my ($self, $args) = @_;
   my $source          = $args->{result_source};
   my $version         = $args->{version};
-  log_info { '[DBICDH] installing_resultsource ' . $source->source_name . ", version $version" };
+  log_info { 'installing_resultsource ' . $source->source_name . ", version $version" };
   my $rs_install_file =
     $self->_resultsource_install_filename($source->source_name);
 
@@ -365,7 +356,7 @@ sub install_resultsource {
 sub prepare_resultsource_install {
   my $self = shift;
   my $source = (shift @_)->{result_source};
-  log_info { '[DBICDH] preparing install for resultsource ' . $source->source_name };
+  log_info { 'preparing install for resultsource ' . $source->source_name };
 
   my $filename = $self->_resultsource_install_filename($source->source_name);
   $self->_prepare_install({
@@ -374,7 +365,7 @@ sub prepare_resultsource_install {
 }
 
 sub prepare_deploy {
-  log_info { '[DBICDH] preparing deploy' };
+  log_info { 'preparing deploy' };
   my $self = shift;
   $self->_prepare_install({}, '_ddl_schema_produce_filename');
 }
@@ -382,8 +373,7 @@ sub prepare_deploy {
 sub prepare_upgrade {
   my ($self, $args) = @_;
   log_info {
-     '[DBICDH] preparing upgrade ' .
-     "from $args->{from_version} to $args->{to_version}"
+     "preparing upgrade from $args->{from_version} to $args->{to_version}"
   };
   $self->_prepare_changegrade(
     $args->{from_version}, $args->{to_version}, $args->{version_set}, 'up'
@@ -393,8 +383,7 @@ sub prepare_upgrade {
 sub prepare_downgrade {
   my ($self, $args) = @_;
   log_info {
-     '[DBICDH] preparing downgrade ' .
-     "from $args->{from_version} to $args->{to_version}"
+     "preparing downgrade from $args->{from_version} to $args->{to_version}"
   };
   $self->_prepare_changegrade(
     $args->{from_version}, $args->{to_version}, $args->{version_set}, 'down'
@@ -411,7 +400,6 @@ method _prepare_changegrade($from_version, $to_version, $version_set, $direction
 
   $sqltargs = {
     add_drop_table => 1,
-    no_comments => 1,
     ignore_constraint_names => 1,
     ignore_index_names => 1,
     %{$sqltargs}
@@ -451,8 +439,7 @@ method _prepare_changegrade($from_version, $to_version, $version_set, $direction
       $t->parser( $db ) # could this really throw an exception?
         or croak($t->error);
 
-      my $sql = $self->_default_read_sql_file_as_string($prefilename);
-      my $out = $t->translate( \$sql )
+      my $out = $t->translate( $prefilename )
         or croak($t->error);
 
       $source_schema = $t->schema;
@@ -477,8 +464,7 @@ method _prepare_changegrade($from_version, $to_version, $version_set, $direction
         or croak($t->error);
 
       my $filename = $self->_ddl_schema_produce_filename($db, $to_version, $dir);
-      my $sql = $self->_default_read_sql_file_as_string($filename);
-      my $out = $t->translate( \$sql )
+      my $out = $t->translate( $filename )
         or croak($t->error);
 
       $dest_schema = $t->schema;
@@ -487,23 +473,17 @@ method _prepare_changegrade($from_version, $to_version, $version_set, $direction
         unless $dest_schema->name;
     }
 
+    my $diff = SQL::Translator::Diff::schema_diff(
+       $source_schema, $db,
+       $dest_schema,   $db,
+       $sqltargs
+    );
     open my $file, q(>), $diff_file;
-    print {$file}
-      $self->_generate_final_diff($source_schema, $dest_schema, $db, $sqltargs);
+    print {$file} $diff;
     close $file;
   }
 }
 
-method _generate_final_diff($source_schema, $dest_schema, $db, $sqltargs) {
-  $self->_json->encode([
-     SQL::Translator::Diff::schema_diff(
-        $source_schema, $db,
-        $dest_schema,   $db,
-        $sqltargs
-     )
-  ])
-}
-
 method _read_sql_file($file) {
   return unless $file;
 
@@ -511,19 +491,21 @@ method _read_sql_file($file) {
   my @data = split /;\n/, join '', <$fh>;
   close $fh;
 
-  return \@data;
-}
+  @data = grep {
+    $_ && # remove blank lines
+    !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/ # strip txn's
+  } map {
+    s/^\s+//; s/\s+$//; # trim whitespace
+    join '', grep { !/^--/ } split /\n/ # remove comments
+  } @data;
 
-method _default_read_sql_file_as_string($file) {
-  return join q(), map "$_;\n", @{$self->_json->decode(
-    do { local( @ARGV, $/ ) = $file; <> } # slurp
-  )};
+  return \@data;
 }
 
 sub downgrade_single_step {
   my $self = shift;
   my $version_set = (shift @_)->{version_set};
-  log_info { qq([DBICDH] downgrade_single_step'ing ) . Dumper($version_set) };
+  Dlog_info { "downgrade_single_step'ing $_" } $version_set;
 
   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_down_consume_filenames(
     $self->storage->sqlt_type,
@@ -536,7 +518,7 @@ sub downgrade_single_step {
 sub upgrade_single_step {
   my $self = shift;
   my $version_set = (shift @_)->{version_set};
-  log_info { qq([DBICDH] upgrade_single_step'ing ) . Dumper($version_set) };
+  Dlog_info { "upgrade_single_step'ing $_" } $version_set;
 
   my $sql = $self->_run_sql_and_perl($self->_ddl_schema_up_consume_filenames(
     $self->storage->sqlt_type,