Remove JSON code because we no longer need it
Arthur Axel 'fREW' Schmidt [Sat, 29 May 2010 10:23:26 +0000 (05:23 -0500)]
dist.ini
lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm
lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator/Deprecated.pm
t/deploy_methods/sql_translator.t

index 01b2d15..3bddc7f 100644 (file)
--- a/dist.ini
+++ b/dist.ini
@@ -23,7 +23,6 @@ repository.type   = git
 [PodSyntaxTests]
 
 [Prereq]
-JSON                        = 2.21
 autodie                     = 0
 namespace::autoclean        = 0
 Log::Contextual             = 0.00202
index 094457c..e9c4aff 100644 (file)
@@ -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) {
@@ -207,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) {
@@ -295,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,
@@ -317,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 {
@@ -340,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" );
   }
 }
 
@@ -408,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}
@@ -448,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;
@@ -474,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;
@@ -484,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;
 
@@ -508,13 +491,15 @@ 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 {
index 6e7a604..813013c 100644 (file)
@@ -6,7 +6,6 @@ use Moose;
 use Method::Signatures::Simple;
 
 use File::Spec::Functions;
-require SQL::Translator::Diff;
 
 extends 'DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator',
 
@@ -40,20 +39,6 @@ method _ddl_schema_up_consume_filenames($type, $versions) {
   return [$self->_ddl_schema_up_produce_filename($type, $versions)]
 }
 
-method _generate_final_diff($source_schema, $dest_schema, $db, $sqltargs) {
-  scalar SQL::Translator::Diff::schema_diff(
-         $source_schema, $db,
-         $dest_schema,   $db,
-         $sqltargs
-  )
-}
-
-method _default_read_sql_file_as_string($file) {
-  do { local( @ARGV, $/ ) = $file; <> } # slurp
-}
-
-method _generate_final_sql($sqlt) { scalar $sqlt->translate }
-
 __PACKAGE__->meta->make_immutable;
 
 1;
index 3d46153..4f10f65 100644 (file)
@@ -36,7 +36,7 @@ VERSION1: {
    close $prerun;
    $dm->preinstall({ version => '1.0' });
 
-   ok -e 'foobar', 'perl migration runs';
+   ok -e 'foobar';
 
    {
       my $warned = 0;
@@ -46,7 +46,7 @@ VERSION1: {
    }
 
    ok(
-      -f catfile(qw( t sql SQLite schema 1.0 001-auto.sql-json )),
+      -f catfile(qw( t sql SQLite schema 1.0 001-auto.sql )),
       '1.0 schema gets generated properly'
    );
 
@@ -81,7 +81,7 @@ VERSION2: {
    $version = $s->schema_version();
    $dm->prepare_deploy;
    ok(
-      -f catfile(qw( t sql SQLite schema 2.0 001-auto.sql-json )),
+      -f catfile(qw( t sql SQLite schema 2.0 001-auto.sql )),
       '2.0 schema gets generated properly'
    );
    mkpath(catfile(qw( t sql SQLite up 1.0-2.0 )));
@@ -102,7 +102,7 @@ VERSION2: {
       ok( $warned, 'prepare_upgrade with a bogus preversion warns' );
    }
    ok(
-      -f catfile(qw( t sql SQLite up 1.0-2.0 001-auto.sql-json )),
+      -f catfile(qw( t sql SQLite up 1.0-2.0 001-auto.sql )),
       '1.0-2.0 diff gets generated properly and default start and end versions get set'
    );
    mkpath(catfile(qw( t sql SQLite down 2.0-1.0 )));
@@ -112,7 +112,7 @@ VERSION2: {
      version_set => [$version, '1.0']
    });
    ok(
-      -f catfile(qw( t sql SQLite down 2.0-1.0 001-auto.sql-json )),
+      -f catfile(qw( t sql SQLite down 2.0-1.0 001-auto.sql )),
       '2.0-1.0 diff gets generated properly'
    );
    dies_ok {
@@ -188,7 +188,7 @@ VERSION3: {
    $version = $s->schema_version();
    $dm->prepare_deploy;
    ok(
-      -f catfile(qw( t sql SQLite schema 3.0 001-auto.sql-json )),
+      -f catfile(qw( t sql SQLite schema 3.0 001-auto.sql )),
       '2.0 schema gets generated properly'
    );
    $dm->prepare_downgrade({
@@ -197,7 +197,7 @@ VERSION3: {
      version_set => [$version, '1.0']
    });
    ok(
-      -f catfile(qw( t sql SQLite down 3.0-1.0 001-auto.sql-json )),
+      -f catfile(qw( t sql SQLite down 3.0-1.0 001-auto.sql )),
       '3.0-1.0 diff gets generated properly'
    );
    $dm->prepare_upgrade({
@@ -206,7 +206,7 @@ VERSION3: {
      version_set => ['1.0', $version]
    });
    ok(
-      -f catfile(qw( t sql SQLite up 1.0-3.0 001-auto.sql-json )),
+      -f catfile(qw( t sql SQLite up 1.0-3.0 001-auto.sql )),
       '1.0-3.0 diff gets generated properly'
    );
    $dm->prepare_upgrade({
@@ -225,11 +225,11 @@ VERSION3: {
       ok( $warned, 'prepare_upgrade warns if you clobber an existing upgrade file' );
    }
    ok(
-      -f catfile(qw( t sql SQLite up 1.0-2.0 001-auto.sql-json )),
+      -f catfile(qw( t sql SQLite up 1.0-2.0 001-auto.sql )),
       '2.0-3.0 diff gets generated properly'
    );
    mkpath catfile(qw( t sql _generic up 2.0-3.0 ));
-   rename catfile(qw( t sql SQLite up 2.0-3.0 001-auto.sql-json )), catfile(qw( t sql _generic up 2.0-3.0 001-auto.sql-json ));
+   rename catfile(qw( t sql SQLite up 2.0-3.0 001-auto.sql )), catfile(qw( t sql _generic up 2.0-3.0 001-auto.sql ));
    rmtree(catfile(qw( t sql SQLite )));
    warn 'how can this be' if -d catfile(qw( t sql SQLite ));
    dies_ok {