|
Line 0
Link Here
|
| 0 |
- |
1 |
#!/bin/perl |
|
|
2 |
|
| 3 |
use Data::Dumper; |
| 4 |
|
| 5 |
#my $filename = $table->ddl_filename($type, $version, $dir, $preversion); |
| 6 |
use Koha::Database; |
| 7 |
|
| 8 |
require SQL::Translator; |
| 9 |
require SQL::Translator::Diff; |
| 10 |
require SQL::Translator::Producer; |
| 11 |
|
| 12 |
my $schema = Koha::Database->new()->schema(); |
| 13 |
|
| 14 |
my $sqltargs = { |
| 15 |
add_drop_table => 1, |
| 16 |
ignore_constraint_names => 1, |
| 17 |
ignore_index_names => 1, |
| 18 |
quote_identifiers => 1, |
| 19 |
output_db => 'MySQL', |
| 20 |
}; |
| 21 |
|
| 22 |
my $databases = ['MySQL']; |
| 23 |
|
| 24 |
my $version = '1.1'; |
| 25 |
my $preversion = '1.0'; |
| 26 |
my $directory = '.'; |
| 27 |
|
| 28 |
|
| 29 |
my $db = 'MySQL'; |
| 30 |
require SQL::Translator::Producer::MySQL; |
| 31 |
|
| 32 |
## |
| 33 |
my $sqlt = SQL::Translator->new ( $sqltargs ); |
| 34 |
$sqlt->parser('SQL::Translator::Parser::DBIx::Class'); |
| 35 |
my $sqlt_schema = $sqlt->translate({ data => $schema }) |
| 36 |
or $self->throw_exception ($sqlt->error); |
| 37 |
## |
| 38 |
|
| 39 |
foreach my $db (@$databases){ |
| 40 |
$sqlt->reset(); |
| 41 |
$sqlt->{schema} = $sqlt_schema; |
| 42 |
$sqlt->producer($db); |
| 43 |
|
| 44 |
#Current version - in DBIC, it re-dumps... |
| 45 |
my $filename = $schema->ddl_filename($db, $version, $directory); |
| 46 |
|
| 47 |
my $prefilename = $schema->ddl_filename($db, $preversion, $directory); |
| 48 |
|
| 49 |
my $source_schema; |
| 50 |
{ |
| 51 |
my $t = SQL::Translator->new($sqltargs); |
| 52 |
$t->debug( 0 ); |
| 53 |
$t->trace( 0 ); |
| 54 |
|
| 55 |
$t->parser( $db ) |
| 56 |
or $self->throw_exception ($t->error); |
| 57 |
|
| 58 |
my $out = $t->translate( $prefilename ) |
| 59 |
or $self->throw_exception ($t->error); |
| 60 |
|
| 61 |
$source_schema = $t->schema; |
| 62 |
|
| 63 |
$source_schema->name( $prefilename ) |
| 64 |
unless ( $source_schema->name ); |
| 65 |
} |
| 66 |
|
| 67 |
my $out_test = $sqlt->translate; |
| 68 |
|
| 69 |
my $dest_schema = $sqlt->schema; |
| 70 |
my $file; |
| 71 |
my $filename = 'test'; |
| 72 |
if (-e $file){ |
| 73 |
unlink($file); |
| 74 |
} |
| 75 |
if(!open($file, ">$filename")) { |
| 76 |
$self->throw_exception("Can't open $filename for writing ($!)"); |
| 77 |
next; |
| 78 |
} |
| 79 |
print $file $out_test; |
| 80 |
close($file); |
| 81 |
|
| 82 |
|
| 83 |
unless ( "SQL::Translator::Producer::$db"->can('preprocess_schema') ) { |
| 84 |
my $t = SQL::Translator->new($sqltargs); |
| 85 |
$t->debug( 0 ); |
| 86 |
$t->trace( 0 ); |
| 87 |
|
| 88 |
$t->parser( $db ) |
| 89 |
or $self->throw_exception ($t->error); |
| 90 |
|
| 91 |
my $out = $t->translate( $filename ) |
| 92 |
or $self->throw_exception ($t->error); |
| 93 |
|
| 94 |
$dest_schema = $t->schema; |
| 95 |
|
| 96 |
$dest_schema->name( $filename ) |
| 97 |
unless $dest_schema->name; |
| 98 |
} |
| 99 |
|
| 100 |
|
| 101 |
my $diff = SQL::Translator::Diff->new({ |
| 102 |
output_db => 'MySQL', |
| 103 |
source_schema => $source_schema, |
| 104 |
target_schema => $dest_schema, |
| 105 |
%$sqltargs, |
| 106 |
})->compute_differences->produce_diff_sql; |
| 107 |
|
| 108 |
=pod |
| 109 |
my $diff = do { |
| 110 |
# FIXME - this is a terrible workaround for |
| 111 |
# https://github.com/dbsrgits/sql-translator/commit/2d23c1e |
| 112 |
# Fixing it in this sloppy manner so that we don't hve to |
| 113 |
# lockstep an SQLT release as well. Needs to be removed at |
| 114 |
# some point, and SQLT dep bumped |
| 115 |
local $SQL::Translator::Producer::SQLite::NO_QUOTES |
| 116 |
if $SQL::Translator::Producer::SQLite::NO_QUOTES; |
| 117 |
|
| 118 |
SQL::Translator::Diff::schema_diff($source_schema, $db, |
| 119 |
$dest_schema, $db, |
| 120 |
$sqltargs |
| 121 |
); |
| 122 |
}; |
| 123 |
=cut |
| 124 |
|
| 125 |
warn Dumper($diff); |
| 126 |
|
| 127 |
|
| 128 |
|
| 129 |
|
| 130 |
} |