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 |
} |