From 370ae4c2d4b99930798b968d1c2aa7b5e437747c Mon Sep 17 00:00:00 2001 From: David Cook Date: Tue, 25 Nov 2014 10:39:48 +1100 Subject: [PATCH] Wind this back... these are experiments for using DBIC schema control http://bugs.koha-community.org/show_bug.cgi?id=11390 --- Koha/Schema.pm | 2 + installer/dbic_controller.pl | 34 +++++++++++ installer/schema_dump/schema.pl | 130 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 166 insertions(+) create mode 100644 installer/dbic_controller.pl create mode 100644 installer/schema_dump/schema.pl diff --git a/Koha/Schema.pm b/Koha/Schema.pm index cffc631..3816ba3 100644 --- a/Koha/Schema.pm +++ b/Koha/Schema.pm @@ -7,6 +7,8 @@ package Koha::Schema; use strict; use warnings; +our $VERSION = 1.1; + use base 'DBIx::Class::Schema'; __PACKAGE__->load_namespaces; diff --git a/installer/dbic_controller.pl b/installer/dbic_controller.pl new file mode 100644 index 0000000..d74dc70 --- /dev/null +++ b/installer/dbic_controller.pl @@ -0,0 +1,34 @@ +use strict; +use Koha::Database; +use Data::Dumper; + +my $schema = Koha::Database->new()->schema(); + + + +$schema->deploy({quote_identifiers => 1, producer_args => {mysql_version => '5.5.33'}, }); +#my $statements = $schema->deployment_statements(undef,'2.0',undef,{quote_identifiers => 1, producer_args => {mysql_version => '5.5.33'},}); +#print Dumper($statements); +exit; + + +$schema->create_ddl_dir(['MySQL'], + '2.0', + './schema_dump/', + undef, + # '1.0', #'1.0', +{ + quote_identifiers => 1, +#ignore_index_names => 0, +#ignore_constraint_names => 1, +#case_insensitive => 1, + producer_args => {mysql_version => '5.5.33'}, +#no_batch_alters => 1, +} + ); +=pod +$schema->create_ddl_dir(['MySQL'], + '1.0', + './schema_dump/' + ); +=cut diff --git a/installer/schema_dump/schema.pl b/installer/schema_dump/schema.pl new file mode 100644 index 0000000..933e2cd --- /dev/null +++ b/installer/schema_dump/schema.pl @@ -0,0 +1,130 @@ +#!/bin/perl + +use Data::Dumper; + +#my $filename = $table->ddl_filename($type, $version, $dir, $preversion); +use Koha::Database; + +require SQL::Translator; +require SQL::Translator::Diff; +require SQL::Translator::Producer; + +my $schema = Koha::Database->new()->schema(); + +my $sqltargs = { + add_drop_table => 1, + ignore_constraint_names => 1, + ignore_index_names => 1, + quote_identifiers => 1, + output_db => 'MySQL', +}; + +my $databases = ['MySQL']; + +my $version = '1.1'; +my $preversion = '1.0'; +my $directory = '.'; + + +my $db = 'MySQL'; +require SQL::Translator::Producer::MySQL; + +## +my $sqlt = SQL::Translator->new ( $sqltargs ); +$sqlt->parser('SQL::Translator::Parser::DBIx::Class'); +my $sqlt_schema = $sqlt->translate({ data => $schema }) + or $self->throw_exception ($sqlt->error); +## + +foreach my $db (@$databases){ + $sqlt->reset(); + $sqlt->{schema} = $sqlt_schema; + $sqlt->producer($db); + + #Current version - in DBIC, it re-dumps... + my $filename = $schema->ddl_filename($db, $version, $directory); + + my $prefilename = $schema->ddl_filename($db, $preversion, $directory); + + my $source_schema; + { + my $t = SQL::Translator->new($sqltargs); + $t->debug( 0 ); + $t->trace( 0 ); + + $t->parser( $db ) + or $self->throw_exception ($t->error); + + my $out = $t->translate( $prefilename ) + or $self->throw_exception ($t->error); + + $source_schema = $t->schema; + + $source_schema->name( $prefilename ) + unless ( $source_schema->name ); + } + +my $out_test = $sqlt->translate; + + my $dest_schema = $sqlt->schema; +my $file; +my $filename = 'test'; + if (-e $file){ + unlink($file); + } + if(!open($file, ">$filename")) { + $self->throw_exception("Can't open $filename for writing ($!)"); + next; + } + print $file $out_test; + close($file); + + + unless ( "SQL::Translator::Producer::$db"->can('preprocess_schema') ) { + my $t = SQL::Translator->new($sqltargs); + $t->debug( 0 ); + $t->trace( 0 ); + + $t->parser( $db ) + or $self->throw_exception ($t->error); + + my $out = $t->translate( $filename ) + or $self->throw_exception ($t->error); + + $dest_schema = $t->schema; + + $dest_schema->name( $filename ) + unless $dest_schema->name; + } + + + my $diff = SQL::Translator::Diff->new({ + output_db => 'MySQL', + source_schema => $source_schema, + target_schema => $dest_schema, + %$sqltargs, + })->compute_differences->produce_diff_sql; + +=pod + my $diff = do { + # FIXME - this is a terrible workaround for + # https://github.com/dbsrgits/sql-translator/commit/2d23c1e + # Fixing it in this sloppy manner so that we don't hve to + # lockstep an SQLT release as well. Needs to be removed at + # some point, and SQLT dep bumped + local $SQL::Translator::Producer::SQLite::NO_QUOTES + if $SQL::Translator::Producer::SQLite::NO_QUOTES; + + SQL::Translator::Diff::schema_diff($source_schema, $db, + $dest_schema, $db, + $sqltargs + ); + }; +=cut + + warn Dumper($diff); + + + + +} -- 2.1.4