line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBIx::Diff::Schema; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY |
4
|
|
|
|
|
|
|
our $DATE = '2020-05-06'; # DATE |
5
|
|
|
|
|
|
|
our $DIST = 'DBIx-Diff-Schema'; # DIST |
6
|
|
|
|
|
|
|
our $VERSION = '0.097'; # VERSION |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
18252
|
use 5.010001; |
|
1
|
|
|
|
|
10
|
|
9
|
1
|
|
|
1
|
|
5
|
use strict 'subs', 'vars'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
30
|
|
10
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
29
|
|
11
|
1
|
|
|
1
|
|
1458
|
use Log::ger; |
|
1
|
|
|
|
|
44
|
|
|
1
|
|
|
|
|
5
|
|
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
632
|
use DBIx::Util::Schema qw(has_table list_tables list_columns); |
|
1
|
|
|
|
|
2545
|
|
|
1
|
|
|
|
|
60
|
|
14
|
1
|
|
|
1
|
|
7
|
use List::Util qw(first); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
37
|
|
15
|
|
|
|
|
|
|
|
16
|
1
|
|
|
1
|
|
5
|
use Exporter; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
653
|
|
17
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
18
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
19
|
|
|
|
|
|
|
diff_db_schema |
20
|
|
|
|
|
|
|
diff_table_schema |
21
|
|
|
|
|
|
|
db_schema_eq |
22
|
|
|
|
|
|
|
table_schema_eq |
23
|
|
|
|
|
|
|
); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
our %SPEC; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
$SPEC{':package'} = { |
28
|
|
|
|
|
|
|
v => 1.1, |
29
|
|
|
|
|
|
|
summary => 'Compare schema of two DBI databases', |
30
|
|
|
|
|
|
|
}; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
my %arg0_dbh = ( |
33
|
|
|
|
|
|
|
dbh => { |
34
|
|
|
|
|
|
|
schema => ['obj*'], |
35
|
|
|
|
|
|
|
summary => 'DBI database handle', |
36
|
|
|
|
|
|
|
req => 1, |
37
|
|
|
|
|
|
|
pos => 0, |
38
|
|
|
|
|
|
|
}, |
39
|
|
|
|
|
|
|
); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
my %arg1_table = ( |
42
|
|
|
|
|
|
|
table => { |
43
|
|
|
|
|
|
|
schema => ['str*'], |
44
|
|
|
|
|
|
|
summary => 'Table name', |
45
|
|
|
|
|
|
|
req => 1, |
46
|
|
|
|
|
|
|
pos => 1, |
47
|
|
|
|
|
|
|
}, |
48
|
|
|
|
|
|
|
); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
my %diff_db_args = ( |
51
|
|
|
|
|
|
|
dbh1 => { |
52
|
|
|
|
|
|
|
schema => ['obj*'], |
53
|
|
|
|
|
|
|
summary => 'DBI database handle for the first database', |
54
|
|
|
|
|
|
|
req => 1, |
55
|
|
|
|
|
|
|
pos => 0, |
56
|
|
|
|
|
|
|
}, |
57
|
|
|
|
|
|
|
dbh2 => { |
58
|
|
|
|
|
|
|
schema => ['obj*'], |
59
|
|
|
|
|
|
|
summary => 'DBI database handle for the second database', |
60
|
|
|
|
|
|
|
req => 1, |
61
|
|
|
|
|
|
|
pos => 1, |
62
|
|
|
|
|
|
|
}, |
63
|
|
|
|
|
|
|
); |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
my %diff_table_args = ( |
66
|
|
|
|
|
|
|
%diff_db_args, |
67
|
|
|
|
|
|
|
table1 => { |
68
|
|
|
|
|
|
|
schema => 'str*', |
69
|
|
|
|
|
|
|
summary => 'Table name', |
70
|
|
|
|
|
|
|
req => 1, |
71
|
|
|
|
|
|
|
pos => 2, |
72
|
|
|
|
|
|
|
}, |
73
|
|
|
|
|
|
|
table2 => { |
74
|
|
|
|
|
|
|
schema => 'str*', |
75
|
|
|
|
|
|
|
summary => 'Second table name (assumed to be the same as first table name if unspecified)', |
76
|
|
|
|
|
|
|
pos => 3, |
77
|
|
|
|
|
|
|
}, |
78
|
|
|
|
|
|
|
); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
sub _diff_column_schema { |
81
|
30
|
|
|
30
|
|
45
|
my ($c1, $c2) = @_; |
82
|
|
|
|
|
|
|
|
83
|
30
|
|
|
|
|
39
|
my $res = {}; |
84
|
|
|
|
|
|
|
{ |
85
|
30
|
100
|
|
|
|
34
|
if ($c1->{TYPE_NAME} ne $c2->{TYPE_NAME}) { |
|
30
|
|
|
|
|
69
|
|
86
|
4
|
|
|
|
|
10
|
$res->{old_type} = $c1->{TYPE_NAME}; |
87
|
4
|
|
|
|
|
21
|
$res->{new_type} = $c2->{TYPE_NAME}; |
88
|
4
|
|
|
|
|
9
|
last; |
89
|
|
|
|
|
|
|
} |
90
|
26
|
100
|
100
|
|
|
95
|
if ($c1->{NULLABLE} xor $c2->{NULLABLE}) { |
91
|
4
|
|
|
|
|
11
|
$res->{old_nullable} = $c1->{NULLABLE}; |
92
|
4
|
|
|
|
|
7
|
$res->{new_nullable} = $c2->{NULLABLE}; |
93
|
|
|
|
|
|
|
} |
94
|
26
|
50
|
|
|
|
50
|
if (defined $c1->{CHAR_OCTET_LENGTH}) { |
95
|
0
|
0
|
|
|
|
0
|
if ($c1->{CHAR_OCTET_LENGTH} != $c2->{CHAR_OCTET_LENGTH}) { |
96
|
0
|
|
|
|
|
0
|
$res->{old_length} = $c1->{CHAR_OCTET_LENGTH}; |
97
|
0
|
|
|
|
|
0
|
$res->{new_length} = $c2->{CHAR_OCTET_LENGTH}; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
} |
100
|
26
|
100
|
|
|
|
46
|
if (defined $c1->{DECIMAL_DIGITS}) { |
101
|
6
|
50
|
|
|
|
18
|
if ($c1->{DECIMAL_DIGITS} != $c2->{DECIMAL_DIGITS}) { |
102
|
0
|
|
|
|
|
0
|
$res->{old_digits} = $c1->{DECIMAL_DIGITS}; |
103
|
0
|
|
|
|
|
0
|
$res->{new_digits} = $c2->{DECIMAL_DIGITS}; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
} |
106
|
26
|
50
|
50
|
|
|
100
|
if (($c1->{mysql_is_auto_increment} // 0) != ($c2->{mysql_is_auto_increment} // 0)) { |
|
|
|
50
|
|
|
|
|
107
|
0
|
|
0
|
|
|
0
|
$res->{old_auto_increment} = $c1->{mysql_is_auto_increment} // 0; |
108
|
0
|
|
0
|
|
|
0
|
$res->{new_auto_increment} = $c2->{mysql_is_auto_increment} // 0; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
} |
111
|
30
|
|
|
|
|
35
|
$res; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub _diff_table_schema { |
115
|
11
|
|
|
11
|
|
30
|
my ($dbh1, $dbh2, $table1, $table2) = @_; |
116
|
|
|
|
|
|
|
|
117
|
11
|
|
|
|
|
28
|
my @columns1 = list_columns($dbh1, $table1); |
118
|
11
|
|
|
|
|
12658
|
my @columns2 = list_columns($dbh2, $table2); |
119
|
|
|
|
|
|
|
|
120
|
11
|
|
|
|
|
9950
|
log_trace("columns1: %s ...", \@columns1); |
121
|
11
|
|
|
|
|
56
|
log_trace("columns2: %s ...", \@columns2); |
122
|
|
|
|
|
|
|
|
123
|
11
|
|
|
|
|
27
|
my (@added, @deleted, %modified); |
124
|
11
|
|
|
|
|
25
|
for my $c1 (@columns1) { |
125
|
35
|
|
|
|
|
50
|
my $c1n = $c1->{COLUMN_NAME}; |
126
|
35
|
|
|
106
|
|
118
|
my $c2 = first {$c1n eq $_->{COLUMN_NAME}} @columns2; |
|
106
|
|
|
|
|
141
|
|
127
|
35
|
100
|
|
|
|
80
|
if (defined $c2) { |
128
|
30
|
|
|
|
|
52
|
my $tres = _diff_column_schema($c1, $c2); |
129
|
30
|
100
|
|
|
|
77
|
$modified{$c1n} = $tres if %$tres; |
130
|
|
|
|
|
|
|
} else { |
131
|
5
|
|
|
|
|
14
|
push @deleted, $c1n; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
} |
134
|
11
|
|
|
|
|
18
|
for my $c2 (@columns2) { |
135
|
39
|
|
|
|
|
50
|
my $c2n = $c2->{COLUMN_NAME}; |
136
|
39
|
|
|
109
|
|
86
|
my $c1 = first {$c2n eq $_->{COLUMN_NAME}} @columns1; |
|
109
|
|
|
|
|
127
|
|
137
|
39
|
100
|
|
|
|
83
|
if (defined $c1) { |
138
|
|
|
|
|
|
|
} else { |
139
|
9
|
|
|
|
|
19
|
push @added, $c2n; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
11
|
|
|
|
|
18
|
my $res = {}; |
144
|
11
|
100
|
|
|
|
26
|
$res->{added_columns} = \@added if @added; |
145
|
11
|
100
|
|
|
|
23
|
$res->{deleted_columns} = \@deleted if @deleted; |
146
|
11
|
100
|
|
|
|
23
|
$res->{modified_columns} = \%modified if %modified; |
147
|
11
|
|
|
|
|
106
|
$res; |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
$SPEC{diff_table_schema} = { |
151
|
|
|
|
|
|
|
v => 1.1, |
152
|
|
|
|
|
|
|
summary => 'Compare schema of two DBI tables', |
153
|
|
|
|
|
|
|
description => <<'_', |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
This function compares schemas of two DBI tables. You supply two `DBI` database |
156
|
|
|
|
|
|
|
handles along with table name and this function will return a hash: |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
{ |
159
|
|
|
|
|
|
|
deleted_columns => [...], |
160
|
|
|
|
|
|
|
added_columns => [...], |
161
|
|
|
|
|
|
|
modified_columns => { |
162
|
|
|
|
|
|
|
column1 => { |
163
|
|
|
|
|
|
|
old_type => '...', |
164
|
|
|
|
|
|
|
new_type => '...', |
165
|
|
|
|
|
|
|
... |
166
|
|
|
|
|
|
|
}, |
167
|
|
|
|
|
|
|
}, |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
_ |
171
|
|
|
|
|
|
|
args => { |
172
|
|
|
|
|
|
|
%diff_table_args, |
173
|
|
|
|
|
|
|
}, |
174
|
|
|
|
|
|
|
args_as => "array", |
175
|
|
|
|
|
|
|
result_naked => 1, |
176
|
|
|
|
|
|
|
"x.perinci.sub.wrapper.disable_validate_args" => 1, |
177
|
|
|
|
|
|
|
}; |
178
|
|
|
|
|
|
|
sub diff_table_schema { |
179
|
1
|
50
|
0
|
1
|
1
|
8
|
my $dbh1 = shift; my $arg_err; { no warnings ('void');require Scalar::Util;((defined($dbh1)) ? 1 : (($arg_err //= "Required but not specified"),0)) && ((Scalar::Util::blessed($dbh1)) ? 1 : (($arg_err //= "Not of type object"),0)); if ($arg_err) { die "diff_table_schema(): " . "Invalid argument value for dbh1: $arg_err" } } # VALIDATE_ARG |
|
1
|
50
|
0
|
6
|
|
2
|
|
|
1
|
50
|
|
|
|
107
|
|
|
6
|
50
|
|
|
|
77
|
|
|
6
|
|
|
|
|
8
|
|
|
6
|
|
|
|
|
8
|
|
|
6
|
|
|
|
|
38
|
|
|
6
|
|
|
|
|
32
|
|
|
6
|
|
|
|
|
16
|
|
|
0
|
|
|
|
|
0
|
|
180
|
1
|
50
|
0
|
1
|
|
6
|
my $dbh2 = shift; { no warnings ('void');((defined($dbh2)) ? 1 : (($arg_err //= "Required but not specified"),0)) && ((Scalar::Util::blessed($dbh2)) ? 1 : (($arg_err //= "Not of type object"),0)); if ($arg_err) { die "diff_table_schema(): " . "Invalid argument value for dbh2: $arg_err" } } # VALIDATE_ARG |
|
1
|
50
|
0
|
|
|
1
|
|
|
1
|
50
|
|
|
|
87
|
|
|
6
|
50
|
|
|
|
12
|
|
|
6
|
|
|
|
|
6
|
|
|
6
|
|
|
|
|
22
|
|
|
6
|
|
|
|
|
13
|
|
|
0
|
|
|
|
|
0
|
|
181
|
1
|
50
|
0
|
1
|
|
6
|
my $table1 = shift; { no warnings ('void');((defined($table1)) ? 1 : (($arg_err //= "Required but not specified"),0)) && ((!ref($table1)) ? 1 : (($arg_err //= "Not of type text"),0)); if ($arg_err) { die "diff_table_schema(): " . "Invalid argument value for table1: $arg_err" } } # VALIDATE_ARG |
|
1
|
50
|
0
|
|
|
2
|
|
|
1
|
50
|
|
|
|
70
|
|
|
6
|
50
|
|
|
|
12
|
|
|
6
|
|
|
|
|
7
|
|
|
6
|
|
|
|
|
20
|
|
|
6
|
|
|
|
|
8
|
|
|
0
|
|
|
|
|
0
|
|
182
|
1
|
50
|
66
|
1
|
|
5
|
my $table2 = shift // $table1; { no warnings ('void');((defined($table2)) ? 1 : (($arg_err //= "Required but not specified"),0)) && ((!ref($table2)) ? 1 : (($arg_err //= "Not of type text"),0)); if ($arg_err) { die "diff_table_schema(): " . "Invalid argument value for table2: $arg_err" } } # VALIDATE_ARG |
|
1
|
50
|
0
|
|
|
2
|
|
|
1
|
50
|
0
|
|
|
246
|
|
|
6
|
50
|
|
|
|
17
|
|
|
6
|
|
|
|
|
9
|
|
|
6
|
|
|
|
|
19
|
|
|
6
|
|
|
|
|
11
|
|
|
0
|
|
|
|
|
0
|
|
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
#$log->tracef("Comparing table %s vs %s ...", $table1, $table2); |
185
|
|
|
|
|
|
|
|
186
|
6
|
100
|
|
|
|
16
|
die "Table $table1 in first database does not exist" |
187
|
|
|
|
|
|
|
unless has_table($dbh1, $table1); |
188
|
5
|
100
|
|
|
|
2103
|
die "Table $table2 in second database does not exist" |
189
|
|
|
|
|
|
|
unless has_table($dbh2, $table2); |
190
|
4
|
|
|
|
|
1380
|
_diff_table_schema($dbh1, $dbh2, $table1, $table2); |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
$SPEC{table_schema_eq} = { |
194
|
|
|
|
|
|
|
v => 1.1, |
195
|
|
|
|
|
|
|
summary => 'Return true if two DBI tables have the same schema', |
196
|
|
|
|
|
|
|
description => <<'_', |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
This is basically just a shortcut for: |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
my $res = diff_table_schema(...); |
201
|
|
|
|
|
|
|
!%res; |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
_ |
204
|
|
|
|
|
|
|
args => { |
205
|
|
|
|
|
|
|
%diff_table_args, |
206
|
|
|
|
|
|
|
}, |
207
|
|
|
|
|
|
|
args_as => "array", |
208
|
|
|
|
|
|
|
result_naked => 1, |
209
|
|
|
|
|
|
|
"x.perinci.sub.wrapper.disable_validate_args" => 1, |
210
|
|
|
|
|
|
|
}; |
211
|
|
|
|
|
|
|
sub table_schema_eq { |
212
|
2
|
|
|
2
|
1
|
1282
|
my $res = diff_table_schema(@_); |
213
|
2
|
|
|
|
|
16
|
!%$res; |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
$SPEC{diff_db_schema} = { |
217
|
|
|
|
|
|
|
v => 1.1, |
218
|
|
|
|
|
|
|
summary => 'Compare schemas of two DBI databases', |
219
|
|
|
|
|
|
|
description => <<'_', |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
This function compares schemas of two DBI databases. You supply two `DBI` |
222
|
|
|
|
|
|
|
database handles and this function will return a hash: |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
{ |
225
|
|
|
|
|
|
|
# list of tables found in first db but missing in second |
226
|
|
|
|
|
|
|
deleted_tables => ['table1', ...], |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# list of tables found only in the second db |
229
|
|
|
|
|
|
|
added_tables => ['table2', ...], |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
# list of modified tables, with details for each |
232
|
|
|
|
|
|
|
modified_tables => { |
233
|
|
|
|
|
|
|
table3 => { |
234
|
|
|
|
|
|
|
deleted_columns => [...], |
235
|
|
|
|
|
|
|
added_columns => [...], |
236
|
|
|
|
|
|
|
modified_columns => { |
237
|
|
|
|
|
|
|
column1 => { |
238
|
|
|
|
|
|
|
old_type => '...', |
239
|
|
|
|
|
|
|
new_type => '...', |
240
|
|
|
|
|
|
|
... |
241
|
|
|
|
|
|
|
}, |
242
|
|
|
|
|
|
|
}, |
243
|
|
|
|
|
|
|
}, |
244
|
|
|
|
|
|
|
}, |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
_ |
248
|
|
|
|
|
|
|
args => { |
249
|
|
|
|
|
|
|
%diff_db_args, |
250
|
|
|
|
|
|
|
}, |
251
|
|
|
|
|
|
|
args_as => "array", |
252
|
|
|
|
|
|
|
result_naked => 1, |
253
|
|
|
|
|
|
|
"x.perinci.sub.wrapper.disable_validate_args" => 1, |
254
|
|
|
|
|
|
|
}; |
255
|
|
|
|
|
|
|
sub diff_db_schema { |
256
|
1
|
50
|
0
|
1
|
1
|
7
|
my $dbh1 = shift; my $arg_err; { no warnings ('void');require Scalar::Util;((defined($dbh1)) ? 1 : (($arg_err //= "Required but not specified"),0)) && ((Scalar::Util::blessed($dbh1)) ? 1 : (($arg_err //= "Not of type object"),0)); if ($arg_err) { die "diff_db_schema(): " . "Invalid argument value for dbh1: $arg_err" } } # VALIDATE_ARG |
|
1
|
50
|
0
|
5
|
|
2
|
|
|
1
|
50
|
|
|
|
102
|
|
|
5
|
50
|
|
|
|
65928
|
|
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
46
|
|
|
5
|
|
|
|
|
40
|
|
|
5
|
|
|
|
|
11
|
|
|
0
|
|
|
|
|
0
|
|
257
|
1
|
50
|
0
|
1
|
|
6
|
my $dbh2 = shift; { no warnings ('void');((defined($dbh2)) ? 1 : (($arg_err //= "Required but not specified"),0)) && ((Scalar::Util::blessed($dbh2)) ? 1 : (($arg_err //= "Not of type object"),0)); if ($arg_err) { die "diff_db_schema(): " . "Invalid argument value for dbh2: $arg_err" } } # VALIDATE_ARG |
|
1
|
50
|
0
|
|
|
1
|
|
|
1
|
50
|
|
|
|
314
|
|
|
5
|
50
|
|
|
|
9
|
|
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
19
|
|
|
5
|
|
|
|
|
12
|
|
|
0
|
|
|
|
|
0
|
|
258
|
|
|
|
|
|
|
|
259
|
5
|
|
|
|
|
16
|
my @tables1 = list_tables($dbh1); |
260
|
5
|
|
|
|
|
2833
|
my @tables2 = list_tables($dbh2); |
261
|
|
|
|
|
|
|
|
262
|
5
|
|
|
|
|
1962
|
log_trace("tables1: %s ...", \@tables1); |
263
|
5
|
|
|
|
|
22
|
log_trace("tables2: %s ...", \@tables2); |
264
|
|
|
|
|
|
|
|
265
|
5
|
|
|
|
|
12
|
my (@added, @deleted, %modified); |
266
|
5
|
|
|
|
|
12
|
for my $t (@tables1) { |
267
|
10
|
100
|
|
|
|
20
|
if (grep {$_ eq $t} @tables2) { |
|
20
|
|
|
|
|
48
|
|
268
|
|
|
|
|
|
|
#$log->tracef("Comparing table %s ...", $_); |
269
|
7
|
|
|
|
|
17
|
my $tres = _diff_table_schema($dbh1, $dbh2, $t, $t); |
270
|
7
|
100
|
|
|
|
23
|
$modified{$t} = $tres if %$tres; |
271
|
|
|
|
|
|
|
} else { |
272
|
3
|
|
|
|
|
9
|
push @deleted, $t; |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
} |
275
|
5
|
|
|
|
|
8
|
for my $t (@tables2) { |
276
|
10
|
100
|
|
|
|
14
|
if (grep {$_ eq $t} @tables1) { |
|
20
|
|
|
|
|
44
|
|
277
|
|
|
|
|
|
|
} else { |
278
|
3
|
|
|
|
|
4
|
push @added, $t; |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
5
|
|
|
|
|
8
|
my $res = {}; |
283
|
5
|
100
|
|
|
|
14
|
$res->{added_tables} = \@added if @added; |
284
|
5
|
100
|
|
|
|
10
|
$res->{deleted_tables} = \@deleted if @deleted; |
285
|
5
|
100
|
|
|
|
10
|
$res->{modified_tables} = \%modified if %modified; |
286
|
5
|
|
|
|
|
23
|
$res; |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
$SPEC{db_schema_eq} = { |
290
|
|
|
|
|
|
|
v => 1.1, |
291
|
|
|
|
|
|
|
summary => 'Return true if two DBI databases have the same schema', |
292
|
|
|
|
|
|
|
description => <<'_', |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
This is basically just a shortcut for: |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
my $res = diff_db_schema(...); |
297
|
|
|
|
|
|
|
!%$res; |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
_ |
300
|
|
|
|
|
|
|
args => { |
301
|
|
|
|
|
|
|
%diff_db_args, |
302
|
|
|
|
|
|
|
}, |
303
|
|
|
|
|
|
|
args_as => "array", |
304
|
|
|
|
|
|
|
result_naked => 1, |
305
|
|
|
|
|
|
|
"x.perinci.sub.wrapper.disable_validate_args" => 1, |
306
|
|
|
|
|
|
|
}; |
307
|
|
|
|
|
|
|
sub db_schema_eq { |
308
|
2
|
|
|
2
|
1
|
1729
|
my $res = diff_db_schema(@_); |
309
|
2
|
|
|
|
|
18
|
!%$res; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
1; |
313
|
|
|
|
|
|
|
# ABSTRACT: Compare schema of two DBI databases |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
__END__ |