From: Arthur Axel 'fREW' Schmidt Date: Sat, 29 May 2010 10:23:26 +0000 (-0500) Subject: Remove JSON code because we no longer need it X-Git-Tag: v0.001000_13~16 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-DeploymentHandler.git;a=commitdiff_plain;h=09bc35e3b405fbac725a45739e15cf30543d7f77 Remove JSON code because we no longer need it --- diff --git a/dist.ini b/dist.ini index 01b2d15..3bddc7f 100644 --- 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 diff --git a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm index 094457c..e9c4aff 100644 --- a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm +++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm @@ -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 { diff --git a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator/Deprecated.pm b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator/Deprecated.pm index 6e7a604..813013c 100644 --- a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator/Deprecated.pm +++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator/Deprecated.pm @@ -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; diff --git a/t/deploy_methods/sql_translator.t b/t/deploy_methods/sql_translator.t index 3d46153..4f10f65 100644 --- a/t/deploy_methods/sql_translator.t +++ b/t/deploy_methods/sql_translator.t @@ -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 {