Merge lp:~percona-toolkit-dev/percona-toolkit/pt-table-checksum-2.0-serialize_list-v2 into lp:percona-toolkit/2.0
- pt-table-checksum-2.0-serialize_list-v2
- Merge into 2.0
Proposed by
Daniel Nichter
Status: | Superseded |
---|---|
Proposed branch: | lp:~percona-toolkit-dev/percona-toolkit/pt-table-checksum-2.0-serialize_list-v2 |
Merge into: | lp:percona-toolkit/2.0 |
Diff against target: |
26997 lines (+12424/-10322) (has conflicts) 177 files modified
Changelog (+8/-2) bin/pt-table-checksum (+5137/-5510) bin/pt-table-sync (+80/-19) lib/CleanupTask.pm (+69/-0) lib/CompareResults.pm (+6/-4) lib/CopyRowsInsertSelect.pm (+17/-18) lib/Cxn.pm (+215/-0) lib/DSNParser.pm (+7/-5) lib/MasterSlave.pm (+85/-0) lib/MySQLDump.pm (+0/-322) lib/MySQLStatusWaiter.pm (+185/-0) lib/NibbleIterator.pm (+545/-269) lib/OobNibbleIterator.pm (+230/-0) lib/OptionParser.pm (+1/-1) lib/PerconaTest.pm (+66/-4) lib/Progress.pm (+13/-2) lib/Quoter.pm (+61/-0) lib/ReplicaLagWaiter.pm (+173/-0) lib/Retry.pm (+35/-41) lib/RowChecksum.pm (+82/-71) lib/Sandbox.pm (+2/-0) lib/SchemaIterator.pm (+99/-26) lib/TableChecksum.pm (+10/-12) lib/TableChunker.pm (+5/-5) lib/TableParser.pm (+75/-60) lib/TableSyncer.pm (+17/-18) lib/WeightedAvgRate.pm (+102/-0) sandbox/load-sakila-db (+0/-3) sandbox/start-sandbox (+3/-0) sandbox/test-env (+10/-2) t/lib/CleanupTask.t (+36/-0) t/lib/CompareResults.t (+0/-3) t/lib/Cxn.t (+259/-0) t/lib/DSNParser.t (+1/-1) t/lib/MasterSlave.t (+113/-4) t/lib/MySQLDump.t (+0/-92) t/lib/MySQLStatusWaiter.t (+221/-0) t/lib/NibbleIterator.t (+512/-157) t/lib/OobNibbleIterator.t (+264/-0) t/lib/OptionParser.t (+2/-2) t/lib/Progress.t (+49/-4) t/lib/QueryReview.t (+3/-5) t/lib/Quoter.t (+78/-1) t/lib/ReplicaLagWaiter.t (+121/-0) t/lib/Retry.t (+83/-118) t/lib/RowChecksum.t (+64/-53) t/lib/RowDiff-custom.t (+1/-3) t/lib/RowDiff.t (+1/-3) t/lib/SQLParser.t (+1/-1) t/lib/Schema.t (+1/-1) t/lib/SchemaIterator.t (+28/-11) t/lib/TableChecksum.t (+1/-3) t/lib/TableChunker.t (+26/-28) t/lib/TableParser.t (+25/-156) t/lib/TableSyncChunk.t (+5/-7) t/lib/TableSyncNibble.t (+7/-9) t/lib/TableSyncer.t (+32/-41) t/lib/WeightedAvgRate.t (+85/-0) t/lib/samples/MasterSlave/dsn_table.sql (+12/-0) t/lib/samples/NibbleIterator/bad_tables.sql (+21/-0) t/lib/samples/SchemaIterator/all-dbs-tbls.txt (+0/-2) t/lib/samples/SchemaIterator/mysql-user-ddl-5.0.txt (+1/-0) t/lib/samples/SchemaIterator/mysql-user-ddl.txt (+1/-0) t/lib/samples/SchemaIterator/resume-from-ignored-sakila-payment.txt (+3/-0) t/lib/samples/SchemaIterator/resume-from-sakila-payment.txt (+4/-0) t/lib/samples/char-chunking/ascii.sql (+146/-0) t/lib/samples/tables/sakila.actor (+8/-0) t/pt-table-checksum/arg_table.t (+0/-106) t/pt-table-checksum/basics.t (+280/-118) t/pt-table-checksum/char_chunking.t (+19/-22) t/pt-table-checksum/checksum.t (+0/-59) t/pt-table-checksum/chunk_column.t (+0/-104) t/pt-table-checksum/chunk_index.t (+52/-81) t/pt-table-checksum/chunk_size.t (+78/-18) t/pt-table-checksum/create_replicate_table.t (+84/-60) t/pt-table-checksum/error_handling.t (+79/-6) t/pt-table-checksum/filters.t (+102/-53) t/pt-table-checksum/float_precision.t (+55/-15) t/pt-table-checksum/fnv_64.t (+72/-20) t/pt-table-checksum/force_index.t (+0/-67) t/pt-table-checksum/ignore_columns.t (+40/-20) t/pt-table-checksum/issue_1020.t (+0/-53) t/pt-table-checksum/issue_1182.t (+0/-59) t/pt-table-checksum/issue_122.t (+0/-70) t/pt-table-checksum/issue_1319.t (+0/-52) t/pt-table-checksum/issue_21.t (+0/-92) t/pt-table-checksum/issue_35.t (+0/-62) t/pt-table-checksum/issue_388.t (+11/-3) t/pt-table-checksum/issue_47.t (+32/-12) t/pt-table-checksum/issue_51.t (+0/-77) t/pt-table-checksum/issue_602.t (+12/-6) t/pt-table-checksum/issue_69.t (+0/-75) t/pt-table-checksum/issue_947.t (+0/-49) t/pt-table-checksum/issue_982.t (+0/-226) t/pt-table-checksum/offset_modulo.t (+0/-52) t/pt-table-checksum/option_sanity.t (+132/-7) t/pt-table-checksum/oversize_chunks.t (+0/-63) t/pt-table-checksum/probability.t (+0/-60) t/pt-table-checksum/progress.t (+45/-43) t/pt-table-checksum/replication_filters.t (+241/-42) t/pt-table-checksum/resume.t (+662/-69) t/pt-table-checksum/retry_timeouts.t (+0/-112) t/pt-table-checksum/samples/3tbl-resume.sql (+27/-0) t/pt-table-checksum/samples/arg-table.sql (+0/-7) t/pt-table-checksum/samples/basic_replicate_output (+0/-2) t/pt-table-checksum/samples/before.sql (+0/-80) t/pt-table-checksum/samples/char-chunk-ascii-explain.txt (+23/-9) t/pt-table-checksum/samples/char-chunk-ascii-oversize.txt (+0/-9) t/pt-table-checksum/samples/char-chunk-ascii.txt (+2/-9) t/pt-table-checksum/samples/char-chunking.sql (+0/-110) t/pt-table-checksum/samples/checksum_results/3tbl-resume (+24/-0) t/pt-table-checksum/samples/checksum_results/3tbl-resume-bar (+11/-0) t/pt-table-checksum/samples/checksum_results/sakila-done-1k-chunks (+65/-0) t/pt-table-checksum/samples/checksum_results/sakila-done-singles (+16/-0) t/pt-table-checksum/samples/checksum_tbl.sql (+0/-14) t/pt-table-checksum/samples/checksum_tbl_truncated.sql (+16/-14) t/pt-table-checksum/samples/chunkidx001.txt (+19/-0) t/pt-table-checksum/samples/chunkidx002.txt (+19/-0) t/pt-table-checksum/samples/chunkidx003.txt (+19/-0) t/pt-table-checksum/samples/chunkidx004.txt (+12/-0) t/pt-table-checksum/samples/chunkidx005.txt (+12/-0) t/pt-table-checksum/samples/default-results-5.1.txt (+38/-0) t/pt-table-checksum/samples/float_precision.sql (+7/-0) t/pt-table-checksum/samples/fnv64-sakila-city.txt (+24/-0) t/pt-table-checksum/samples/issue_122.sql (+0/-15) t/pt-table-checksum/samples/issue_21.sql (+5/-3) t/pt-table-checksum/samples/issue_467.txt (+0/-5) t/pt-table-checksum/samples/issue_922.sql (+0/-10) t/pt-table-checksum/samples/no-recheck.txt (+10/-0) t/pt-table-checksum/samples/oversize-chunks-allowed.txt (+0/-6) t/pt-table-checksum/samples/oversize-chunks.sql (+24/-3) t/pt-table-checksum/samples/oversize-chunks.txt (+18/-6) t/pt-table-checksum/samples/replicate.sql (+0/-22) t/pt-table-checksum/samples/resume-chunked-complete.txt (+0/-9) t/pt-table-checksum/samples/resume-chunked-partial.txt (+0/-5) t/pt-table-checksum/samples/resume-complete.txt (+0/-3) t/pt-table-checksum/samples/resume-partial.txt (+0/-2) t/pt-table-checksum/samples/resume.sql (+0/-5) t/pt-table-checksum/samples/resume2-chunked-complete.txt (+0/-17) t/pt-table-checksum/samples/resume2-chunked-partial.txt (+0/-6) t/pt-table-checksum/samples/resume2.sql (+0/-7) t/pt-table-checksum/samples/sample_1 (+0/-6) t/pt-table-checksum/samples/sample_2 (+0/-5) t/pt-table-checksum/samples/sample_schema_opt (+0/-35) t/pt-table-checksum/samples/static-chunk-size-results-5.1.txt (+38/-0) t/pt-table-checksum/samples/unchunkable-table-small.txt (+0/-2) t/pt-table-checksum/samples/unchunkable-table.txt (+0/-1) t/pt-table-checksum/samples/where01.out (+0/-3) t/pt-table-checksum/samples/where01.sql (+0/-26) t/pt-table-checksum/samples/where02.out (+0/-4) t/pt-table-checksum/samples/where02.sql (+0/-26) t/pt-table-checksum/schema.t (+0/-172) t/pt-table-checksum/scripts/exec-wait-exec.sh (+10/-0) t/pt-table-checksum/scripts/wait-for-chunk.sh (+8/-0) t/pt-table-checksum/since.t (+0/-79) t/pt-table-checksum/standard_options.t (+106/-13) t/pt-table-checksum/throttle.t (+39/-226) t/pt-table-checksum/unchunkable_tables.t (+0/-57) t/pt-table-checksum/zero_chunk.t (+0/-56) t/pt-table-sync/bidirectional.t (+17/-18) t/pt-table-sync/diff_where.t (+63/-0) t/pt-table-sync/filters.t (+6/-8) t/pt-table-sync/issue_408.t (+5/-5) t/pt-table-sync/issue_560.t (+6/-11) t/pt-table-sync/issue_627.t (+1/-2) t/pt-table-sync/issue_79.t (+2/-3) t/pt-table-sync/issue_996.t (+5/-8) t/pt-table-sync/samples/bidirectional/queries001.txt (+7/-0) t/pt-table-sync/samples/diff001.sql (+12/-0) t/pt-table-sync/samples/issue_560.sql (+0/-13) t/pt-table-sync/samples/issue_560_output_2.txt (+12/-12) t/pt-table-sync/samples/simple-tbl-ddl.sql (+10/-0) t/pt-table-sync/samples/simple-tbls.sql (+62/-0) t/pt-table-sync/sync_to_differnt_db.t (+5/-6) t/pt-table-sync/triggers.t (+4/-4) util/build-packages (+26/-11) util/wait-to-exec (+40/-0) Text conflict in Changelog |
To merge this branch: | bzr merge lp:~percona-toolkit-dev/percona-toolkit/pt-table-checksum-2.0-serialize_list-v2 |
Related bugs: |
Reviewer | Review Type | Date Requested | Status |
---|---|---|---|
Brian Fraser (community) | Approve | ||
Daniel Nichter | Approve | ||
Review via email: mp+87048@code.launchpad.net |
This proposal has been superseded by a proposal from 2011-12-28.
Commit message
Description of the change
To post a comment you must log in.
Revision history for this message
Daniel Nichter (daniel-nichter) : | # |
review:
Approve
- 263. By Brian Fraser
-
Slight improvement to the deserialize regex and its test output.
Revision history for this message
Daniel Nichter (daniel-nichter) : | # |
review:
Approve
Revision history for this message
Brian Fraser (fraserbn) : | # |
review:
Approve
Unmerged revisions
Preview Diff
[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
1 | === modified file 'Changelog' |
2 | --- Changelog 2011-10-11 14:31:42 +0000 |
3 | +++ Changelog 2011-12-28 23:12:24 +0000 |
4 | @@ -1,7 +1,13 @@ |
5 | Changelog for Percona Toolkit |
6 | |
7 | - * Fixed bug 821717: pt-tcp-model --type=requests crashes |
8 | - |
9 | +<<<<<<< TREE |
10 | + * Fixed bug 821717: pt-tcp-model --type=requests crashes |
11 | + |
12 | +======= |
13 | + * Completely redesigned pt-table-checksum. |
14 | + * Fixed bug 821717: pt-tcp-model --type=requests crashes |
15 | + |
16 | +>>>>>>> MERGE-SOURCE |
17 | v1.0.1 released 2011-09-01 |
18 | |
19 | * Fixed bug 819421: MasterSlave::is_replication_thread() doesn't match all |
20 | |
21 | === modified file 'bin/pt-table-checksum' |
22 | --- bin/pt-table-checksum 2011-09-01 16:00:38 +0000 |
23 | +++ bin/pt-table-checksum 2011-12-28 23:12:24 +0000 |
24 | @@ -9,15 +9,15 @@ |
25 | use constant MKDEBUG => $ENV{MKDEBUG} || 0; |
26 | |
27 | # ########################################################################### |
28 | -# TableParser package |
29 | +# DSNParser package |
30 | # This package is a copy without comments from the original. The original |
31 | # with comments and its test file can be found in the Bazaar repository at, |
32 | -# lib/TableParser.pm |
33 | -# t/lib/TableParser.t |
34 | +# lib/DSNParser.pm |
35 | +# t/lib/DSNParser.t |
36 | # See https://launchpad.net/percona-toolkit for more information. |
37 | # ########################################################################### |
38 | { |
39 | -package TableParser; |
40 | +package DSNParser; |
41 | |
42 | use strict; |
43 | use warnings FATAL => 'all'; |
44 | @@ -25,757 +25,331 @@ |
45 | use constant MKDEBUG => $ENV{MKDEBUG} || 0; |
46 | |
47 | use Data::Dumper; |
48 | -$Data::Dumper::Indent = 1; |
49 | -$Data::Dumper::Sortkeys = 1; |
50 | +$Data::Dumper::Indent = 0; |
51 | $Data::Dumper::Quotekeys = 0; |
52 | |
53 | +eval { |
54 | + require DBI; |
55 | +}; |
56 | +my $have_dbi = $EVAL_ERROR ? 0 : 1; |
57 | + |
58 | sub new { |
59 | my ( $class, %args ) = @_; |
60 | - my @required_args = qw(Quoter); |
61 | - foreach my $arg ( @required_args ) { |
62 | + foreach my $arg ( qw(opts) ) { |
63 | die "I need a $arg argument" unless $args{$arg}; |
64 | } |
65 | - my $self = { %args }; |
66 | + my $self = { |
67 | + opts => {} # h, P, u, etc. Should come from DSN OPTIONS section in POD. |
68 | + }; |
69 | + foreach my $opt ( @{$args{opts}} ) { |
70 | + if ( !$opt->{key} || !$opt->{desc} ) { |
71 | + die "Invalid DSN option: ", Dumper($opt); |
72 | + } |
73 | + MKDEBUG && _d('DSN option:', |
74 | + join(', ', |
75 | + map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } |
76 | + keys %$opt |
77 | + ) |
78 | + ); |
79 | + $self->{opts}->{$opt->{key}} = { |
80 | + dsn => $opt->{dsn}, |
81 | + desc => $opt->{desc}, |
82 | + copy => $opt->{copy} || 0, |
83 | + }; |
84 | + } |
85 | return bless $self, $class; |
86 | } |
87 | |
88 | +sub prop { |
89 | + my ( $self, $prop, $value ) = @_; |
90 | + if ( @_ > 2 ) { |
91 | + MKDEBUG && _d('Setting', $prop, 'property'); |
92 | + $self->{$prop} = $value; |
93 | + } |
94 | + return $self->{$prop}; |
95 | +} |
96 | + |
97 | sub parse { |
98 | - my ( $self, $ddl, $opts ) = @_; |
99 | - return unless $ddl; |
100 | - if ( ref $ddl eq 'ARRAY' ) { |
101 | - if ( lc $ddl->[0] eq 'table' ) { |
102 | - $ddl = $ddl->[1]; |
103 | - } |
104 | - else { |
105 | - return { |
106 | - engine => 'VIEW', |
107 | - }; |
108 | - } |
109 | - } |
110 | - |
111 | - if ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) { |
112 | - die "Cannot parse table definition; is ANSI quoting " |
113 | - . "enabled or SQL_QUOTE_SHOW_CREATE disabled?"; |
114 | - } |
115 | - |
116 | - my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/; |
117 | - (undef, $name) = $self->{Quoter}->split_unquote($name) if $name; |
118 | - |
119 | - $ddl =~ s/(`[^`]+`)/\L$1/g; |
120 | - |
121 | - my $engine = $self->get_engine($ddl); |
122 | - |
123 | - my @defs = $ddl =~ m/^(\s+`.*?),?$/gm; |
124 | - my @cols = map { $_ =~ m/`([^`]+)`/ } @defs; |
125 | - MKDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); |
126 | - |
127 | - my %def_for; |
128 | - @def_for{@cols} = @defs; |
129 | - |
130 | - my (@nums, @null); |
131 | - my (%type_for, %is_nullable, %is_numeric, %is_autoinc); |
132 | - foreach my $col ( @cols ) { |
133 | - my $def = $def_for{$col}; |
134 | - my ( $type ) = $def =~ m/`[^`]+`\s([a-z]+)/; |
135 | - die "Can't determine column type for $def" unless $type; |
136 | - $type_for{$col} = $type; |
137 | - if ( $type =~ m/(?:(?:tiny|big|medium|small)?int|float|double|decimal|year)/ ) { |
138 | - push @nums, $col; |
139 | - $is_numeric{$col} = 1; |
140 | - } |
141 | - if ( $def !~ m/NOT NULL/ ) { |
142 | - push @null, $col; |
143 | - $is_nullable{$col} = 1; |
144 | - } |
145 | - $is_autoinc{$col} = $def =~ m/AUTO_INCREMENT/i ? 1 : 0; |
146 | - } |
147 | - |
148 | - my ($keys, $clustered_key) = $self->get_keys($ddl, $opts, \%is_nullable); |
149 | - |
150 | - my ($charset) = $ddl =~ m/DEFAULT CHARSET=(\w+)/; |
151 | - |
152 | - return { |
153 | - name => $name, |
154 | - cols => \@cols, |
155 | - col_posn => { map { $cols[$_] => $_ } 0..$#cols }, |
156 | - is_col => { map { $_ => 1 } @cols }, |
157 | - null_cols => \@null, |
158 | - is_nullable => \%is_nullable, |
159 | - is_autoinc => \%is_autoinc, |
160 | - clustered_key => $clustered_key, |
161 | - keys => $keys, |
162 | - defs => \%def_for, |
163 | - numeric_cols => \@nums, |
164 | - is_numeric => \%is_numeric, |
165 | - engine => $engine, |
166 | - type_for => \%type_for, |
167 | - charset => $charset, |
168 | - }; |
169 | -} |
170 | - |
171 | -sub sort_indexes { |
172 | - my ( $self, $tbl ) = @_; |
173 | - |
174 | - my @indexes |
175 | - = sort { |
176 | - (($a ne 'PRIMARY') <=> ($b ne 'PRIMARY')) |
177 | - || ( !$tbl->{keys}->{$a}->{is_unique} <=> !$tbl->{keys}->{$b}->{is_unique} ) |
178 | - || ( $tbl->{keys}->{$a}->{is_nullable} <=> $tbl->{keys}->{$b}->{is_nullable} ) |
179 | - || ( scalar(@{$tbl->{keys}->{$a}->{cols}}) <=> scalar(@{$tbl->{keys}->{$b}->{cols}}) ) |
180 | - } |
181 | - grep { |
182 | - $tbl->{keys}->{$_}->{type} eq 'BTREE' |
183 | - } |
184 | - sort keys %{$tbl->{keys}}; |
185 | - |
186 | - MKDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); |
187 | - return @indexes; |
188 | -} |
189 | - |
190 | -sub find_best_index { |
191 | - my ( $self, $tbl, $index ) = @_; |
192 | - my $best; |
193 | - if ( $index ) { |
194 | - ($best) = grep { uc $_ eq uc $index } keys %{$tbl->{keys}}; |
195 | - } |
196 | - if ( !$best ) { |
197 | - if ( $index ) { |
198 | - die "Index '$index' does not exist in table"; |
199 | - } |
200 | - else { |
201 | - ($best) = $self->sort_indexes($tbl); |
202 | - } |
203 | - } |
204 | - MKDEBUG && _d('Best index found is', $best); |
205 | - return $best; |
206 | -} |
207 | - |
208 | -sub find_possible_keys { |
209 | - my ( $self, $dbh, $database, $table, $quoter, $where ) = @_; |
210 | - return () unless $where; |
211 | - my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table) |
212 | - . ' WHERE ' . $where; |
213 | - MKDEBUG && _d($sql); |
214 | - my $expl = $dbh->selectrow_hashref($sql); |
215 | - $expl = { map { lc($_) => $expl->{$_} } keys %$expl }; |
216 | - if ( $expl->{possible_keys} ) { |
217 | - MKDEBUG && _d('possible_keys =', $expl->{possible_keys}); |
218 | - my @candidates = split(',', $expl->{possible_keys}); |
219 | - my %possible = map { $_ => 1 } @candidates; |
220 | - if ( $expl->{key} ) { |
221 | - MKDEBUG && _d('MySQL chose', $expl->{key}); |
222 | - unshift @candidates, grep { $possible{$_} } split(',', $expl->{key}); |
223 | - MKDEBUG && _d('Before deduping:', join(', ', @candidates)); |
224 | - my %seen; |
225 | - @candidates = grep { !$seen{$_}++ } @candidates; |
226 | - } |
227 | - MKDEBUG && _d('Final list:', join(', ', @candidates)); |
228 | - return @candidates; |
229 | - } |
230 | - else { |
231 | - MKDEBUG && _d('No keys in possible_keys'); |
232 | - return (); |
233 | - } |
234 | -} |
235 | - |
236 | -sub check_table { |
237 | - my ( $self, %args ) = @_; |
238 | - my @required_args = qw(dbh db tbl); |
239 | - foreach my $arg ( @required_args ) { |
240 | - die "I need a $arg argument" unless $args{$arg}; |
241 | - } |
242 | - my ($dbh, $db, $tbl) = @args{@required_args}; |
243 | - my $q = $self->{Quoter}; |
244 | - my $db_tbl = $q->quote($db, $tbl); |
245 | - MKDEBUG && _d('Checking', $db_tbl); |
246 | - |
247 | - my $sql = "SHOW TABLES FROM " . $q->quote($db) |
248 | - . ' LIKE ' . $q->literal_like($tbl); |
249 | - MKDEBUG && _d($sql); |
250 | - my $row; |
251 | - eval { |
252 | - $row = $dbh->selectrow_arrayref($sql); |
253 | - }; |
254 | - if ( $EVAL_ERROR ) { |
255 | - MKDEBUG && _d($EVAL_ERROR); |
256 | - return 0; |
257 | - } |
258 | - if ( !$row->[0] || $row->[0] ne $tbl ) { |
259 | - MKDEBUG && _d('Table does not exist'); |
260 | - return 0; |
261 | - } |
262 | - |
263 | - MKDEBUG && _d('Table exists; no privs to check'); |
264 | - return 1 unless $args{all_privs}; |
265 | - |
266 | - $sql = "SHOW FULL COLUMNS FROM $db_tbl"; |
267 | - MKDEBUG && _d($sql); |
268 | - eval { |
269 | - $row = $dbh->selectrow_hashref($sql); |
270 | - }; |
271 | - if ( $EVAL_ERROR ) { |
272 | - MKDEBUG && _d($EVAL_ERROR); |
273 | - return 0; |
274 | - } |
275 | - if ( !scalar keys %$row ) { |
276 | - MKDEBUG && _d('Table has no columns:', Dumper($row)); |
277 | - return 0; |
278 | - } |
279 | - my $privs = $row->{privileges} || $row->{Privileges}; |
280 | - |
281 | - $sql = "DELETE FROM $db_tbl LIMIT 0"; |
282 | - MKDEBUG && _d($sql); |
283 | - eval { |
284 | - $dbh->do($sql); |
285 | - }; |
286 | - my $can_delete = $EVAL_ERROR ? 0 : 1; |
287 | - |
288 | - MKDEBUG && _d('User privs on', $db_tbl, ':', $privs, |
289 | - ($can_delete ? 'delete' : '')); |
290 | - |
291 | - if ( !($privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/ |
292 | - && $can_delete) ) { |
293 | - MKDEBUG && _d('User does not have all privs'); |
294 | - return 0; |
295 | - } |
296 | - |
297 | - MKDEBUG && _d('User has all privs'); |
298 | - return 1; |
299 | -} |
300 | - |
301 | -sub get_engine { |
302 | - my ( $self, $ddl, $opts ) = @_; |
303 | - my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; |
304 | - MKDEBUG && _d('Storage engine:', $engine); |
305 | - return $engine || undef; |
306 | -} |
307 | - |
308 | -sub get_keys { |
309 | - my ( $self, $ddl, $opts, $is_nullable ) = @_; |
310 | - my $engine = $self->get_engine($ddl); |
311 | - my $keys = {}; |
312 | - my $clustered_key = undef; |
313 | - |
314 | - KEY: |
315 | - foreach my $key ( $ddl =~ m/^ ((?:[A-Z]+ )?KEY .*)$/gm ) { |
316 | - |
317 | - next KEY if $key =~ m/FOREIGN/; |
318 | - |
319 | - my $key_ddl = $key; |
320 | - MKDEBUG && _d('Parsed key:', $key_ddl); |
321 | - |
322 | - if ( $engine !~ m/MEMORY|HEAP/ ) { |
323 | - $key =~ s/USING HASH/USING BTREE/; |
324 | - } |
325 | - |
326 | - my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/; |
327 | - my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/; |
328 | - $type = $type || $special || 'BTREE'; |
329 | - if ( $opts->{mysql_version} && $opts->{mysql_version} lt '004001000' |
330 | - && $engine =~ m/HEAP|MEMORY/i ) |
331 | + my ( $self, $dsn, $prev, $defaults ) = @_; |
332 | + if ( !$dsn ) { |
333 | + MKDEBUG && _d('No DSN to parse'); |
334 | + return; |
335 | + } |
336 | + MKDEBUG && _d('Parsing', $dsn); |
337 | + $prev ||= {}; |
338 | + $defaults ||= {}; |
339 | + my %given_props; |
340 | + my %final_props; |
341 | + my $opts = $self->{opts}; |
342 | + |
343 | + foreach my $dsn_part ( split(/,/, $dsn) ) { |
344 | + if ( my ($prop_key, $prop_val) = $dsn_part =~ m/^(.)=(.*)$/ ) { |
345 | + $given_props{$prop_key} = $prop_val; |
346 | + } |
347 | + else { |
348 | + MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); |
349 | + $given_props{h} = $dsn_part; |
350 | + } |
351 | + } |
352 | + |
353 | + foreach my $key ( keys %$opts ) { |
354 | + MKDEBUG && _d('Finding value for', $key); |
355 | + $final_props{$key} = $given_props{$key}; |
356 | + if ( !defined $final_props{$key} |
357 | + && defined $prev->{$key} && $opts->{$key}->{copy} ) |
358 | { |
359 | - $type = 'HASH'; # MySQL pre-4.1 supports only HASH indexes on HEAP |
360 | - } |
361 | - |
362 | - my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/; |
363 | - my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0; |
364 | - my @cols; |
365 | - my @col_prefixes; |
366 | - foreach my $col_def ( $cols =~ m/`[^`]+`(?:\(\d+\))?/g ) { |
367 | - my ($name, $prefix) = $col_def =~ m/`([^`]+)`(?:\((\d+)\))?/; |
368 | - push @cols, $name; |
369 | - push @col_prefixes, $prefix; |
370 | - } |
371 | - $name =~ s/`//g; |
372 | - |
373 | - MKDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); |
374 | - |
375 | - $keys->{$name} = { |
376 | - name => $name, |
377 | - type => $type, |
378 | - colnames => $cols, |
379 | - cols => \@cols, |
380 | - col_prefixes => \@col_prefixes, |
381 | - is_unique => $unique, |
382 | - is_nullable => scalar(grep { $is_nullable->{$_} } @cols), |
383 | - is_col => { map { $_ => 1 } @cols }, |
384 | - ddl => $key_ddl, |
385 | - }; |
386 | - |
387 | - if ( $engine =~ m/InnoDB/i && !$clustered_key ) { |
388 | - my $this_key = $keys->{$name}; |
389 | - if ( $this_key->{name} eq 'PRIMARY' ) { |
390 | - $clustered_key = 'PRIMARY'; |
391 | - } |
392 | - elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) { |
393 | - $clustered_key = $this_key->{name}; |
394 | - } |
395 | - MKDEBUG && $clustered_key && _d('This key is the clustered key'); |
396 | - } |
397 | - } |
398 | - |
399 | - return $keys, $clustered_key; |
400 | -} |
401 | - |
402 | -sub get_fks { |
403 | - my ( $self, $ddl, $opts ) = @_; |
404 | - my $q = $self->{Quoter}; |
405 | - my $fks = {}; |
406 | - |
407 | - foreach my $fk ( |
408 | - $ddl =~ m/CONSTRAINT .* FOREIGN KEY .* REFERENCES [^\)]*\)/mg ) |
409 | - { |
410 | - my ( $name ) = $fk =~ m/CONSTRAINT `(.*?)`/; |
411 | - my ( $cols ) = $fk =~ m/FOREIGN KEY \(([^\)]+)\)/; |
412 | - my ( $parent, $parent_cols ) = $fk =~ m/REFERENCES (\S+) \(([^\)]+)\)/; |
413 | - |
414 | - my ($db, $tbl) = $q->split_unquote($parent, $opts->{database}); |
415 | - my %parent_tbl = (tbl => $tbl); |
416 | - $parent_tbl{db} = $db if $db; |
417 | - |
418 | - if ( $parent !~ m/\./ && $opts->{database} ) { |
419 | - $parent = $q->quote($opts->{database}) . ".$parent"; |
420 | - } |
421 | - |
422 | - $fks->{$name} = { |
423 | - name => $name, |
424 | - colnames => $cols, |
425 | - cols => [ map { s/[ `]+//g; $_; } split(',', $cols) ], |
426 | - parent_tbl => \%parent_tbl, |
427 | - parent_tblname => $parent, |
428 | - parent_cols => [ map { s/[ `]+//g; $_; } split(',', $parent_cols) ], |
429 | - parent_colnames=> $parent_cols, |
430 | - ddl => $fk, |
431 | - }; |
432 | - } |
433 | - |
434 | - return $fks; |
435 | -} |
436 | - |
437 | -sub remove_auto_increment { |
438 | - my ( $self, $ddl ) = @_; |
439 | - $ddl =~ s/(^\).*?) AUTO_INCREMENT=\d+\b/$1/m; |
440 | - return $ddl; |
441 | -} |
442 | - |
443 | -sub remove_secondary_indexes { |
444 | - my ( $self, $ddl ) = @_; |
445 | - my $sec_indexes_ddl; |
446 | - my $tbl_struct = $self->parse($ddl); |
447 | - |
448 | - if ( ($tbl_struct->{engine} || '') =~ m/InnoDB/i ) { |
449 | - my $clustered_key = $tbl_struct->{clustered_key}; |
450 | - $clustered_key ||= ''; |
451 | - |
452 | - my @sec_indexes = map { |
453 | - my $key_def = $_->{ddl}; |
454 | - $key_def =~ s/([\(\)])/\\$1/g; |
455 | - $ddl =~ s/\s+$key_def//i; |
456 | - |
457 | - my $key_ddl = "ADD $_->{ddl}"; |
458 | - $key_ddl .= ',' unless $key_ddl =~ m/,$/; |
459 | - $key_ddl; |
460 | - } |
461 | - grep { $_->{name} ne $clustered_key } |
462 | - values %{$tbl_struct->{keys}}; |
463 | - MKDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); |
464 | - |
465 | - if ( @sec_indexes ) { |
466 | - $sec_indexes_ddl = join(' ', @sec_indexes); |
467 | - $sec_indexes_ddl =~ s/,$//; |
468 | - } |
469 | - |
470 | - $ddl =~ s/,(\n\) )/$1/s; |
471 | + $final_props{$key} = $prev->{$key}; |
472 | + MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); |
473 | + } |
474 | + if ( !defined $final_props{$key} ) { |
475 | + $final_props{$key} = $defaults->{$key}; |
476 | + MKDEBUG && _d('Copying value for', $key, 'from defaults'); |
477 | + } |
478 | + } |
479 | + |
480 | + foreach my $key ( keys %given_props ) { |
481 | + die "Unknown DSN option '$key' in '$dsn'. For more details, " |
482 | + . "please use the --help option, or try 'perldoc $PROGRAM_NAME' " |
483 | + . "for complete documentation." |
484 | + unless exists $opts->{$key}; |
485 | + } |
486 | + if ( (my $required = $self->prop('required')) ) { |
487 | + foreach my $key ( keys %$required ) { |
488 | + die "Missing required DSN option '$key' in '$dsn'. For more details, " |
489 | + . "please use the --help option, or try 'perldoc $PROGRAM_NAME' " |
490 | + . "for complete documentation." |
491 | + unless $final_props{$key}; |
492 | + } |
493 | + } |
494 | + |
495 | + return \%final_props; |
496 | +} |
497 | + |
498 | +sub parse_options { |
499 | + my ( $self, $o ) = @_; |
500 | + die 'I need an OptionParser object' unless ref $o eq 'OptionParser'; |
501 | + my $dsn_string |
502 | + = join(',', |
503 | + map { "$_=".$o->get($_); } |
504 | + grep { $o->has($_) && $o->get($_) } |
505 | + keys %{$self->{opts}} |
506 | + ); |
507 | + MKDEBUG && _d('DSN string made from options:', $dsn_string); |
508 | + return $self->parse($dsn_string); |
509 | +} |
510 | + |
511 | +sub as_string { |
512 | + my ( $self, $dsn, $props ) = @_; |
513 | + return $dsn unless ref $dsn; |
514 | + my @keys = $props ? @$props : sort keys %$dsn; |
515 | + return join(',', |
516 | + map { "$_=" . ($_ eq 'p' ? '...' : $dsn->{$_}) } |
517 | + grep { |
518 | + exists $self->{opts}->{$_} |
519 | + && exists $dsn->{$_} |
520 | + && defined $dsn->{$_} |
521 | + } @keys); |
522 | +} |
523 | + |
524 | +sub usage { |
525 | + my ( $self ) = @_; |
526 | + my $usage |
527 | + = "DSN syntax is key=value[,key=value...] Allowable DSN keys:\n\n" |
528 | + . " KEY COPY MEANING\n" |
529 | + . " === ==== =============================================\n"; |
530 | + my %opts = %{$self->{opts}}; |
531 | + foreach my $key ( sort keys %opts ) { |
532 | + $usage .= " $key " |
533 | + . ($opts{$key}->{copy} ? 'yes ' : 'no ') |
534 | + . ($opts{$key}->{desc} || '[No description]') |
535 | + . "\n"; |
536 | + } |
537 | + $usage .= "\n If the DSN is a bareword, the word is treated as the 'h' key.\n"; |
538 | + return $usage; |
539 | +} |
540 | + |
541 | +sub get_cxn_params { |
542 | + my ( $self, $info ) = @_; |
543 | + my $dsn; |
544 | + my %opts = %{$self->{opts}}; |
545 | + my $driver = $self->prop('dbidriver') || ''; |
546 | + if ( $driver eq 'Pg' ) { |
547 | + $dsn = 'DBI:Pg:dbname=' . ( $info->{D} || '' ) . ';' |
548 | + . join(';', map { "$opts{$_}->{dsn}=$info->{$_}" } |
549 | + grep { defined $info->{$_} } |
550 | + qw(h P)); |
551 | } |
552 | else { |
553 | - MKDEBUG && _d('Not removing secondary indexes from', |
554 | - $tbl_struct->{engine}, 'table'); |
555 | - } |
556 | - |
557 | - return $ddl, $sec_indexes_ddl, $tbl_struct; |
558 | -} |
559 | - |
560 | -sub _d { |
561 | - my ($package, undef, $line) = caller 0; |
562 | - @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
563 | - map { defined $_ ? $_ : 'undef' } |
564 | - @_; |
565 | - print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; |
566 | -} |
567 | - |
568 | -1; |
569 | -} |
570 | -# ########################################################################### |
571 | -# End TableParser package |
572 | -# ########################################################################### |
573 | - |
574 | -# ########################################################################### |
575 | -# TableChecksum package |
576 | -# This package is a copy without comments from the original. The original |
577 | -# with comments and its test file can be found in the Bazaar repository at, |
578 | -# lib/TableChecksum.pm |
579 | -# t/lib/TableChecksum.t |
580 | -# See https://launchpad.net/percona-toolkit for more information. |
581 | -# ########################################################################### |
582 | -{ |
583 | -package TableChecksum; |
584 | - |
585 | -use strict; |
586 | -use warnings FATAL => 'all'; |
587 | -use English qw(-no_match_vars); |
588 | -use constant MKDEBUG => $ENV{MKDEBUG} || 0; |
589 | - |
590 | -use List::Util qw(max); |
591 | - |
592 | -our %ALGOS = ( |
593 | - CHECKSUM => { pref => 0, hash => 0 }, |
594 | - BIT_XOR => { pref => 2, hash => 1 }, |
595 | - ACCUM => { pref => 3, hash => 1 }, |
596 | -); |
597 | - |
598 | -sub new { |
599 | - my ( $class, %args ) = @_; |
600 | - foreach my $arg ( qw(Quoter VersionParser) ) { |
601 | - die "I need a $arg argument" unless defined $args{$arg}; |
602 | - } |
603 | - my $self = { %args }; |
604 | - return bless $self, $class; |
605 | -} |
606 | - |
607 | -sub crc32 { |
608 | - my ( $self, $string ) = @_; |
609 | - my $poly = 0xEDB88320; |
610 | - my $crc = 0xFFFFFFFF; |
611 | - foreach my $char ( split(//, $string) ) { |
612 | - my $comp = ($crc ^ ord($char)) & 0xFF; |
613 | - for ( 1 .. 8 ) { |
614 | - $comp = $comp & 1 ? $poly ^ ($comp >> 1) : $comp >> 1; |
615 | - } |
616 | - $crc = (($crc >> 8) & 0x00FFFFFF) ^ $comp; |
617 | - } |
618 | - return $crc ^ 0xFFFFFFFF; |
619 | -} |
620 | - |
621 | -sub get_crc_wid { |
622 | - my ( $self, $dbh, $func ) = @_; |
623 | - my $crc_wid = 16; |
624 | - if ( uc $func ne 'FNV_64' && uc $func ne 'FNV1A_64' ) { |
625 | - eval { |
626 | - my ($val) = $dbh->selectrow_array("SELECT $func('a')"); |
627 | - $crc_wid = max(16, length($val)); |
628 | - }; |
629 | - } |
630 | - return $crc_wid; |
631 | -} |
632 | - |
633 | -sub get_crc_type { |
634 | - my ( $self, $dbh, $func ) = @_; |
635 | - my $type = ''; |
636 | - my $length = 0; |
637 | - my $sql = "SELECT $func('a')"; |
638 | - my $sth = $dbh->prepare($sql); |
639 | - eval { |
640 | - $sth->execute(); |
641 | - $type = $sth->{mysql_type_name}->[0]; |
642 | - $length = $sth->{mysql_length}->[0]; |
643 | - MKDEBUG && _d($sql, $type, $length); |
644 | - if ( $type eq 'bigint' && $length < 20 ) { |
645 | - $type = 'int'; |
646 | - } |
647 | + $dsn = 'DBI:mysql:' . ( $info->{D} || '' ) . ';' |
648 | + . join(';', map { "$opts{$_}->{dsn}=$info->{$_}" } |
649 | + grep { defined $info->{$_} } |
650 | + qw(F h P S A)) |
651 | + . ';mysql_read_default_group=client'; |
652 | + } |
653 | + MKDEBUG && _d($dsn); |
654 | + return ($dsn, $info->{u}, $info->{p}); |
655 | +} |
656 | + |
657 | +sub fill_in_dsn { |
658 | + my ( $self, $dbh, $dsn ) = @_; |
659 | + my $vars = $dbh->selectall_hashref('SHOW VARIABLES', 'Variable_name'); |
660 | + my ($user, $db) = $dbh->selectrow_array('SELECT USER(), DATABASE()'); |
661 | + $user =~ s/@.*//; |
662 | + $dsn->{h} ||= $vars->{hostname}->{Value}; |
663 | + $dsn->{S} ||= $vars->{'socket'}->{Value}; |
664 | + $dsn->{P} ||= $vars->{port}->{Value}; |
665 | + $dsn->{u} ||= $user; |
666 | + $dsn->{D} ||= $db; |
667 | +} |
668 | + |
669 | +sub get_dbh { |
670 | + my ( $self, $cxn_string, $user, $pass, $opts ) = @_; |
671 | + $opts ||= {}; |
672 | + my $defaults = { |
673 | + AutoCommit => 0, |
674 | + RaiseError => 1, |
675 | + PrintError => 0, |
676 | + ShowErrorStatement => 1, |
677 | + mysql_enable_utf8 => ($cxn_string =~ m/charset=utf8/i ? 1 : 0), |
678 | }; |
679 | - $sth->finish; |
680 | - MKDEBUG && _d('crc_type:', $type, 'length:', $length); |
681 | - return ($type, $length); |
682 | -} |
683 | - |
684 | -sub best_algorithm { |
685 | - my ( $self, %args ) = @_; |
686 | - my ( $alg, $dbh ) = @args{ qw(algorithm dbh) }; |
687 | - my $vp = $self->{VersionParser}; |
688 | - my @choices = sort { $ALGOS{$a}->{pref} <=> $ALGOS{$b}->{pref} } keys %ALGOS; |
689 | - die "Invalid checksum algorithm $alg" |
690 | - if $alg && !$ALGOS{$alg}; |
691 | - |
692 | - if ( |
693 | - $args{where} || $args{chunk} # CHECKSUM does whole table |
694 | - || $args{replicate} # CHECKSUM can't do INSERT.. SELECT |
695 | - || !$vp->version_ge($dbh, '4.1.1')) # CHECKSUM doesn't exist |
696 | - { |
697 | - MKDEBUG && _d('Cannot use CHECKSUM algorithm'); |
698 | - @choices = grep { $_ ne 'CHECKSUM' } @choices; |
699 | - } |
700 | - |
701 | - if ( !$vp->version_ge($dbh, '4.1.1') ) { |
702 | - MKDEBUG && _d('Cannot use BIT_XOR algorithm because MySQL < 4.1.1'); |
703 | - @choices = grep { $_ ne 'BIT_XOR' } @choices; |
704 | - } |
705 | - |
706 | - if ( $alg && grep { $_ eq $alg } @choices ) { |
707 | - MKDEBUG && _d('User requested', $alg, 'algorithm'); |
708 | - return $alg; |
709 | - } |
710 | - |
711 | - if ( $args{count} && grep { $_ ne 'CHECKSUM' } @choices ) { |
712 | - MKDEBUG && _d('Not using CHECKSUM algorithm because COUNT desired'); |
713 | - @choices = grep { $_ ne 'CHECKSUM' } @choices; |
714 | - } |
715 | - |
716 | - MKDEBUG && _d('Algorithms, in order:', @choices); |
717 | - return $choices[0]; |
718 | -} |
719 | - |
720 | -sub is_hash_algorithm { |
721 | - my ( $self, $algorithm ) = @_; |
722 | - return $ALGOS{$algorithm} && $ALGOS{$algorithm}->{hash}; |
723 | -} |
724 | - |
725 | -sub choose_hash_func { |
726 | - my ( $self, %args ) = @_; |
727 | - my @funcs = qw(CRC32 FNV1A_64 FNV_64 MD5 SHA1); |
728 | - if ( $args{function} ) { |
729 | - unshift @funcs, $args{function}; |
730 | - } |
731 | - my ($result, $error); |
732 | - do { |
733 | - my $func; |
734 | + @{$defaults}{ keys %$opts } = values %$opts; |
735 | + |
736 | + if ( $opts->{mysql_use_result} ) { |
737 | + $defaults->{mysql_use_result} = 1; |
738 | + } |
739 | + |
740 | + if ( !$have_dbi ) { |
741 | + die "Cannot connect to MySQL because the Perl DBI module is not " |
742 | + . "installed or not found. Run 'perl -MDBI' to see the directories " |
743 | + . "that Perl searches for DBI. If DBI is not installed, try:\n" |
744 | + . " Debian/Ubuntu apt-get install libdbi-perl\n" |
745 | + . " RHEL/CentOS yum install perl-DBI\n" |
746 | + . " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; |
747 | + |
748 | + } |
749 | + |
750 | + my $dbh; |
751 | + my $tries = 2; |
752 | + while ( !$dbh && $tries-- ) { |
753 | + MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, |
754 | + join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); |
755 | + |
756 | eval { |
757 | - $func = shift(@funcs); |
758 | - my $sql = "SELECT $func('test-string')"; |
759 | - MKDEBUG && _d($sql); |
760 | - $args{dbh}->do($sql); |
761 | - $result = $func; |
762 | + $dbh = DBI->connect($cxn_string, $user, $pass, $defaults); |
763 | + |
764 | + if ( $cxn_string =~ m/mysql/i ) { |
765 | + my $sql; |
766 | + |
767 | + $sql = 'SELECT @@SQL_MODE'; |
768 | + MKDEBUG && _d($dbh, $sql); |
769 | + my ($sql_mode) = $dbh->selectrow_array($sql); |
770 | + |
771 | + $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' |
772 | + . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' |
773 | + . ($sql_mode ? ",$sql_mode" : '') |
774 | + . '\'*/'; |
775 | + MKDEBUG && _d($dbh, $sql); |
776 | + $dbh->do($sql); |
777 | + |
778 | + if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { |
779 | + $sql = "/*!40101 SET NAMES $charset*/"; |
780 | + MKDEBUG && _d($dbh, ':', $sql); |
781 | + $dbh->do($sql); |
782 | + MKDEBUG && _d('Enabling charset for STDOUT'); |
783 | + if ( $charset eq 'utf8' ) { |
784 | + binmode(STDOUT, ':utf8') |
785 | + or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; |
786 | + } |
787 | + else { |
788 | + binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR"; |
789 | + } |
790 | + } |
791 | + |
792 | + if ( $self->prop('set-vars') ) { |
793 | + $sql = "SET " . $self->prop('set-vars'); |
794 | + MKDEBUG && _d($dbh, ':', $sql); |
795 | + $dbh->do($sql); |
796 | + } |
797 | + } |
798 | }; |
799 | - if ( $EVAL_ERROR && $EVAL_ERROR =~ m/failed: (.*?) at \S+ line/ ) { |
800 | - $error .= qq{$func cannot be used because "$1"\n}; |
801 | - MKDEBUG && _d($func, 'cannot be used because', $1); |
802 | - } |
803 | - } while ( @funcs && !$result ); |
804 | - |
805 | - die $error unless $result; |
806 | - MKDEBUG && _d('Chosen hash func:', $result); |
807 | - return $result; |
808 | -} |
809 | - |
810 | -sub optimize_xor { |
811 | - my ( $self, %args ) = @_; |
812 | - my ($dbh, $func) = @args{qw(dbh function)}; |
813 | - |
814 | - die "$func never needs the BIT_XOR optimization" |
815 | - if $func =~ m/^(?:FNV1A_64|FNV_64|CRC32)$/i; |
816 | - |
817 | - my $opt_slice = 0; |
818 | - my $unsliced = uc $dbh->selectall_arrayref("SELECT $func('a')")->[0]->[0]; |
819 | - my $sliced = ''; |
820 | - my $start = 1; |
821 | - my $crc_wid = length($unsliced) < 16 ? 16 : length($unsliced); |
822 | - |
823 | - do { # Try different positions till sliced result equals non-sliced. |
824 | - MKDEBUG && _d('Trying slice', $opt_slice); |
825 | - $dbh->do('SET @crc := "", @cnt := 0'); |
826 | - my $slices = $self->make_xor_slices( |
827 | - query => "\@crc := $func('a')", |
828 | - crc_wid => $crc_wid, |
829 | - opt_slice => $opt_slice, |
830 | - ); |
831 | - |
832 | - my $sql = "SELECT CONCAT($slices) AS TEST FROM (SELECT NULL) AS x"; |
833 | - $sliced = ($dbh->selectrow_array($sql))[0]; |
834 | - if ( $sliced ne $unsliced ) { |
835 | - MKDEBUG && _d('Slice', $opt_slice, 'does not work'); |
836 | - $start += 16; |
837 | - ++$opt_slice; |
838 | - } |
839 | - } while ( $start < $crc_wid && $sliced ne $unsliced ); |
840 | - |
841 | - if ( $sliced eq $unsliced ) { |
842 | - MKDEBUG && _d('Slice', $opt_slice, 'works'); |
843 | - return $opt_slice; |
844 | - } |
845 | - else { |
846 | - MKDEBUG && _d('No slice works'); |
847 | - return undef; |
848 | - } |
849 | -} |
850 | - |
851 | -sub make_xor_slices { |
852 | - my ( $self, %args ) = @_; |
853 | - foreach my $arg ( qw(query crc_wid) ) { |
854 | - die "I need a $arg argument" unless defined $args{$arg}; |
855 | - } |
856 | - my ( $query, $crc_wid, $opt_slice ) = @args{qw(query crc_wid opt_slice)}; |
857 | - |
858 | - my @slices; |
859 | - for ( my $start = 1; $start <= $crc_wid; $start += 16 ) { |
860 | - my $len = $crc_wid - $start + 1; |
861 | - if ( $len > 16 ) { |
862 | - $len = 16; |
863 | - } |
864 | - push @slices, |
865 | - "LPAD(CONV(BIT_XOR(" |
866 | - . "CAST(CONV(SUBSTRING(\@crc, $start, $len), 16, 10) AS UNSIGNED))" |
867 | - . ", 10, 16), $len, '0')"; |
868 | - } |
869 | - |
870 | - if ( defined $opt_slice && $opt_slice < @slices ) { |
871 | - $slices[$opt_slice] =~ s/\@crc/\@crc := $query/; |
872 | - } |
873 | - else { |
874 | - map { s/\@crc/$query/ } @slices; |
875 | - } |
876 | - |
877 | - return join(', ', @slices); |
878 | -} |
879 | - |
880 | -sub make_row_checksum { |
881 | - my ( $self, %args ) = @_; |
882 | - my ( $tbl_struct, $func ) = @args{ qw(tbl_struct function) }; |
883 | - my $q = $self->{Quoter}; |
884 | - |
885 | - my $sep = $args{sep} || '#'; |
886 | - $sep =~ s/'//g; |
887 | - $sep ||= '#'; |
888 | - |
889 | - my $ignorecols = $args{ignorecols} || {}; |
890 | - |
891 | - my %cols = map { lc($_) => 1 } |
892 | - grep { !exists $ignorecols->{$_} } |
893 | - ($args{cols} ? @{$args{cols}} : @{$tbl_struct->{cols}}); |
894 | - my %seen; |
895 | - my @cols = |
896 | - map { |
897 | - my $type = $tbl_struct->{type_for}->{$_}; |
898 | - my $result = $q->quote($_); |
899 | - if ( $type eq 'timestamp' ) { |
900 | - $result .= ' + 0'; |
901 | - } |
902 | - elsif ( $args{float_precision} && $type =~ m/float|double/ ) { |
903 | - $result = "ROUND($result, $args{float_precision})"; |
904 | - } |
905 | - elsif ( $args{trim} && $type =~ m/varchar/ ) { |
906 | - $result = "TRIM($result)"; |
907 | - } |
908 | - $result; |
909 | - } |
910 | - grep { |
911 | - $cols{$_} && !$seen{$_}++ |
912 | - } |
913 | - @{$tbl_struct->{cols}}; |
914 | - |
915 | - my $query; |
916 | - if ( !$args{no_cols} ) { |
917 | - $query = join(', ', |
918 | - map { |
919 | - my $col = $_; |
920 | - if ( $col =~ m/\+ 0/ ) { |
921 | - my ($real_col) = /^(\S+)/; |
922 | - $col .= " AS $real_col"; |
923 | - } |
924 | - elsif ( $col =~ m/TRIM/ ) { |
925 | - my ($real_col) = m/TRIM\(([^\)]+)\)/; |
926 | - $col .= " AS $real_col"; |
927 | - } |
928 | - $col; |
929 | - } @cols) |
930 | - . ', '; |
931 | - } |
932 | - |
933 | - if ( uc $func ne 'FNV_64' && uc $func ne 'FNV1A_64' ) { |
934 | - my @nulls = grep { $cols{$_} } @{$tbl_struct->{null_cols}}; |
935 | - if ( @nulls ) { |
936 | - my $bitmap = "CONCAT(" |
937 | - . join(', ', map { 'ISNULL(' . $q->quote($_) . ')' } @nulls) |
938 | - . ")"; |
939 | - push @cols, $bitmap; |
940 | - } |
941 | - |
942 | - $query .= @cols > 1 |
943 | - ? "$func(CONCAT_WS('$sep', " . join(', ', @cols) . '))' |
944 | - : "$func($cols[0])"; |
945 | - } |
946 | - else { |
947 | - my $fnv_func = uc $func; |
948 | - $query .= "$fnv_func(" . join(', ', @cols) . ')'; |
949 | - } |
950 | - |
951 | - return $query; |
952 | -} |
953 | - |
954 | -sub make_checksum_query { |
955 | - my ( $self, %args ) = @_; |
956 | - my @required_args = qw(db tbl tbl_struct algorithm crc_wid crc_type); |
957 | - foreach my $arg( @required_args ) { |
958 | - die "I need a $arg argument" unless $args{$arg}; |
959 | - } |
960 | - my ( $db, $tbl, $tbl_struct, $algorithm, |
961 | - $crc_wid, $crc_type) = @args{@required_args}; |
962 | - my $func = $args{function}; |
963 | - my $q = $self->{Quoter}; |
964 | - my $result; |
965 | - |
966 | - die "Invalid or missing checksum algorithm" |
967 | - unless $algorithm && $ALGOS{$algorithm}; |
968 | - |
969 | - if ( $algorithm eq 'CHECKSUM' ) { |
970 | - return "CHECKSUM TABLE " . $q->quote($db, $tbl); |
971 | - } |
972 | - |
973 | - my $expr = $self->make_row_checksum(%args, no_cols=>1); |
974 | - |
975 | - if ( $algorithm eq 'BIT_XOR' ) { |
976 | - if ( $crc_type =~ m/int$/ ) { |
977 | - $result = "COALESCE(LOWER(CONV(BIT_XOR(CAST($expr AS UNSIGNED)), 10, 16)), 0) AS crc "; |
978 | - } |
979 | - else { |
980 | - my $slices = $self->make_xor_slices( query => $expr, %args ); |
981 | - $result = "COALESCE(LOWER(CONCAT($slices)), 0) AS crc "; |
982 | - } |
983 | - } |
984 | - else { |
985 | - if ( $crc_type =~ m/int$/ ) { |
986 | - $result = "COALESCE(RIGHT(MAX(" |
987 | - . "\@crc := CONCAT(LPAD(\@cnt := \@cnt + 1, 16, '0'), " |
988 | - . "CONV(CAST($func(CONCAT(\@crc, $expr)) AS UNSIGNED), 10, 16))" |
989 | - . "), $crc_wid), 0) AS crc "; |
990 | - } |
991 | - else { |
992 | - $result = "COALESCE(RIGHT(MAX(" |
993 | - . "\@crc := CONCAT(LPAD(\@cnt := \@cnt + 1, 16, '0'), " |
994 | - . "$func(CONCAT(\@crc, $expr)))" |
995 | - . "), $crc_wid), 0) AS crc "; |
996 | - } |
997 | - } |
998 | - if ( $args{replicate} ) { |
999 | - $result = "REPLACE /*PROGRESS_COMMENT*/ INTO $args{replicate} " |
1000 | - . "(db, tbl, chunk, boundaries, this_cnt, this_crc) " |
1001 | - . "SELECT ?, ?, /*CHUNK_NUM*/ ?, COUNT(*) AS cnt, $result"; |
1002 | - } |
1003 | - else { |
1004 | - $result = "SELECT " |
1005 | - . ($args{buffer} ? 'SQL_BUFFER_RESULT ' : '') |
1006 | - . "/*PROGRESS_COMMENT*//*CHUNK_NUM*/ COUNT(*) AS cnt, $result"; |
1007 | - } |
1008 | - return $result . "FROM /*DB_TBL*//*INDEX_HINT*//*WHERE*/"; |
1009 | -} |
1010 | - |
1011 | -sub find_replication_differences { |
1012 | - my ( $self, $dbh, $table ) = @_; |
1013 | - |
1014 | - (my $sql = <<" EOF") =~ s/\s+/ /gm; |
1015 | - SELECT db, tbl, chunk, boundaries, |
1016 | - COALESCE(this_cnt-master_cnt, 0) AS cnt_diff, |
1017 | - COALESCE( |
1018 | - this_crc <> master_crc OR ISNULL(master_crc) <> ISNULL(this_crc), |
1019 | - 0 |
1020 | - ) AS crc_diff, |
1021 | - this_cnt, master_cnt, this_crc, master_crc |
1022 | - FROM $table |
1023 | - WHERE master_cnt <> this_cnt OR master_crc <> this_crc |
1024 | - OR ISNULL(master_crc) <> ISNULL(this_crc) |
1025 | - EOF |
1026 | - |
1027 | - MKDEBUG && _d($sql); |
1028 | - my $diffs = $dbh->selectall_arrayref($sql, { Slice => {} }); |
1029 | - return @$diffs; |
1030 | + if ( !$dbh && $EVAL_ERROR ) { |
1031 | + MKDEBUG && _d($EVAL_ERROR); |
1032 | + if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { |
1033 | + MKDEBUG && _d('Going to try again without utf8 support'); |
1034 | + delete $defaults->{mysql_enable_utf8}; |
1035 | + } |
1036 | + elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { |
1037 | + die "Cannot connect to MySQL because the Perl DBD::mysql module is " |
1038 | + . "not installed or not found. Run 'perl -MDBD::mysql' to see " |
1039 | + . "the directories that Perl searches for DBD::mysql. If " |
1040 | + . "DBD::mysql is not installed, try:\n" |
1041 | + . " Debian/Ubuntu apt-get install libdbd-mysql-perl\n" |
1042 | + . " RHEL/CentOS yum install perl-DBD-MySQL\n" |
1043 | + . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n"; |
1044 | + } |
1045 | + if ( !$tries ) { |
1046 | + die $EVAL_ERROR; |
1047 | + } |
1048 | + } |
1049 | + } |
1050 | + |
1051 | + MKDEBUG && _d('DBH info: ', |
1052 | + $dbh, |
1053 | + Dumper($dbh->selectrow_hashref( |
1054 | + 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), |
1055 | + 'Connection info:', $dbh->{mysql_hostinfo}, |
1056 | + 'Character set info:', Dumper($dbh->selectall_arrayref( |
1057 | + 'SHOW VARIABLES LIKE "character_set%"', { Slice => {}})), |
1058 | + '$DBD::mysql::VERSION:', $DBD::mysql::VERSION, |
1059 | + '$DBI::VERSION:', $DBI::VERSION, |
1060 | + ); |
1061 | + |
1062 | + return $dbh; |
1063 | +} |
1064 | + |
1065 | +sub get_hostname { |
1066 | + my ( $self, $dbh ) = @_; |
1067 | + if ( my ($host) = ($dbh->{mysql_hostinfo} || '') =~ m/^(\w+) via/ ) { |
1068 | + return $host; |
1069 | + } |
1070 | + my ( $hostname, $one ) = $dbh->selectrow_array( |
1071 | + 'SELECT /*!50038 @@hostname, */ 1'); |
1072 | + return $hostname; |
1073 | +} |
1074 | + |
1075 | +sub disconnect { |
1076 | + my ( $self, $dbh ) = @_; |
1077 | + MKDEBUG && $self->print_active_handles($dbh); |
1078 | + $dbh->disconnect; |
1079 | +} |
1080 | + |
1081 | +sub print_active_handles { |
1082 | + my ( $self, $thing, $level ) = @_; |
1083 | + $level ||= 0; |
1084 | + printf("# Active %sh: %s %s %s\n", ($thing->{Type} || 'undef'), "\t" x $level, |
1085 | + $thing, (($thing->{Type} || '') eq 'st' ? $thing->{Statement} || '' : '')) |
1086 | + or die "Cannot print: $OS_ERROR"; |
1087 | + foreach my $handle ( grep {defined} @{ $thing->{ChildHandles} } ) { |
1088 | + $self->print_active_handles( $handle, $level + 1 ); |
1089 | + } |
1090 | +} |
1091 | + |
1092 | +sub copy { |
1093 | + my ( $self, $dsn_1, $dsn_2, %args ) = @_; |
1094 | + die 'I need a dsn_1 argument' unless $dsn_1; |
1095 | + die 'I need a dsn_2 argument' unless $dsn_2; |
1096 | + my %new_dsn = map { |
1097 | + my $key = $_; |
1098 | + my $val; |
1099 | + if ( $args{overwrite} ) { |
1100 | + $val = defined $dsn_1->{$key} ? $dsn_1->{$key} : $dsn_2->{$key}; |
1101 | + } |
1102 | + else { |
1103 | + $val = defined $dsn_2->{$key} ? $dsn_2->{$key} : $dsn_1->{$key}; |
1104 | + } |
1105 | + $key => $val; |
1106 | + } keys %{$self->{opts}}; |
1107 | + return \%new_dsn; |
1108 | } |
1109 | |
1110 | sub _d { |
1111 | @@ -789,7 +363,7 @@ |
1112 | 1; |
1113 | } |
1114 | # ########################################################################### |
1115 | -# End TableChecksum package |
1116 | +# End DSNParser package |
1117 | # ########################################################################### |
1118 | |
1119 | # ########################################################################### |
1120 | @@ -1743,7 +1317,7 @@ |
1121 | $opt->{value} = ($pre || '') . $num; |
1122 | } |
1123 | else { |
1124 | - $self->save_error("Invalid size for --$opt->{long}"); |
1125 | + $self->save_error("Invalid size for --$opt->{long}: $val"); |
1126 | } |
1127 | return; |
1128 | } |
1129 | @@ -1818,345 +1392,129 @@ |
1130 | # ########################################################################### |
1131 | |
1132 | # ########################################################################### |
1133 | -# DSNParser package |
1134 | +# Cxn package |
1135 | # This package is a copy without comments from the original. The original |
1136 | # with comments and its test file can be found in the Bazaar repository at, |
1137 | -# lib/DSNParser.pm |
1138 | -# t/lib/DSNParser.t |
1139 | +# lib/Cxn.pm |
1140 | +# t/lib/Cxn.t |
1141 | # See https://launchpad.net/percona-toolkit for more information. |
1142 | # ########################################################################### |
1143 | { |
1144 | -package DSNParser; |
1145 | +package Cxn; |
1146 | |
1147 | use strict; |
1148 | use warnings FATAL => 'all'; |
1149 | use English qw(-no_match_vars); |
1150 | use constant MKDEBUG => $ENV{MKDEBUG} || 0; |
1151 | |
1152 | -use Data::Dumper; |
1153 | -$Data::Dumper::Indent = 0; |
1154 | -$Data::Dumper::Quotekeys = 0; |
1155 | - |
1156 | -eval { |
1157 | - require DBI; |
1158 | -}; |
1159 | -my $have_dbi = $EVAL_ERROR ? 0 : 1; |
1160 | +use constant PERCONA_TOOLKIT_TEST_USE_DSN_NAMES => $ENV{PERCONA_TOOLKIT_TEST_USE_DSN_NAMES} || 0; |
1161 | |
1162 | sub new { |
1163 | my ( $class, %args ) = @_; |
1164 | - foreach my $arg ( qw(opts) ) { |
1165 | + my @required_args = qw(DSNParser OptionParser); |
1166 | + foreach my $arg ( @required_args ) { |
1167 | die "I need a $arg argument" unless $args{$arg}; |
1168 | - } |
1169 | + }; |
1170 | + my ($dp, $o) = @args{@required_args}; |
1171 | + |
1172 | + my $dsn_defaults = $dp->parse_options($o); |
1173 | + my $prev_dsn = $args{prev_dsn}; |
1174 | + my $dsn = $args{dsn}; |
1175 | + if ( !$dsn ) { |
1176 | + $args{dsn_string} ||= 'h=' . ($dsn_defaults->{h} || 'localhost'); |
1177 | + |
1178 | + $dsn = $dp->parse( |
1179 | + $args{dsn_string}, $prev_dsn, $dsn_defaults); |
1180 | + } |
1181 | + elsif ( $prev_dsn ) { |
1182 | + $dsn = $dp->copy($prev_dsn, $dsn); |
1183 | + } |
1184 | + |
1185 | my $self = { |
1186 | - opts => {} # h, P, u, etc. Should come from DSN OPTIONS section in POD. |
1187 | + dsn => $dsn, |
1188 | + dbh => $args{dbh}, |
1189 | + dsn_name => $dp->as_string($dsn, [qw(h P S)]), |
1190 | + hostname => '', |
1191 | + set => $args{set}, |
1192 | + dbh_set => 0, |
1193 | + OptionParser => $o, |
1194 | + DSNParser => $dp, |
1195 | }; |
1196 | - foreach my $opt ( @{$args{opts}} ) { |
1197 | - if ( !$opt->{key} || !$opt->{desc} ) { |
1198 | - die "Invalid DSN option: ", Dumper($opt); |
1199 | - } |
1200 | - MKDEBUG && _d('DSN option:', |
1201 | - join(', ', |
1202 | - map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } |
1203 | - keys %$opt |
1204 | - ) |
1205 | - ); |
1206 | - $self->{opts}->{$opt->{key}} = { |
1207 | - dsn => $opt->{dsn}, |
1208 | - desc => $opt->{desc}, |
1209 | - copy => $opt->{copy} || 0, |
1210 | - }; |
1211 | - } |
1212 | + |
1213 | return bless $self, $class; |
1214 | } |
1215 | |
1216 | -sub prop { |
1217 | - my ( $self, $prop, $value ) = @_; |
1218 | - if ( @_ > 2 ) { |
1219 | - MKDEBUG && _d('Setting', $prop, 'property'); |
1220 | - $self->{$prop} = $value; |
1221 | - } |
1222 | - return $self->{$prop}; |
1223 | -} |
1224 | - |
1225 | -sub parse { |
1226 | - my ( $self, $dsn, $prev, $defaults ) = @_; |
1227 | - if ( !$dsn ) { |
1228 | - MKDEBUG && _d('No DSN to parse'); |
1229 | - return; |
1230 | - } |
1231 | - MKDEBUG && _d('Parsing', $dsn); |
1232 | - $prev ||= {}; |
1233 | - $defaults ||= {}; |
1234 | - my %given_props; |
1235 | - my %final_props; |
1236 | - my $opts = $self->{opts}; |
1237 | - |
1238 | - foreach my $dsn_part ( split(/,/, $dsn) ) { |
1239 | - if ( my ($prop_key, $prop_val) = $dsn_part =~ m/^(.)=(.*)$/ ) { |
1240 | - $given_props{$prop_key} = $prop_val; |
1241 | - } |
1242 | - else { |
1243 | - MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); |
1244 | - $given_props{h} = $dsn_part; |
1245 | - } |
1246 | - } |
1247 | - |
1248 | - foreach my $key ( keys %$opts ) { |
1249 | - MKDEBUG && _d('Finding value for', $key); |
1250 | - $final_props{$key} = $given_props{$key}; |
1251 | - if ( !defined $final_props{$key} |
1252 | - && defined $prev->{$key} && $opts->{$key}->{copy} ) |
1253 | - { |
1254 | - $final_props{$key} = $prev->{$key}; |
1255 | - MKDEBUG && _d('Copying value for', $key, 'from previous DSN'); |
1256 | - } |
1257 | - if ( !defined $final_props{$key} ) { |
1258 | - $final_props{$key} = $defaults->{$key}; |
1259 | - MKDEBUG && _d('Copying value for', $key, 'from defaults'); |
1260 | - } |
1261 | - } |
1262 | - |
1263 | - foreach my $key ( keys %given_props ) { |
1264 | - die "Unknown DSN option '$key' in '$dsn'. For more details, " |
1265 | - . "please use the --help option, or try 'perldoc $PROGRAM_NAME' " |
1266 | - . "for complete documentation." |
1267 | - unless exists $opts->{$key}; |
1268 | - } |
1269 | - if ( (my $required = $self->prop('required')) ) { |
1270 | - foreach my $key ( keys %$required ) { |
1271 | - die "Missing required DSN option '$key' in '$dsn'. For more details, " |
1272 | - . "please use the --help option, or try 'perldoc $PROGRAM_NAME' " |
1273 | - . "for complete documentation." |
1274 | - unless $final_props{$key}; |
1275 | - } |
1276 | - } |
1277 | - |
1278 | - return \%final_props; |
1279 | -} |
1280 | - |
1281 | -sub parse_options { |
1282 | - my ( $self, $o ) = @_; |
1283 | - die 'I need an OptionParser object' unless ref $o eq 'OptionParser'; |
1284 | - my $dsn_string |
1285 | - = join(',', |
1286 | - map { "$_=".$o->get($_); } |
1287 | - grep { $o->has($_) && $o->get($_) } |
1288 | - keys %{$self->{opts}} |
1289 | - ); |
1290 | - MKDEBUG && _d('DSN string made from options:', $dsn_string); |
1291 | - return $self->parse($dsn_string); |
1292 | -} |
1293 | - |
1294 | -sub as_string { |
1295 | - my ( $self, $dsn, $props ) = @_; |
1296 | - return $dsn unless ref $dsn; |
1297 | - my %allowed = $props ? map { $_=>1 } @$props : (); |
1298 | - return join(',', |
1299 | - map { "$_=" . ($_ eq 'p' ? '...' : $dsn->{$_}) } |
1300 | - grep { defined $dsn->{$_} && $self->{opts}->{$_} } |
1301 | - grep { !$props || $allowed{$_} } |
1302 | - sort keys %$dsn ); |
1303 | -} |
1304 | - |
1305 | -sub usage { |
1306 | +sub connect { |
1307 | my ( $self ) = @_; |
1308 | - my $usage |
1309 | - = "DSN syntax is key=value[,key=value...] Allowable DSN keys:\n\n" |
1310 | - . " KEY COPY MEANING\n" |
1311 | - . " === ==== =============================================\n"; |
1312 | - my %opts = %{$self->{opts}}; |
1313 | - foreach my $key ( sort keys %opts ) { |
1314 | - $usage .= " $key " |
1315 | - . ($opts{$key}->{copy} ? 'yes ' : 'no ') |
1316 | - . ($opts{$key}->{desc} || '[No description]') |
1317 | - . "\n"; |
1318 | - } |
1319 | - $usage .= "\n If the DSN is a bareword, the word is treated as the 'h' key.\n"; |
1320 | - return $usage; |
1321 | -} |
1322 | - |
1323 | -sub get_cxn_params { |
1324 | - my ( $self, $info ) = @_; |
1325 | - my $dsn; |
1326 | - my %opts = %{$self->{opts}}; |
1327 | - my $driver = $self->prop('dbidriver') || ''; |
1328 | - if ( $driver eq 'Pg' ) { |
1329 | - $dsn = 'DBI:Pg:dbname=' . ( $info->{D} || '' ) . ';' |
1330 | - . join(';', map { "$opts{$_}->{dsn}=$info->{$_}" } |
1331 | - grep { defined $info->{$_} } |
1332 | - qw(h P)); |
1333 | - } |
1334 | - else { |
1335 | - $dsn = 'DBI:mysql:' . ( $info->{D} || '' ) . ';' |
1336 | - . join(';', map { "$opts{$_}->{dsn}=$info->{$_}" } |
1337 | - grep { defined $info->{$_} } |
1338 | - qw(F h P S A)) |
1339 | - . ';mysql_read_default_group=client'; |
1340 | - } |
1341 | - MKDEBUG && _d($dsn); |
1342 | - return ($dsn, $info->{u}, $info->{p}); |
1343 | -} |
1344 | - |
1345 | -sub fill_in_dsn { |
1346 | - my ( $self, $dbh, $dsn ) = @_; |
1347 | - my $vars = $dbh->selectall_hashref('SHOW VARIABLES', 'Variable_name'); |
1348 | - my ($user, $db) = $dbh->selectrow_array('SELECT USER(), DATABASE()'); |
1349 | - $user =~ s/@.*//; |
1350 | - $dsn->{h} ||= $vars->{hostname}->{Value}; |
1351 | - $dsn->{S} ||= $vars->{'socket'}->{Value}; |
1352 | - $dsn->{P} ||= $vars->{port}->{Value}; |
1353 | - $dsn->{u} ||= $user; |
1354 | - $dsn->{D} ||= $db; |
1355 | -} |
1356 | - |
1357 | -sub get_dbh { |
1358 | - my ( $self, $cxn_string, $user, $pass, $opts ) = @_; |
1359 | - $opts ||= {}; |
1360 | - my $defaults = { |
1361 | - AutoCommit => 0, |
1362 | - RaiseError => 1, |
1363 | - PrintError => 0, |
1364 | - ShowErrorStatement => 1, |
1365 | - mysql_enable_utf8 => ($cxn_string =~ m/charset=utf8/i ? 1 : 0), |
1366 | - }; |
1367 | - @{$defaults}{ keys %$opts } = values %$opts; |
1368 | - |
1369 | - if ( $opts->{mysql_use_result} ) { |
1370 | - $defaults->{mysql_use_result} = 1; |
1371 | - } |
1372 | - |
1373 | - if ( !$have_dbi ) { |
1374 | - die "Cannot connect to MySQL because the Perl DBI module is not " |
1375 | - . "installed or not found. Run 'perl -MDBI' to see the directories " |
1376 | - . "that Perl searches for DBI. If DBI is not installed, try:\n" |
1377 | - . " Debian/Ubuntu apt-get install libdbi-perl\n" |
1378 | - . " RHEL/CentOS yum install perl-DBI\n" |
1379 | - . " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; |
1380 | - |
1381 | - } |
1382 | - |
1383 | - my $dbh; |
1384 | - my $tries = 2; |
1385 | - while ( !$dbh && $tries-- ) { |
1386 | - MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, |
1387 | - join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); |
1388 | - |
1389 | - eval { |
1390 | - $dbh = DBI->connect($cxn_string, $user, $pass, $defaults); |
1391 | - |
1392 | - if ( $cxn_string =~ m/mysql/i ) { |
1393 | - my $sql; |
1394 | - |
1395 | - $sql = 'SELECT @@SQL_MODE'; |
1396 | - MKDEBUG && _d($dbh, $sql); |
1397 | - my ($sql_mode) = $dbh->selectrow_array($sql); |
1398 | - |
1399 | - $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' |
1400 | - . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' |
1401 | - . ($sql_mode ? ",$sql_mode" : '') |
1402 | - . '\'*/'; |
1403 | - MKDEBUG && _d($dbh, $sql); |
1404 | - $dbh->do($sql); |
1405 | - |
1406 | - if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { |
1407 | - $sql = "/*!40101 SET NAMES $charset*/"; |
1408 | - MKDEBUG && _d($dbh, ':', $sql); |
1409 | - $dbh->do($sql); |
1410 | - MKDEBUG && _d('Enabling charset for STDOUT'); |
1411 | - if ( $charset eq 'utf8' ) { |
1412 | - binmode(STDOUT, ':utf8') |
1413 | - or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; |
1414 | - } |
1415 | - else { |
1416 | - binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR"; |
1417 | - } |
1418 | - } |
1419 | - |
1420 | - if ( $self->prop('set-vars') ) { |
1421 | - $sql = "SET " . $self->prop('set-vars'); |
1422 | - MKDEBUG && _d($dbh, ':', $sql); |
1423 | - $dbh->do($sql); |
1424 | - } |
1425 | - } |
1426 | - }; |
1427 | - if ( !$dbh && $EVAL_ERROR ) { |
1428 | - MKDEBUG && _d($EVAL_ERROR); |
1429 | - if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { |
1430 | - MKDEBUG && _d('Going to try again without utf8 support'); |
1431 | - delete $defaults->{mysql_enable_utf8}; |
1432 | - } |
1433 | - elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { |
1434 | - die "Cannot connect to MySQL because the Perl DBD::mysql module is " |
1435 | - . "not installed or not found. Run 'perl -MDBD::mysql' to see " |
1436 | - . "the directories that Perl searches for DBD::mysql. If " |
1437 | - . "DBD::mysql is not installed, try:\n" |
1438 | - . " Debian/Ubuntu apt-get install libdbd-mysql-perl\n" |
1439 | - . " RHEL/CentOS yum install perl-DBD-MySQL\n" |
1440 | - . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n"; |
1441 | - } |
1442 | - if ( !$tries ) { |
1443 | - die $EVAL_ERROR; |
1444 | - } |
1445 | + my $dsn = $self->{dsn}; |
1446 | + my $dp = $self->{DSNParser}; |
1447 | + my $o = $self->{OptionParser}; |
1448 | + |
1449 | + my $dbh = $self->{dbh}; |
1450 | + if ( !$dbh || !$dbh->ping() ) { |
1451 | + if ( $o->get('ask-pass') && !$self->{asked_for_pass} ) { |
1452 | + $dsn->{p} = OptionParser::prompt_noecho("Enter MySQL password: "); |
1453 | + $self->{asked_for_pass} = 1; |
1454 | } |
1455 | - } |
1456 | - |
1457 | - MKDEBUG && _d('DBH info: ', |
1458 | - $dbh, |
1459 | - Dumper($dbh->selectrow_hashref( |
1460 | - 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), |
1461 | - 'Connection info:', $dbh->{mysql_hostinfo}, |
1462 | - 'Character set info:', Dumper($dbh->selectall_arrayref( |
1463 | - 'SHOW VARIABLES LIKE "character_set%"', { Slice => {}})), |
1464 | - '$DBD::mysql::VERSION:', $DBD::mysql::VERSION, |
1465 | - '$DBI::VERSION:', $DBI::VERSION, |
1466 | - ); |
1467 | - |
1468 | + $dbh = $dp->get_dbh($dp->get_cxn_params($dsn), { AutoCommit => 1 }); |
1469 | + } |
1470 | + MKDEBUG && _d($dbh, 'Connected dbh to', $self->{name}); |
1471 | + |
1472 | + return $self->set_dbh($dbh); |
1473 | +} |
1474 | + |
1475 | +sub set_dbh { |
1476 | + my ($self, $dbh) = @_; |
1477 | + |
1478 | + if ( $self->{dbh} && $self->{dbh} == $dbh && $self->{dbh_set} ) { |
1479 | + MKDEBUG && _d($dbh, 'Already set dbh'); |
1480 | + return $dbh; |
1481 | + } |
1482 | + |
1483 | + MKDEBUG && _d($dbh, 'Setting dbh'); |
1484 | + |
1485 | + $dbh->{FetchHashKeyName} = 'NAME_lc'; |
1486 | + |
1487 | + my $sql = 'SELECT @@hostname, @@server_id'; |
1488 | + MKDEBUG && _d($dbh, $sql); |
1489 | + my ($hostname, $server_id) = $dbh->selectrow_array($sql); |
1490 | + MKDEBUG && _d($dbh, 'hostname:', $hostname, $server_id); |
1491 | + if ( $hostname ) { |
1492 | + $self->{hostname} = $hostname; |
1493 | + } |
1494 | + |
1495 | + if ( my $set = $self->{set}) { |
1496 | + $set->($dbh); |
1497 | + } |
1498 | + |
1499 | + $self->{dbh} = $dbh; |
1500 | + $self->{dbh_set} = 1; |
1501 | return $dbh; |
1502 | } |
1503 | |
1504 | -sub get_hostname { |
1505 | - my ( $self, $dbh ) = @_; |
1506 | - if ( my ($host) = ($dbh->{mysql_hostinfo} || '') =~ m/^(\w+) via/ ) { |
1507 | - return $host; |
1508 | - } |
1509 | - my ( $hostname, $one ) = $dbh->selectrow_array( |
1510 | - 'SELECT /*!50038 @@hostname, */ 1'); |
1511 | - return $hostname; |
1512 | -} |
1513 | - |
1514 | -sub disconnect { |
1515 | - my ( $self, $dbh ) = @_; |
1516 | - MKDEBUG && $self->print_active_handles($dbh); |
1517 | - $dbh->disconnect; |
1518 | -} |
1519 | - |
1520 | -sub print_active_handles { |
1521 | - my ( $self, $thing, $level ) = @_; |
1522 | - $level ||= 0; |
1523 | - printf("# Active %sh: %s %s %s\n", ($thing->{Type} || 'undef'), "\t" x $level, |
1524 | - $thing, (($thing->{Type} || '') eq 'st' ? $thing->{Statement} || '' : '')) |
1525 | - or die "Cannot print: $OS_ERROR"; |
1526 | - foreach my $handle ( grep {defined} @{ $thing->{ChildHandles} } ) { |
1527 | - $self->print_active_handles( $handle, $level + 1 ); |
1528 | - } |
1529 | -} |
1530 | - |
1531 | -sub copy { |
1532 | - my ( $self, $dsn_1, $dsn_2, %args ) = @_; |
1533 | - die 'I need a dsn_1 argument' unless $dsn_1; |
1534 | - die 'I need a dsn_2 argument' unless $dsn_2; |
1535 | - my %new_dsn = map { |
1536 | - my $key = $_; |
1537 | - my $val; |
1538 | - if ( $args{overwrite} ) { |
1539 | - $val = defined $dsn_1->{$key} ? $dsn_1->{$key} : $dsn_2->{$key}; |
1540 | - } |
1541 | - else { |
1542 | - $val = defined $dsn_2->{$key} ? $dsn_2->{$key} : $dsn_1->{$key}; |
1543 | - } |
1544 | - $key => $val; |
1545 | - } keys %{$self->{opts}}; |
1546 | - return \%new_dsn; |
1547 | +sub dbh { |
1548 | + my ($self) = @_; |
1549 | + return $self->{dbh}; |
1550 | +} |
1551 | + |
1552 | +sub dsn { |
1553 | + my ($self) = @_; |
1554 | + return $self->{dsn}; |
1555 | +} |
1556 | + |
1557 | +sub name { |
1558 | + my ($self) = @_; |
1559 | + return $self->{dsn_name} if PERCONA_TOOLKIT_TEST_USE_DSN_NAMES; |
1560 | + return $self->{hostname} || $self->{dsn_name} || 'unknown host'; |
1561 | +} |
1562 | + |
1563 | +sub DESTROY { |
1564 | + my ($self) = @_; |
1565 | + if ( $self->{dbh} ) { |
1566 | + MKDEBUG && _d('Disconnecting dbh', $self->{dbh}, $self->{name}); |
1567 | + $self->{dbh}->disconnect(); |
1568 | + } |
1569 | + return; |
1570 | } |
1571 | |
1572 | sub _d { |
1573 | @@ -2170,7 +1528,84 @@ |
1574 | 1; |
1575 | } |
1576 | # ########################################################################### |
1577 | -# End DSNParser package |
1578 | +# End Cxn package |
1579 | +# ########################################################################### |
1580 | + |
1581 | +# ########################################################################### |
1582 | +# Quoter package |
1583 | +# This package is a copy without comments from the original. The original |
1584 | +# with comments and its test file can be found in the Bazaar repository at, |
1585 | +# lib/Quoter.pm |
1586 | +# t/lib/Quoter.t |
1587 | +# See https://launchpad.net/percona-toolkit for more information. |
1588 | +# ########################################################################### |
1589 | +{ |
1590 | +package Quoter; |
1591 | + |
1592 | +use strict; |
1593 | +use warnings FATAL => 'all'; |
1594 | +use English qw(-no_match_vars); |
1595 | +use constant MKDEBUG => $ENV{MKDEBUG} || 0; |
1596 | + |
1597 | +sub new { |
1598 | + my ( $class, %args ) = @_; |
1599 | + return bless {}, $class; |
1600 | +} |
1601 | + |
1602 | +sub quote { |
1603 | + my ( $self, @vals ) = @_; |
1604 | + foreach my $val ( @vals ) { |
1605 | + $val =~ s/`/``/g; |
1606 | + } |
1607 | + return join('.', map { '`' . $_ . '`' } @vals); |
1608 | +} |
1609 | + |
1610 | +sub quote_val { |
1611 | + my ( $self, $val ) = @_; |
1612 | + |
1613 | + return 'NULL' unless defined $val; # undef = NULL |
1614 | + return "''" if $val eq ''; # blank string = '' |
1615 | + return $val if $val =~ m/^0x[0-9a-fA-F]+$/; # hex data |
1616 | + |
1617 | + $val =~ s/(['\\])/\\$1/g; |
1618 | + return "'$val'"; |
1619 | +} |
1620 | + |
1621 | +sub split_unquote { |
1622 | + my ( $self, $db_tbl, $default_db ) = @_; |
1623 | + $db_tbl =~ s/`//g; |
1624 | + my ( $db, $tbl ) = split(/[.]/, $db_tbl); |
1625 | + if ( !$tbl ) { |
1626 | + $tbl = $db; |
1627 | + $db = $default_db; |
1628 | + } |
1629 | + return ($db, $tbl); |
1630 | +} |
1631 | + |
1632 | +sub literal_like { |
1633 | + my ( $self, $like ) = @_; |
1634 | + return unless $like; |
1635 | + $like =~ s/([%_])/\\$1/g; |
1636 | + return "'$like'"; |
1637 | +} |
1638 | + |
1639 | +sub join_quote { |
1640 | + my ( $self, $default_db, $db_tbl ) = @_; |
1641 | + return unless $db_tbl; |
1642 | + my ($db, $tbl) = split(/[.]/, $db_tbl); |
1643 | + if ( !$tbl ) { |
1644 | + $tbl = $db; |
1645 | + $db = $default_db; |
1646 | + } |
1647 | + $db = "`$db`" if $db && $db !~ m/^`/; |
1648 | + $tbl = "`$tbl`" if $tbl && $tbl !~ m/^`/; |
1649 | + return $db ? "$db.$tbl" : $tbl; |
1650 | +} |
1651 | + |
1652 | +1; |
1653 | +} |
1654 | +# ########################################################################### |
1655 | +# End Quoter package |
1656 | # ########################################################################### |
1657 | |
1658 | # ########################################################################### |
1659 | @@ -2257,294 +1692,417 @@ |
1660 | # ########################################################################### |
1661 | |
1662 | # ########################################################################### |
1663 | -# MySQLDump package |
1664 | +# TableParser package |
1665 | # This package is a copy without comments from the original. The original |
1666 | # with comments and its test file can be found in the Bazaar repository at, |
1667 | -# lib/MySQLDump.pm |
1668 | -# t/lib/MySQLDump.t |
1669 | +# lib/TableParser.pm |
1670 | +# t/lib/TableParser.t |
1671 | # See https://launchpad.net/percona-toolkit for more information. |
1672 | # ########################################################################### |
1673 | { |
1674 | -package MySQLDump; |
1675 | +package TableParser; |
1676 | |
1677 | use strict; |
1678 | use warnings FATAL => 'all'; |
1679 | use English qw(-no_match_vars); |
1680 | use constant MKDEBUG => $ENV{MKDEBUG} || 0; |
1681 | |
1682 | -( our $before = <<'EOF') =~ s/^ //gm; |
1683 | - /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */; |
1684 | - /*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */; |
1685 | - /*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */; |
1686 | - /*!40101 SET NAMES utf8 */; |
1687 | - /*!40103 SET @OLD_TIME_ZONE=@@TIME_ZONE */; |
1688 | - /*!40103 SET TIME_ZONE='+00:00' */; |
1689 | - /*!40014 SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0 */; |
1690 | - /*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */; |
1691 | - /*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */; |
1692 | - /*!40111 SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0 */; |
1693 | -EOF |
1694 | - |
1695 | -( our $after = <<'EOF') =~ s/^ //gm; |
1696 | - /*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */; |
1697 | - /*!40101 SET SQL_MODE=@OLD_SQL_MODE */; |
1698 | - /*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */; |
1699 | - /*!40014 SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS */; |
1700 | - /*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */; |
1701 | - /*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */; |
1702 | - /*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */; |
1703 | - /*!40111 SET SQL_NOTES=@OLD_SQL_NOTES */; |
1704 | -EOF |
1705 | +use Data::Dumper; |
1706 | +$Data::Dumper::Indent = 1; |
1707 | +$Data::Dumper::Sortkeys = 1; |
1708 | +$Data::Dumper::Quotekeys = 0; |
1709 | |
1710 | sub new { |
1711 | my ( $class, %args ) = @_; |
1712 | - my $self = { |
1713 | - cache => 0, # Afaik no script uses this cache any longer because |
1714 | - }; |
1715 | + my @required_args = qw(Quoter); |
1716 | + foreach my $arg ( @required_args ) { |
1717 | + die "I need a $arg argument" unless $args{$arg}; |
1718 | + } |
1719 | + my $self = { %args }; |
1720 | return bless $self, $class; |
1721 | } |
1722 | |
1723 | -sub dump { |
1724 | - my ( $self, $dbh, $quoter, $db, $tbl, $what ) = @_; |
1725 | - |
1726 | - if ( $what eq 'table' ) { |
1727 | - my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl); |
1728 | - return unless $ddl; |
1729 | - if ( $ddl->[0] eq 'table' ) { |
1730 | - return $before |
1731 | - . 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n" |
1732 | - . $ddl->[1] . ";\n"; |
1733 | - } |
1734 | - else { |
1735 | - return 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n" |
1736 | - . '/*!50001 DROP VIEW IF EXISTS ' |
1737 | - . $quoter->quote($tbl) . "*/;\n/*!50001 " |
1738 | - . $self->get_tmp_table($dbh, $quoter, $db, $tbl) . "*/;\n"; |
1739 | - } |
1740 | - } |
1741 | - elsif ( $what eq 'triggers' ) { |
1742 | - my $trgs = $self->get_triggers($dbh, $quoter, $db, $tbl); |
1743 | - if ( $trgs && @$trgs ) { |
1744 | - my $result = $before . "\nDELIMITER ;;\n"; |
1745 | - foreach my $trg ( @$trgs ) { |
1746 | - if ( $trg->{sql_mode} ) { |
1747 | - $result .= qq{/*!50003 SET SESSION SQL_MODE='$trg->{sql_mode}' */;;\n}; |
1748 | - } |
1749 | - $result .= "/*!50003 CREATE */ "; |
1750 | - if ( $trg->{definer} ) { |
1751 | - my ( $user, $host ) |
1752 | - = map { s/'/''/g; "'$_'"; } |
1753 | - split('@', $trg->{definer}, 2); |
1754 | - $result .= "/*!50017 DEFINER=$user\@$host */ "; |
1755 | - } |
1756 | - $result .= sprintf("/*!50003 TRIGGER %s %s %s ON %s\nFOR EACH ROW %s */;;\n\n", |
1757 | - $quoter->quote($trg->{trigger}), |
1758 | - @{$trg}{qw(timing event)}, |
1759 | - $quoter->quote($trg->{table}), |
1760 | - $trg->{statement}); |
1761 | - } |
1762 | - $result .= "DELIMITER ;\n\n/*!50003 SET SESSION SQL_MODE=\@OLD_SQL_MODE */;\n\n"; |
1763 | - return $result; |
1764 | - } |
1765 | - else { |
1766 | - return undef; |
1767 | - } |
1768 | - } |
1769 | - elsif ( $what eq 'view' ) { |
1770 | - my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl); |
1771 | - return '/*!50001 DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . "*/;\n" |
1772 | - . '/*!50001 DROP VIEW IF EXISTS ' . $quoter->quote($tbl) . "*/;\n" |
1773 | - . '/*!50001 ' . $ddl->[1] . "*/;\n"; |
1774 | - } |
1775 | - else { |
1776 | - die "You didn't say what to dump."; |
1777 | - } |
1778 | -} |
1779 | - |
1780 | -sub _use_db { |
1781 | - my ( $self, $dbh, $quoter, $new ) = @_; |
1782 | - if ( !$new ) { |
1783 | - MKDEBUG && _d('No new DB to use'); |
1784 | - return; |
1785 | - } |
1786 | - my $sql = 'USE ' . $quoter->quote($new); |
1787 | - MKDEBUG && _d($dbh, $sql); |
1788 | - $dbh->do($sql); |
1789 | - return; |
1790 | -} |
1791 | - |
1792 | sub get_create_table { |
1793 | - my ( $self, $dbh, $quoter, $db, $tbl ) = @_; |
1794 | - if ( !$self->{cache} || !$self->{tables}->{$db}->{$tbl} ) { |
1795 | - my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, ' |
1796 | - . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } |
1797 | - . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' |
1798 | - . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; |
1799 | - MKDEBUG && _d($sql); |
1800 | - eval { $dbh->do($sql); }; |
1801 | - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); |
1802 | - $self->_use_db($dbh, $quoter, $db); |
1803 | - $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl); |
1804 | - MKDEBUG && _d($sql); |
1805 | - my $href; |
1806 | - eval { $href = $dbh->selectrow_hashref($sql); }; |
1807 | - if ( $EVAL_ERROR ) { |
1808 | - warn "Failed to $sql. The table may be damaged.\nError: $EVAL_ERROR"; |
1809 | - return; |
1810 | - } |
1811 | - |
1812 | - $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' |
1813 | - . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; |
1814 | - MKDEBUG && _d($sql); |
1815 | - $dbh->do($sql); |
1816 | - my ($key) = grep { m/create table/i } keys %$href; |
1817 | - if ( $key ) { |
1818 | - MKDEBUG && _d('This table is a base table'); |
1819 | - $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ]; |
1820 | + my ( $self, $dbh, $db, $tbl ) = @_; |
1821 | + die "I need a dbh parameter" unless $dbh; |
1822 | + die "I need a db parameter" unless $db; |
1823 | + die "I need a tbl parameter" unless $tbl; |
1824 | + my $q = $self->{Quoter}; |
1825 | + |
1826 | + my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, ' |
1827 | + . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } |
1828 | + . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' |
1829 | + . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; |
1830 | + MKDEBUG && _d($sql); |
1831 | + eval { $dbh->do($sql); }; |
1832 | + MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); |
1833 | + |
1834 | + $sql = 'USE ' . $q->quote($db); |
1835 | + MKDEBUG && _d($dbh, $sql); |
1836 | + $dbh->do($sql); |
1837 | + |
1838 | + $sql = "SHOW CREATE TABLE " . $q->quote($db, $tbl); |
1839 | + MKDEBUG && _d($sql); |
1840 | + my $href; |
1841 | + eval { $href = $dbh->selectrow_hashref($sql); }; |
1842 | + if ( $EVAL_ERROR ) { |
1843 | + MKDEBUG && _d($EVAL_ERROR); |
1844 | + return; |
1845 | + } |
1846 | + |
1847 | + $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' |
1848 | + . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; |
1849 | + MKDEBUG && _d($sql); |
1850 | + $dbh->do($sql); |
1851 | + |
1852 | + my ($key) = grep { m/create table/i } keys %$href; |
1853 | + if ( $key ) { |
1854 | + MKDEBUG && _d('This table is a base table'); |
1855 | + $href->{$key} =~ s/\b[ ]{2,}/ /g; |
1856 | + $href->{$key} .= "\n"; |
1857 | + } |
1858 | + else { |
1859 | + MKDEBUG && _d('This table is a view'); |
1860 | + ($key) = grep { m/create view/i } keys %$href; |
1861 | + } |
1862 | + |
1863 | + return $href->{$key}; |
1864 | +} |
1865 | + |
1866 | +sub parse { |
1867 | + my ( $self, $ddl, $opts ) = @_; |
1868 | + return unless $ddl; |
1869 | + |
1870 | + if ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) { |
1871 | + die "Cannot parse table definition; is ANSI quoting " |
1872 | + . "enabled or SQL_QUOTE_SHOW_CREATE disabled?"; |
1873 | + } |
1874 | + |
1875 | + my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/; |
1876 | + (undef, $name) = $self->{Quoter}->split_unquote($name) if $name; |
1877 | + |
1878 | + $ddl =~ s/(`[^`]+`)/\L$1/g; |
1879 | + |
1880 | + my $engine = $self->get_engine($ddl); |
1881 | + |
1882 | + my @defs = $ddl =~ m/^(\s+`.*?),?$/gm; |
1883 | + my @cols = map { $_ =~ m/`([^`]+)`/ } @defs; |
1884 | + MKDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); |
1885 | + |
1886 | + my %def_for; |
1887 | + @def_for{@cols} = @defs; |
1888 | + |
1889 | + my (@nums, @null); |
1890 | + my (%type_for, %is_nullable, %is_numeric, %is_autoinc); |
1891 | + foreach my $col ( @cols ) { |
1892 | + my $def = $def_for{$col}; |
1893 | + my ( $type ) = $def =~ m/`[^`]+`\s([a-z]+)/; |
1894 | + die "Can't determine column type for $def" unless $type; |
1895 | + $type_for{$col} = $type; |
1896 | + if ( $type =~ m/(?:(?:tiny|big|medium|small)?int|float|double|decimal|year)/ ) { |
1897 | + push @nums, $col; |
1898 | + $is_numeric{$col} = 1; |
1899 | + } |
1900 | + if ( $def !~ m/NOT NULL/ ) { |
1901 | + push @null, $col; |
1902 | + $is_nullable{$col} = 1; |
1903 | + } |
1904 | + $is_autoinc{$col} = $def =~ m/AUTO_INCREMENT/i ? 1 : 0; |
1905 | + } |
1906 | + |
1907 | + my ($keys, $clustered_key) = $self->get_keys($ddl, $opts, \%is_nullable); |
1908 | + |
1909 | + my ($charset) = $ddl =~ m/DEFAULT CHARSET=(\w+)/; |
1910 | + |
1911 | + return { |
1912 | + name => $name, |
1913 | + cols => \@cols, |
1914 | + col_posn => { map { $cols[$_] => $_ } 0..$#cols }, |
1915 | + is_col => { map { $_ => 1 } @cols }, |
1916 | + null_cols => \@null, |
1917 | + is_nullable => \%is_nullable, |
1918 | + is_autoinc => \%is_autoinc, |
1919 | + clustered_key => $clustered_key, |
1920 | + keys => $keys, |
1921 | + defs => \%def_for, |
1922 | + numeric_cols => \@nums, |
1923 | + is_numeric => \%is_numeric, |
1924 | + engine => $engine, |
1925 | + type_for => \%type_for, |
1926 | + charset => $charset, |
1927 | + }; |
1928 | +} |
1929 | + |
1930 | +sub sort_indexes { |
1931 | + my ( $self, $tbl ) = @_; |
1932 | + |
1933 | + my @indexes |
1934 | + = sort { |
1935 | + (($a ne 'PRIMARY') <=> ($b ne 'PRIMARY')) |
1936 | + || ( !$tbl->{keys}->{$a}->{is_unique} <=> !$tbl->{keys}->{$b}->{is_unique} ) |
1937 | + || ( $tbl->{keys}->{$a}->{is_nullable} <=> $tbl->{keys}->{$b}->{is_nullable} ) |
1938 | + || ( scalar(@{$tbl->{keys}->{$a}->{cols}}) <=> scalar(@{$tbl->{keys}->{$b}->{cols}}) ) |
1939 | + } |
1940 | + grep { |
1941 | + $tbl->{keys}->{$_}->{type} eq 'BTREE' |
1942 | + } |
1943 | + sort keys %{$tbl->{keys}}; |
1944 | + |
1945 | + MKDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); |
1946 | + return @indexes; |
1947 | +} |
1948 | + |
1949 | +sub find_best_index { |
1950 | + my ( $self, $tbl, $index ) = @_; |
1951 | + my $best; |
1952 | + if ( $index ) { |
1953 | + ($best) = grep { uc $_ eq uc $index } keys %{$tbl->{keys}}; |
1954 | + } |
1955 | + if ( !$best ) { |
1956 | + if ( $index ) { |
1957 | + die "Index '$index' does not exist in table"; |
1958 | } |
1959 | else { |
1960 | - MKDEBUG && _d('This table is a view'); |
1961 | - ($key) = grep { m/create view/i } keys %$href; |
1962 | - $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ]; |
1963 | - } |
1964 | - } |
1965 | - return $self->{tables}->{$db}->{$tbl}; |
1966 | -} |
1967 | - |
1968 | -sub get_columns { |
1969 | - my ( $self, $dbh, $quoter, $db, $tbl ) = @_; |
1970 | - MKDEBUG && _d('Get columns for', $db, $tbl); |
1971 | - if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) { |
1972 | - $self->_use_db($dbh, $quoter, $db); |
1973 | - my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl); |
1974 | - MKDEBUG && _d($sql); |
1975 | - my $cols = $dbh->selectall_arrayref($sql, { Slice => {} }); |
1976 | - |
1977 | - $self->{columns}->{$db}->{$tbl} = [ |
1978 | - map { |
1979 | - my %row; |
1980 | - @row{ map { lc $_ } keys %$_ } = values %$_; |
1981 | - \%row; |
1982 | - } @$cols |
1983 | - ]; |
1984 | - } |
1985 | - return $self->{columns}->{$db}->{$tbl}; |
1986 | -} |
1987 | - |
1988 | -sub get_tmp_table { |
1989 | - my ( $self, $dbh, $quoter, $db, $tbl ) = @_; |
1990 | - my $result = 'CREATE TABLE ' . $quoter->quote($tbl) . " (\n"; |
1991 | - $result .= join(",\n", |
1992 | - map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} } |
1993 | - @{$self->get_columns($dbh, $quoter, $db, $tbl)}); |
1994 | - $result .= "\n)"; |
1995 | - MKDEBUG && _d($result); |
1996 | - return $result; |
1997 | -} |
1998 | - |
1999 | -sub get_triggers { |
2000 | - my ( $self, $dbh, $quoter, $db, $tbl ) = @_; |
2001 | - if ( !$self->{cache} || !$self->{triggers}->{$db} ) { |
2002 | - $self->{triggers}->{$db} = {}; |
2003 | - my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, ' |
2004 | - . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } |
2005 | - . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' |
2006 | - . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; |
2007 | - MKDEBUG && _d($sql); |
2008 | - eval { $dbh->do($sql); }; |
2009 | - MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); |
2010 | - $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db); |
2011 | - MKDEBUG && _d($sql); |
2012 | - my $sth = $dbh->prepare($sql); |
2013 | - $sth->execute(); |
2014 | - if ( $sth->rows ) { |
2015 | - my $trgs = $sth->fetchall_arrayref({}); |
2016 | - foreach my $trg (@$trgs) { |
2017 | - my %trg; |
2018 | - @trg{ map { lc $_ } keys %$trg } = values %$trg; |
2019 | - push @{ $self->{triggers}->{$db}->{ $trg{table} } }, \%trg; |
2020 | - } |
2021 | - } |
2022 | - $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' |
2023 | - . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; |
2024 | - MKDEBUG && _d($sql); |
2025 | + ($best) = $self->sort_indexes($tbl); |
2026 | + } |
2027 | + } |
2028 | + MKDEBUG && _d('Best index found is', $best); |
2029 | + return $best; |
2030 | +} |
2031 | + |
2032 | +sub find_possible_keys { |
2033 | + my ( $self, $dbh, $database, $table, $quoter, $where ) = @_; |
2034 | + return () unless $where; |
2035 | + my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table) |
2036 | + . ' WHERE ' . $where; |
2037 | + MKDEBUG && _d($sql); |
2038 | + my $expl = $dbh->selectrow_hashref($sql); |
2039 | + $expl = { map { lc($_) => $expl->{$_} } keys %$expl }; |
2040 | + if ( $expl->{possible_keys} ) { |
2041 | + MKDEBUG && _d('possible_keys =', $expl->{possible_keys}); |
2042 | + my @candidates = split(',', $expl->{possible_keys}); |
2043 | + my %possible = map { $_ => 1 } @candidates; |
2044 | + if ( $expl->{key} ) { |
2045 | + MKDEBUG && _d('MySQL chose', $expl->{key}); |
2046 | + unshift @candidates, grep { $possible{$_} } split(',', $expl->{key}); |
2047 | + MKDEBUG && _d('Before deduping:', join(', ', @candidates)); |
2048 | + my %seen; |
2049 | + @candidates = grep { !$seen{$_}++ } @candidates; |
2050 | + } |
2051 | + MKDEBUG && _d('Final list:', join(', ', @candidates)); |
2052 | + return @candidates; |
2053 | + } |
2054 | + else { |
2055 | + MKDEBUG && _d('No keys in possible_keys'); |
2056 | + return (); |
2057 | + } |
2058 | +} |
2059 | + |
2060 | +sub check_table { |
2061 | + my ( $self, %args ) = @_; |
2062 | + my @required_args = qw(dbh db tbl); |
2063 | + foreach my $arg ( @required_args ) { |
2064 | + die "I need a $arg argument" unless $args{$arg}; |
2065 | + } |
2066 | + my ($dbh, $db, $tbl) = @args{@required_args}; |
2067 | + my $q = $self->{Quoter}; |
2068 | + my $db_tbl = $q->quote($db, $tbl); |
2069 | + MKDEBUG && _d('Checking', $db_tbl); |
2070 | + |
2071 | + my $sql = "SHOW TABLES FROM " . $q->quote($db) |
2072 | + . ' LIKE ' . $q->literal_like($tbl); |
2073 | + MKDEBUG && _d($sql); |
2074 | + my $row; |
2075 | + eval { |
2076 | + $row = $dbh->selectrow_arrayref($sql); |
2077 | + }; |
2078 | + if ( $EVAL_ERROR ) { |
2079 | + MKDEBUG && _d($EVAL_ERROR); |
2080 | + return 0; |
2081 | + } |
2082 | + if ( !$row->[0] || $row->[0] ne $tbl ) { |
2083 | + MKDEBUG && _d('Table does not exist'); |
2084 | + return 0; |
2085 | + } |
2086 | + |
2087 | + MKDEBUG && _d('Table exists; no privs to check'); |
2088 | + return 1 unless $args{all_privs}; |
2089 | + |
2090 | + $sql = "SHOW FULL COLUMNS FROM $db_tbl"; |
2091 | + MKDEBUG && _d($sql); |
2092 | + eval { |
2093 | + $row = $dbh->selectrow_hashref($sql); |
2094 | + }; |
2095 | + if ( $EVAL_ERROR ) { |
2096 | + MKDEBUG && _d($EVAL_ERROR); |
2097 | + return 0; |
2098 | + } |
2099 | + if ( !scalar keys %$row ) { |
2100 | + MKDEBUG && _d('Table has no columns:', Dumper($row)); |
2101 | + return 0; |
2102 | + } |
2103 | + my $privs = $row->{privileges} || $row->{Privileges}; |
2104 | + |
2105 | + $sql = "DELETE FROM $db_tbl LIMIT 0"; |
2106 | + MKDEBUG && _d($sql); |
2107 | + eval { |
2108 | $dbh->do($sql); |
2109 | - } |
2110 | - if ( $tbl ) { |
2111 | - return $self->{triggers}->{$db}->{$tbl}; |
2112 | - } |
2113 | - return values %{$self->{triggers}->{$db}}; |
2114 | -} |
2115 | - |
2116 | -sub get_databases { |
2117 | - my ( $self, $dbh, $quoter, $like ) = @_; |
2118 | - if ( !$self->{cache} || !$self->{databases} || $like ) { |
2119 | - my $sql = 'SHOW DATABASES'; |
2120 | - my @params; |
2121 | - if ( $like ) { |
2122 | - $sql .= ' LIKE ?'; |
2123 | - push @params, $like; |
2124 | - } |
2125 | - my $sth = $dbh->prepare($sql); |
2126 | - MKDEBUG && _d($sql, @params); |
2127 | - $sth->execute( @params ); |
2128 | - my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()}; |
2129 | - $self->{databases} = \@dbs unless $like; |
2130 | - return @dbs; |
2131 | - } |
2132 | - return @{$self->{databases}}; |
2133 | + }; |
2134 | + my $can_delete = $EVAL_ERROR ? 0 : 1; |
2135 | + |
2136 | + MKDEBUG && _d('User privs on', $db_tbl, ':', $privs, |
2137 | + ($can_delete ? 'delete' : '')); |
2138 | + |
2139 | + if ( !($privs =~ m/select/ && $privs =~ m/insert/ && $privs =~ m/update/ |
2140 | + && $can_delete) ) { |
2141 | + MKDEBUG && _d('User does not have all privs'); |
2142 | + return 0; |
2143 | + } |
2144 | + |
2145 | + MKDEBUG && _d('User has all privs'); |
2146 | + return 1; |
2147 | +} |
2148 | + |
2149 | +sub get_engine { |
2150 | + my ( $self, $ddl, $opts ) = @_; |
2151 | + my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; |
2152 | + MKDEBUG && _d('Storage engine:', $engine); |
2153 | + return $engine || undef; |
2154 | +} |
2155 | + |
2156 | +sub get_keys { |
2157 | + my ( $self, $ddl, $opts, $is_nullable ) = @_; |
2158 | + my $engine = $self->get_engine($ddl); |
2159 | + my $keys = {}; |
2160 | + my $clustered_key = undef; |
2161 | + |
2162 | + KEY: |
2163 | + foreach my $key ( $ddl =~ m/^ ((?:[A-Z]+ )?KEY .*)$/gm ) { |
2164 | + |
2165 | + next KEY if $key =~ m/FOREIGN/; |
2166 | + |
2167 | + my $key_ddl = $key; |
2168 | + MKDEBUG && _d('Parsed key:', $key_ddl); |
2169 | + |
2170 | + if ( $engine !~ m/MEMORY|HEAP/ ) { |
2171 | + $key =~ s/USING HASH/USING BTREE/; |
2172 | + } |
2173 | + |
2174 | + my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/; |
2175 | + my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/; |
2176 | + $type = $type || $special || 'BTREE'; |
2177 | + if ( $opts->{mysql_version} && $opts->{mysql_version} lt '004001000' |
2178 | + && $engine =~ m/HEAP|MEMORY/i ) |
2179 | + { |
2180 | + $type = 'HASH'; # MySQL pre-4.1 supports only HASH indexes on HEAP |
2181 | + } |
2182 | + |
2183 | + my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/; |
2184 | + my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0; |
2185 | + my @cols; |
2186 | + my @col_prefixes; |
2187 | + foreach my $col_def ( $cols =~ m/`[^`]+`(?:\(\d+\))?/g ) { |
2188 | + my ($name, $prefix) = $col_def =~ m/`([^`]+)`(?:\((\d+)\))?/; |
2189 | + push @cols, $name; |
2190 | + push @col_prefixes, $prefix; |
2191 | + } |
2192 | + $name =~ s/`//g; |
2193 | + |
2194 | + MKDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); |
2195 | + |
2196 | + $keys->{$name} = { |
2197 | + name => $name, |
2198 | + type => $type, |
2199 | + colnames => $cols, |
2200 | + cols => \@cols, |
2201 | + col_prefixes => \@col_prefixes, |
2202 | + is_unique => $unique, |
2203 | + is_nullable => scalar(grep { $is_nullable->{$_} } @cols), |
2204 | + is_col => { map { $_ => 1 } @cols }, |
2205 | + ddl => $key_ddl, |
2206 | + }; |
2207 | + |
2208 | + if ( $engine =~ m/InnoDB/i && !$clustered_key ) { |
2209 | + my $this_key = $keys->{$name}; |
2210 | + if ( $this_key->{name} eq 'PRIMARY' ) { |
2211 | + $clustered_key = 'PRIMARY'; |
2212 | + } |
2213 | + elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) { |
2214 | + $clustered_key = $this_key->{name}; |
2215 | + } |
2216 | + MKDEBUG && $clustered_key && _d('This key is the clustered key'); |
2217 | + } |
2218 | + } |
2219 | + |
2220 | + return $keys, $clustered_key; |
2221 | +} |
2222 | + |
2223 | +sub get_fks { |
2224 | + my ( $self, $ddl, $opts ) = @_; |
2225 | + my $q = $self->{Quoter}; |
2226 | + my $fks = {}; |
2227 | + |
2228 | + foreach my $fk ( |
2229 | + $ddl =~ m/CONSTRAINT .* FOREIGN KEY .* REFERENCES [^\)]*\)/mg ) |
2230 | + { |
2231 | + my ( $name ) = $fk =~ m/CONSTRAINT `(.*?)`/; |
2232 | + my ( $cols ) = $fk =~ m/FOREIGN KEY \(([^\)]+)\)/; |
2233 | + my ( $parent, $parent_cols ) = $fk =~ m/REFERENCES (\S+) \(([^\)]+)\)/; |
2234 | + |
2235 | + my ($db, $tbl) = $q->split_unquote($parent, $opts->{database}); |
2236 | + my %parent_tbl = (tbl => $tbl); |
2237 | + $parent_tbl{db} = $db if $db; |
2238 | + |
2239 | + if ( $parent !~ m/\./ && $opts->{database} ) { |
2240 | + $parent = $q->quote($opts->{database}) . ".$parent"; |
2241 | + } |
2242 | + |
2243 | + $fks->{$name} = { |
2244 | + name => $name, |
2245 | + colnames => $cols, |
2246 | + cols => [ map { s/[ `]+//g; $_; } split(',', $cols) ], |
2247 | + parent_tbl => \%parent_tbl, |
2248 | + parent_tblname => $parent, |
2249 | + parent_cols => [ map { s/[ `]+//g; $_; } split(',', $parent_cols) ], |
2250 | + parent_colnames=> $parent_cols, |
2251 | + ddl => $fk, |
2252 | + }; |
2253 | + } |
2254 | + |
2255 | + return $fks; |
2256 | +} |
2257 | + |
2258 | +sub remove_auto_increment { |
2259 | + my ( $self, $ddl ) = @_; |
2260 | + $ddl =~ s/(^\).*?) AUTO_INCREMENT=\d+\b/$1/m; |
2261 | + return $ddl; |
2262 | } |
2263 | |
2264 | sub get_table_status { |
2265 | - my ( $self, $dbh, $quoter, $db, $like ) = @_; |
2266 | - if ( !$self->{cache} || !$self->{table_status}->{$db} || $like ) { |
2267 | - my $sql = "SHOW TABLE STATUS FROM " . $quoter->quote($db); |
2268 | - my @params; |
2269 | - if ( $like ) { |
2270 | - $sql .= ' LIKE ?'; |
2271 | - push @params, $like; |
2272 | - } |
2273 | - MKDEBUG && _d($sql, @params); |
2274 | - my $sth = $dbh->prepare($sql); |
2275 | - $sth->execute(@params); |
2276 | - my @tables = @{$sth->fetchall_arrayref({})}; |
2277 | - @tables = map { |
2278 | - my %tbl; # Make a copy with lowercased keys |
2279 | - @tbl{ map { lc $_ } keys %$_ } = values %$_; |
2280 | - $tbl{engine} ||= $tbl{type} || $tbl{comment}; |
2281 | - delete $tbl{type}; |
2282 | - \%tbl; |
2283 | - } @tables; |
2284 | - $self->{table_status}->{$db} = \@tables unless $like; |
2285 | - return @tables; |
2286 | - } |
2287 | - return @{$self->{table_status}->{$db}}; |
2288 | -} |
2289 | - |
2290 | -sub get_table_list { |
2291 | - my ( $self, $dbh, $quoter, $db, $like ) = @_; |
2292 | - if ( !$self->{cache} || !$self->{table_list}->{$db} || $like ) { |
2293 | - my $sql = "SHOW /*!50002 FULL*/ TABLES FROM " . $quoter->quote($db); |
2294 | - my @params; |
2295 | - if ( $like ) { |
2296 | - $sql .= ' LIKE ?'; |
2297 | - push @params, $like; |
2298 | - } |
2299 | - MKDEBUG && _d($sql, @params); |
2300 | - my $sth = $dbh->prepare($sql); |
2301 | - $sth->execute(@params); |
2302 | - my @tables = @{$sth->fetchall_arrayref()}; |
2303 | - @tables = map { |
2304 | - my %tbl = ( |
2305 | - name => $_->[0], |
2306 | - engine => ($_->[1] || '') eq 'VIEW' ? 'VIEW' : '', |
2307 | - ); |
2308 | - \%tbl; |
2309 | - } @tables; |
2310 | - $self->{table_list}->{$db} = \@tables unless $like; |
2311 | - return @tables; |
2312 | - } |
2313 | - return @{$self->{table_list}->{$db}}; |
2314 | + my ( $self, $dbh, $db, $like ) = @_; |
2315 | + my $q = $self->{Quoter}; |
2316 | + my $sql = "SHOW TABLE STATUS FROM " . $q->quote($db); |
2317 | + my @params; |
2318 | + if ( $like ) { |
2319 | + $sql .= ' LIKE ?'; |
2320 | + push @params, $like; |
2321 | + } |
2322 | + MKDEBUG && _d($sql, @params); |
2323 | + my $sth = $dbh->prepare($sql); |
2324 | + eval { $sth->execute(@params); }; |
2325 | + if ($EVAL_ERROR) { |
2326 | + MKDEBUG && _d($EVAL_ERROR); |
2327 | + return; |
2328 | + } |
2329 | + my @tables = @{$sth->fetchall_arrayref({})}; |
2330 | + @tables = map { |
2331 | + my %tbl; # Make a copy with lowercased keys |
2332 | + @tbl{ map { lc $_ } keys %$_ } = values %$_; |
2333 | + $tbl{engine} ||= $tbl{type} || $tbl{comment}; |
2334 | + delete $tbl{type}; |
2335 | + \%tbl; |
2336 | + } @tables; |
2337 | + return @tables; |
2338 | } |
2339 | |
2340 | sub _d { |
2341 | @@ -2558,923 +2116,250 @@ |
2342 | 1; |
2343 | } |
2344 | # ########################################################################### |
2345 | -# End MySQLDump package |
2346 | +# End TableParser package |
2347 | # ########################################################################### |
2348 | |
2349 | # ########################################################################### |
2350 | -# TableChunker package |
2351 | +# TableNibbler package |
2352 | # This package is a copy without comments from the original. The original |
2353 | # with comments and its test file can be found in the Bazaar repository at, |
2354 | -# lib/TableChunker.pm |
2355 | -# t/lib/TableChunker.t |
2356 | +# lib/TableNibbler.pm |
2357 | +# t/lib/TableNibbler.t |
2358 | # See https://launchpad.net/percona-toolkit for more information. |
2359 | # ########################################################################### |
2360 | { |
2361 | -package TableChunker; |
2362 | +package TableNibbler; |
2363 | |
2364 | use strict; |
2365 | use warnings FATAL => 'all'; |
2366 | use English qw(-no_match_vars); |
2367 | use constant MKDEBUG => $ENV{MKDEBUG} || 0; |
2368 | |
2369 | -use POSIX qw(floor ceil); |
2370 | -use List::Util qw(min max); |
2371 | -use Data::Dumper; |
2372 | -$Data::Dumper::Indent = 1; |
2373 | -$Data::Dumper::Sortkeys = 1; |
2374 | -$Data::Dumper::Quotekeys = 0; |
2375 | - |
2376 | sub new { |
2377 | my ( $class, %args ) = @_; |
2378 | - foreach my $arg ( qw(Quoter MySQLDump) ) { |
2379 | + my @required_args = qw(TableParser Quoter); |
2380 | + foreach my $arg ( @required_args ) { |
2381 | die "I need a $arg argument" unless $args{$arg}; |
2382 | } |
2383 | - |
2384 | - my %int_types = map { $_ => 1 } qw(bigint date datetime int mediumint smallint time timestamp tinyint year); |
2385 | - my %real_types = map { $_ => 1 } qw(decimal double float); |
2386 | - |
2387 | - my $self = { |
2388 | - %args, |
2389 | - int_types => \%int_types, |
2390 | - real_types => \%real_types, |
2391 | - EPOCH => '1970-01-01', |
2392 | - }; |
2393 | - |
2394 | + my $self = { %args }; |
2395 | return bless $self, $class; |
2396 | } |
2397 | |
2398 | -sub find_chunk_columns { |
2399 | - my ( $self, %args ) = @_; |
2400 | - foreach my $arg ( qw(tbl_struct) ) { |
2401 | - die "I need a $arg argument" unless $args{$arg}; |
2402 | - } |
2403 | - my $tbl_struct = $args{tbl_struct}; |
2404 | - |
2405 | - my @possible_indexes; |
2406 | - foreach my $index ( values %{ $tbl_struct->{keys} } ) { |
2407 | - |
2408 | - next unless $index->{type} eq 'BTREE'; |
2409 | - |
2410 | - next if grep { defined } @{$index->{col_prefixes}}; |
2411 | - |
2412 | - if ( $args{exact} ) { |
2413 | - next unless $index->{is_unique} && @{$index->{cols}} == 1; |
2414 | - } |
2415 | - |
2416 | - push @possible_indexes, $index; |
2417 | - } |
2418 | - MKDEBUG && _d('Possible chunk indexes in order:', |
2419 | - join(', ', map { $_->{name} } @possible_indexes)); |
2420 | - |
2421 | - my $can_chunk_exact = 0; |
2422 | - my @candidate_cols; |
2423 | - foreach my $index ( @possible_indexes ) { |
2424 | - my $col = $index->{cols}->[0]; |
2425 | - |
2426 | - my $col_type = $tbl_struct->{type_for}->{$col}; |
2427 | - next unless $self->{int_types}->{$col_type} |
2428 | - || $self->{real_types}->{$col_type} |
2429 | - || $col_type =~ m/char/; |
2430 | - |
2431 | - push @candidate_cols, { column => $col, index => $index->{name} }; |
2432 | - } |
2433 | - |
2434 | - $can_chunk_exact = 1 if $args{exact} && scalar @candidate_cols; |
2435 | - |
2436 | - if ( MKDEBUG ) { |
2437 | - my $chunk_type = $args{exact} ? 'Exact' : 'Inexact'; |
2438 | - _d($chunk_type, 'chunkable:', |
2439 | - join(', ', map { "$_->{column} on $_->{index}" } @candidate_cols)); |
2440 | - } |
2441 | - |
2442 | - my @result; |
2443 | - MKDEBUG && _d('Ordering columns by order in tbl, PK first'); |
2444 | - if ( $tbl_struct->{keys}->{PRIMARY} ) { |
2445 | - my $pk_first_col = $tbl_struct->{keys}->{PRIMARY}->{cols}->[0]; |
2446 | - @result = grep { $_->{column} eq $pk_first_col } @candidate_cols; |
2447 | - @candidate_cols = grep { $_->{column} ne $pk_first_col } @candidate_cols; |
2448 | - } |
2449 | - my $i = 0; |
2450 | - my %col_pos = map { $_ => $i++ } @{$tbl_struct->{cols}}; |
2451 | - push @result, sort { $col_pos{$a->{column}} <=> $col_pos{$b->{column}} } |
2452 | - @candidate_cols; |
2453 | - |
2454 | - if ( MKDEBUG ) { |
2455 | - _d('Chunkable columns:', |
2456 | - join(', ', map { "$_->{column} on $_->{index}" } @result)); |
2457 | - _d('Can chunk exactly:', $can_chunk_exact); |
2458 | - } |
2459 | - |
2460 | - return ($can_chunk_exact, @result); |
2461 | -} |
2462 | - |
2463 | -sub calculate_chunks { |
2464 | - my ( $self, %args ) = @_; |
2465 | - my @required_args = qw(dbh db tbl tbl_struct chunk_col rows_in_range chunk_size); |
2466 | +sub generate_asc_stmt { |
2467 | + my ( $self, %args ) = @_; |
2468 | + my @required_args = qw(tbl_struct index); |
2469 | foreach my $arg ( @required_args ) { |
2470 | die "I need a $arg argument" unless defined $args{$arg}; |
2471 | } |
2472 | - MKDEBUG && _d('Calculate chunks for', |
2473 | - join(", ", map {"$_=".(defined $args{$_} ? $args{$_} : "undef")} |
2474 | - qw(db tbl chunk_col min max rows_in_range chunk_size zero_chunk exact) |
2475 | - )); |
2476 | - |
2477 | - if ( !$args{rows_in_range} ) { |
2478 | - MKDEBUG && _d("Empty table"); |
2479 | - return '1=1'; |
2480 | - } |
2481 | - |
2482 | - if ( $args{rows_in_range} < $args{chunk_size} ) { |
2483 | - MKDEBUG && _d("Chunk size larger than rows in range"); |
2484 | - return '1=1'; |
2485 | - } |
2486 | - |
2487 | - my $q = $self->{Quoter}; |
2488 | - my $dbh = $args{dbh}; |
2489 | - my $chunk_col = $args{chunk_col}; |
2490 | - my $tbl_struct = $args{tbl_struct}; |
2491 | - my $col_type = $tbl_struct->{type_for}->{$chunk_col}; |
2492 | - MKDEBUG && _d('chunk col type:', $col_type); |
2493 | - |
2494 | - my %chunker; |
2495 | - if ( $tbl_struct->{is_numeric}->{$chunk_col} || $col_type =~ /date|time/ ) { |
2496 | - %chunker = $self->_chunk_numeric(%args); |
2497 | - } |
2498 | - elsif ( $col_type =~ m/char/ ) { |
2499 | - %chunker = $self->_chunk_char(%args); |
2500 | - } |
2501 | - else { |
2502 | - die "Cannot chunk $col_type columns"; |
2503 | - } |
2504 | - MKDEBUG && _d("Chunker:", Dumper(\%chunker)); |
2505 | - my ($col, $start_point, $end_point, $interval, $range_func) |
2506 | - = @chunker{qw(col start_point end_point interval range_func)}; |
2507 | - |
2508 | - my @chunks; |
2509 | - if ( $start_point < $end_point ) { |
2510 | - |
2511 | - push @chunks, "$col = 0" if $chunker{have_zero_chunk}; |
2512 | - |
2513 | - my ($beg, $end); |
2514 | - my $iter = 0; |
2515 | - for ( my $i = $start_point; $i < $end_point; $i += $interval ) { |
2516 | - ($beg, $end) = $self->$range_func($dbh, $i, $interval, $end_point); |
2517 | - |
2518 | - if ( $iter++ == 0 ) { |
2519 | - push @chunks, |
2520 | - ($chunker{have_zero_chunk} ? "$col > 0 AND " : "") |
2521 | - ."$col < " . $q->quote_val($end); |
2522 | + my ($tbl_struct, $index) = @args{@required_args}; |
2523 | + my @cols = $args{cols} ? @{$args{cols}} : @{$tbl_struct->{cols}}; |
2524 | + my $q = $self->{Quoter}; |
2525 | + |
2526 | + die "Index '$index' does not exist in table" |
2527 | + unless exists $tbl_struct->{keys}->{$index}; |
2528 | + MKDEBUG && _d('Will ascend index', $index); |
2529 | + |
2530 | + my @asc_cols = @{$tbl_struct->{keys}->{$index}->{cols}}; |
2531 | + if ( $args{asc_first} ) { |
2532 | + @asc_cols = $asc_cols[0]; |
2533 | + MKDEBUG && _d('Ascending only first column'); |
2534 | + } |
2535 | + MKDEBUG && _d('Will ascend columns', join(', ', @asc_cols)); |
2536 | + |
2537 | + my @asc_slice; |
2538 | + my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols }; |
2539 | + foreach my $col ( @asc_cols ) { |
2540 | + if ( !exists $col_posn{$col} ) { |
2541 | + push @cols, $col; |
2542 | + $col_posn{$col} = $#cols; |
2543 | + } |
2544 | + push @asc_slice, $col_posn{$col}; |
2545 | + } |
2546 | + MKDEBUG && _d('Will ascend, in ordinal position:', join(', ', @asc_slice)); |
2547 | + |
2548 | + my $asc_stmt = { |
2549 | + cols => \@cols, |
2550 | + index => $index, |
2551 | + where => '', |
2552 | + slice => [], |
2553 | + scols => [], |
2554 | + }; |
2555 | + |
2556 | + if ( @asc_slice ) { |
2557 | + my $cmp_where; |
2558 | + foreach my $cmp ( qw(< <= >= >) ) { |
2559 | + $cmp_where = $self->generate_cmp_where( |
2560 | + type => $cmp, |
2561 | + slice => \@asc_slice, |
2562 | + cols => \@cols, |
2563 | + quoter => $q, |
2564 | + is_nullable => $tbl_struct->{is_nullable}, |
2565 | + ); |
2566 | + $asc_stmt->{boundaries}->{$cmp} = $cmp_where->{where}; |
2567 | + } |
2568 | + my $cmp = $args{asc_only} ? '>' : '>='; |
2569 | + $asc_stmt->{where} = $asc_stmt->{boundaries}->{$cmp}; |
2570 | + $asc_stmt->{slice} = $cmp_where->{slice}; |
2571 | + $asc_stmt->{scols} = $cmp_where->{scols}; |
2572 | + } |
2573 | + |
2574 | + return $asc_stmt; |
2575 | +} |
2576 | + |
2577 | +sub generate_cmp_where { |
2578 | + my ( $self, %args ) = @_; |
2579 | + foreach my $arg ( qw(type slice cols is_nullable) ) { |
2580 | + die "I need a $arg arg" unless defined $args{$arg}; |
2581 | + } |
2582 | + my @slice = @{$args{slice}}; |
2583 | + my @cols = @{$args{cols}}; |
2584 | + my $is_nullable = $args{is_nullable}; |
2585 | + my $type = $args{type}; |
2586 | + my $q = $self->{Quoter}; |
2587 | + |
2588 | + (my $cmp = $type) =~ s/=//; |
2589 | + |
2590 | + my @r_slice; # Resulting slice columns, by ordinal |
2591 | + my @r_scols; # Ditto, by name |
2592 | + |
2593 | + my @clauses; |
2594 | + foreach my $i ( 0 .. $#slice ) { |
2595 | + my @clause; |
2596 | + |
2597 | + foreach my $j ( 0 .. $i - 1 ) { |
2598 | + my $ord = $slice[$j]; |
2599 | + my $col = $cols[$ord]; |
2600 | + my $quo = $q->quote($col); |
2601 | + if ( $is_nullable->{$col} ) { |
2602 | + push @clause, "((? IS NULL AND $quo IS NULL) OR ($quo = ?))"; |
2603 | + push @r_slice, $ord, $ord; |
2604 | + push @r_scols, $col, $col; |
2605 | } |
2606 | else { |
2607 | - push @chunks, "$col >= " . $q->quote_val($beg) . " AND $col < " . $q->quote_val($end); |
2608 | - } |
2609 | - } |
2610 | - |
2611 | - my $chunk_range = lc $args{chunk_range} || 'open'; |
2612 | - my $nullable = $args{tbl_struct}->{is_nullable}->{$args{chunk_col}}; |
2613 | - pop @chunks; |
2614 | - if ( @chunks ) { |
2615 | - push @chunks, "$col >= " . $q->quote_val($beg) |
2616 | - . ($chunk_range eq 'openclosed' |
2617 | - ? " AND $col <= " . $q->quote_val($args{max}) : ""); |
2618 | - } |
2619 | - else { |
2620 | - push @chunks, $nullable ? "$col IS NOT NULL" : '1=1'; |
2621 | - } |
2622 | - if ( $nullable ) { |
2623 | - push @chunks, "$col IS NULL"; |
2624 | - } |
2625 | - } |
2626 | - else { |
2627 | - MKDEBUG && _d('No chunks; using single chunk 1=1'); |
2628 | - push @chunks, '1=1'; |
2629 | - } |
2630 | - |
2631 | - return @chunks; |
2632 | -} |
2633 | - |
2634 | -sub _chunk_numeric { |
2635 | - my ( $self, %args ) = @_; |
2636 | - my @required_args = qw(dbh db tbl tbl_struct chunk_col rows_in_range chunk_size); |
2637 | - foreach my $arg ( @required_args ) { |
2638 | - die "I need a $arg argument" unless defined $args{$arg}; |
2639 | - } |
2640 | - my $q = $self->{Quoter}; |
2641 | - my $db_tbl = $q->quote($args{db}, $args{tbl}); |
2642 | - my $col_type = $args{tbl_struct}->{type_for}->{$args{chunk_col}}; |
2643 | - |
2644 | - my $range_func; |
2645 | - if ( $col_type =~ m/(?:int|year|float|double|decimal)$/ ) { |
2646 | - $range_func = 'range_num'; |
2647 | - } |
2648 | - elsif ( $col_type =~ m/^(?:timestamp|date|time)$/ ) { |
2649 | - $range_func = "range_$col_type"; |
2650 | - } |
2651 | - elsif ( $col_type eq 'datetime' ) { |
2652 | - $range_func = 'range_datetime'; |
2653 | - } |
2654 | - |
2655 | - my ($start_point, $end_point); |
2656 | - eval { |
2657 | - $start_point = $self->value_to_number( |
2658 | - value => $args{min}, |
2659 | - column_type => $col_type, |
2660 | - dbh => $args{dbh}, |
2661 | - ); |
2662 | - $end_point = $self->value_to_number( |
2663 | - value => $args{max}, |
2664 | - column_type => $col_type, |
2665 | - dbh => $args{dbh}, |
2666 | - ); |
2667 | - }; |
2668 | - if ( $EVAL_ERROR ) { |
2669 | - if ( $EVAL_ERROR =~ m/don't know how to chunk/ ) { |
2670 | - die $EVAL_ERROR; |
2671 | - } |
2672 | - else { |
2673 | - die "Error calculating chunk start and end points for table " |
2674 | - . "`$args{tbl_struct}->{name}` on column `$args{chunk_col}` " |
2675 | - . "with min/max values " |
2676 | - . join('/', |
2677 | - map { defined $args{$_} ? $args{$_} : 'undef' } qw(min max)) |
2678 | - . ":\n\n" |
2679 | - . $EVAL_ERROR |
2680 | - . "\nVerify that the min and max values are valid for the column. " |
2681 | - . "If they are valid, this error could be caused by a bug in the " |
2682 | - . "tool."; |
2683 | - } |
2684 | - } |
2685 | - |
2686 | - if ( !defined $start_point ) { |
2687 | - MKDEBUG && _d('Start point is undefined'); |
2688 | - $start_point = 0; |
2689 | - } |
2690 | - if ( !defined $end_point || $end_point < $start_point ) { |
2691 | - MKDEBUG && _d('End point is undefined or before start point'); |
2692 | - $end_point = 0; |
2693 | - } |
2694 | - MKDEBUG && _d("Actual chunk range:", $start_point, "to", $end_point); |
2695 | - |
2696 | - my $have_zero_chunk = 0; |
2697 | - if ( $args{zero_chunk} ) { |
2698 | - if ( $start_point != $end_point && $start_point >= 0 ) { |
2699 | - MKDEBUG && _d('Zero chunking'); |
2700 | - my $nonzero_val = $self->get_nonzero_value( |
2701 | - %args, |
2702 | - db_tbl => $db_tbl, |
2703 | - col => $args{chunk_col}, |
2704 | - col_type => $col_type, |
2705 | - val => $args{min} |
2706 | - ); |
2707 | - $start_point = $self->value_to_number( |
2708 | - value => $nonzero_val, |
2709 | - column_type => $col_type, |
2710 | - dbh => $args{dbh}, |
2711 | - ); |
2712 | - $have_zero_chunk = 1; |
2713 | - } |
2714 | - else { |
2715 | - MKDEBUG && _d("Cannot zero chunk"); |
2716 | - } |
2717 | - } |
2718 | - MKDEBUG && _d("Using chunk range:", $start_point, "to", $end_point); |
2719 | - |
2720 | - my $interval = $args{chunk_size} |
2721 | - * ($end_point - $start_point) |
2722 | - / $args{rows_in_range}; |
2723 | - if ( $self->{int_types}->{$col_type} ) { |
2724 | - $interval = ceil($interval); |
2725 | - } |
2726 | - $interval ||= $args{chunk_size}; |
2727 | - if ( $args{exact} ) { |
2728 | - $interval = $args{chunk_size}; |
2729 | - } |
2730 | - MKDEBUG && _d('Chunk interval:', $interval, 'units'); |
2731 | - |
2732 | - return ( |
2733 | - col => $q->quote($args{chunk_col}), |
2734 | - start_point => $start_point, |
2735 | - end_point => $end_point, |
2736 | - interval => $interval, |
2737 | - range_func => $range_func, |
2738 | - have_zero_chunk => $have_zero_chunk, |
2739 | - ); |
2740 | -} |
2741 | - |
2742 | -sub _chunk_char { |
2743 | - my ( $self, %args ) = @_; |
2744 | - my @required_args = qw(dbh db tbl tbl_struct chunk_col min max rows_in_range chunk_size); |
2745 | - foreach my $arg ( @required_args ) { |
2746 | - die "I need a $arg argument" unless defined $args{$arg}; |
2747 | - } |
2748 | - my $q = $self->{Quoter}; |
2749 | - my $db_tbl = $q->quote($args{db}, $args{tbl}); |
2750 | - my $dbh = $args{dbh}; |
2751 | - my $chunk_col = $args{chunk_col}; |
2752 | - my $row; |
2753 | - my $sql; |
2754 | - |
2755 | - my ($min_col, $max_col) = @{args}{qw(min max)}; |
2756 | - $sql = "SELECT ORD(?) AS min_col_ord, ORD(?) AS max_col_ord"; |
2757 | - MKDEBUG && _d($dbh, $sql); |
2758 | - my $ord_sth = $dbh->prepare($sql); # avoid quoting issues |
2759 | - $ord_sth->execute($min_col, $max_col); |
2760 | - $row = $ord_sth->fetchrow_arrayref(); |
2761 | - my ($min_col_ord, $max_col_ord) = ($row->[0], $row->[1]); |
2762 | - MKDEBUG && _d("Min/max col char code:", $min_col_ord, $max_col_ord); |
2763 | - |
2764 | - my $base; |
2765 | - my @chars; |
2766 | - MKDEBUG && _d("Table charset:", $args{tbl_struct}->{charset}); |
2767 | - if ( ($args{tbl_struct}->{charset} || "") eq "latin1" ) { |
2768 | - my @sorted_latin1_chars = ( |
2769 | - 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, |
2770 | - 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, |
2771 | - 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, |
2772 | - 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, |
2773 | - 88, 89, 90, 91, 92, 93, 94, 95, 96, 123, 124, 125, 126, 161, |
2774 | - 162, 163, 164, 165, 166, 167, 168, 169, 170, 171, 172, 173, 174, 175, |
2775 | - 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, |
2776 | - 190, 191, 215, 216, 222, 223, 247, 255); |
2777 | - |
2778 | - my ($first_char, $last_char); |
2779 | - for my $i ( 0..$#sorted_latin1_chars ) { |
2780 | - $first_char = $i and last if $sorted_latin1_chars[$i] >= $min_col_ord; |
2781 | - } |
2782 | - for my $i ( $first_char..$#sorted_latin1_chars ) { |
2783 | - $last_char = $i and last if $sorted_latin1_chars[$i] >= $max_col_ord; |
2784 | - }; |
2785 | - |
2786 | - @chars = map { chr $_; } @sorted_latin1_chars[$first_char..$last_char]; |
2787 | - $base = scalar @chars; |
2788 | - } |
2789 | - else { |
2790 | - |
2791 | - my $tmp_tbl = '__maatkit_char_chunking_map'; |
2792 | - my $tmp_db_tbl = $q->quote($args{db}, $tmp_tbl); |
2793 | - $sql = "DROP TABLE IF EXISTS $tmp_db_tbl"; |
2794 | - MKDEBUG && _d($dbh, $sql); |
2795 | - $dbh->do($sql); |
2796 | - my $col_def = $args{tbl_struct}->{defs}->{$chunk_col}; |
2797 | - $sql = "CREATE TEMPORARY TABLE $tmp_db_tbl ($col_def) " |
2798 | - . "ENGINE=MEMORY"; |
2799 | - MKDEBUG && _d($dbh, $sql); |
2800 | - $dbh->do($sql); |
2801 | - |
2802 | - $sql = "INSERT INTO $tmp_db_tbl VALUE (CHAR(?))"; |
2803 | - MKDEBUG && _d($dbh, $sql); |
2804 | - my $ins_char_sth = $dbh->prepare($sql); # avoid quoting issues |
2805 | - for my $char_code ( $min_col_ord..$max_col_ord ) { |
2806 | - $ins_char_sth->execute($char_code); |
2807 | - } |
2808 | - |
2809 | - $sql = "SELECT `$chunk_col` FROM $tmp_db_tbl " |
2810 | - . "WHERE `$chunk_col` BETWEEN ? AND ? " |
2811 | - . "ORDER BY `$chunk_col`"; |
2812 | - MKDEBUG && _d($dbh, $sql); |
2813 | - my $sel_char_sth = $dbh->prepare($sql); |
2814 | - $sel_char_sth->execute($min_col, $max_col); |
2815 | - |
2816 | - @chars = map { $_->[0] } @{ $sel_char_sth->fetchall_arrayref() }; |
2817 | - $base = scalar @chars; |
2818 | - |
2819 | - $sql = "DROP TABLE $tmp_db_tbl"; |
2820 | - MKDEBUG && _d($dbh, $sql); |
2821 | - $dbh->do($sql); |
2822 | - } |
2823 | - MKDEBUG && _d("Base", $base, "chars:", @chars); |
2824 | - |
2825 | - |
2826 | - $sql = "SELECT MAX(LENGTH($chunk_col)) FROM $db_tbl " |
2827 | - . ($args{where} ? "WHERE $args{where} " : "") |
2828 | - . "ORDER BY `$chunk_col`"; |
2829 | - MKDEBUG && _d($dbh, $sql); |
2830 | - $row = $dbh->selectrow_arrayref($sql); |
2831 | - my $max_col_len = $row->[0]; |
2832 | - MKDEBUG && _d("Max column value:", $max_col, $max_col_len); |
2833 | - my $n_values; |
2834 | - for my $n_chars ( 1..$max_col_len ) { |
2835 | - $n_values = $base**$n_chars; |
2836 | - if ( $n_values >= $args{chunk_size} ) { |
2837 | - MKDEBUG && _d($n_chars, "chars in base", $base, "expresses", |
2838 | - $n_values, "values"); |
2839 | - last; |
2840 | - } |
2841 | - } |
2842 | - |
2843 | - my $n_chunks = $args{rows_in_range} / $args{chunk_size}; |
2844 | - my $interval = floor($n_values / $n_chunks) || 1; |
2845 | - |
2846 | - my $range_func = sub { |
2847 | - my ( $self, $dbh, $start, $interval, $max ) = @_; |
2848 | - my $start_char = $self->base_count( |
2849 | - count_to => $start, |
2850 | - base => $base, |
2851 | - symbols => \@chars, |
2852 | - ); |
2853 | - my $end_char = $self->base_count( |
2854 | - count_to => min($max, $start + $interval), |
2855 | - base => $base, |
2856 | - symbols => \@chars, |
2857 | - ); |
2858 | - return $start_char, $end_char; |
2859 | - }; |
2860 | - |
2861 | - return ( |
2862 | - col => $q->quote($chunk_col), |
2863 | - start_point => 0, |
2864 | - end_point => $n_values, |
2865 | - interval => $interval, |
2866 | - range_func => $range_func, |
2867 | - ); |
2868 | -} |
2869 | - |
2870 | -sub get_first_chunkable_column { |
2871 | - my ( $self, %args ) = @_; |
2872 | - foreach my $arg ( qw(tbl_struct) ) { |
2873 | - die "I need a $arg argument" unless $args{$arg}; |
2874 | - } |
2875 | - |
2876 | - my ($exact, @cols) = $self->find_chunk_columns(%args); |
2877 | - my $col = $cols[0]->{column}; |
2878 | - my $idx = $cols[0]->{index}; |
2879 | - |
2880 | - my $wanted_col = $args{chunk_column}; |
2881 | - my $wanted_idx = $args{chunk_index}; |
2882 | - MKDEBUG && _d("Preferred chunk col/idx:", $wanted_col, $wanted_idx); |
2883 | - |
2884 | - if ( $wanted_col && $wanted_idx ) { |
2885 | - foreach my $chunkable_col ( @cols ) { |
2886 | - if ( $wanted_col eq $chunkable_col->{column} |
2887 | - && $wanted_idx eq $chunkable_col->{index} ) { |
2888 | - $col = $wanted_col; |
2889 | - $idx = $wanted_idx; |
2890 | - last; |
2891 | - } |
2892 | - } |
2893 | - } |
2894 | - elsif ( $wanted_col ) { |
2895 | - foreach my $chunkable_col ( @cols ) { |
2896 | - if ( $wanted_col eq $chunkable_col->{column} ) { |
2897 | - $col = $wanted_col; |
2898 | - $idx = $chunkable_col->{index}; |
2899 | - last; |
2900 | - } |
2901 | - } |
2902 | - } |
2903 | - elsif ( $wanted_idx ) { |
2904 | - foreach my $chunkable_col ( @cols ) { |
2905 | - if ( $wanted_idx eq $chunkable_col->{index} ) { |
2906 | - $col = $chunkable_col->{column}; |
2907 | - $idx = $wanted_idx; |
2908 | - last; |
2909 | - } |
2910 | - } |
2911 | - } |
2912 | - |
2913 | - MKDEBUG && _d('First chunkable col/index:', $col, $idx); |
2914 | - return $col, $idx; |
2915 | -} |
2916 | - |
2917 | -sub size_to_rows { |
2918 | - my ( $self, %args ) = @_; |
2919 | - my @required_args = qw(dbh db tbl chunk_size); |
2920 | - foreach my $arg ( @required_args ) { |
2921 | - die "I need a $arg argument" unless $args{$arg}; |
2922 | - } |
2923 | - my ($dbh, $db, $tbl, $chunk_size) = @args{@required_args}; |
2924 | - my $q = $self->{Quoter}; |
2925 | - my $du = $self->{MySQLDump}; |
2926 | - |
2927 | - my ($n_rows, $avg_row_length); |
2928 | - |
2929 | - my ( $num, $suffix ) = $chunk_size =~ m/^(\d+)([MGk])?$/; |
2930 | - if ( $suffix ) { # Convert to bytes. |
2931 | - $chunk_size = $suffix eq 'k' ? $num * 1_024 |
2932 | - : $suffix eq 'M' ? $num * 1_024 * 1_024 |
2933 | - : $num * 1_024 * 1_024 * 1_024; |
2934 | - } |
2935 | - elsif ( $num ) { |
2936 | - $n_rows = $num; |
2937 | - } |
2938 | - else { |
2939 | - die "Invalid chunk size $chunk_size; must be an integer " |
2940 | - . "with optional suffix kMG"; |
2941 | - } |
2942 | - |
2943 | - if ( $suffix || $args{avg_row_length} ) { |
2944 | - my ($status) = $du->get_table_status($dbh, $q, $db, $tbl); |
2945 | - $avg_row_length = $status->{avg_row_length}; |
2946 | - if ( !defined $n_rows ) { |
2947 | - $n_rows = $avg_row_length ? ceil($chunk_size / $avg_row_length) : undef; |
2948 | - } |
2949 | - } |
2950 | - |
2951 | - return $n_rows, $avg_row_length; |
2952 | -} |
2953 | - |
2954 | -sub get_range_statistics { |
2955 | - my ( $self, %args ) = @_; |
2956 | - my @required_args = qw(dbh db tbl chunk_col tbl_struct); |
2957 | - foreach my $arg ( @required_args ) { |
2958 | - die "I need a $arg argument" unless $args{$arg}; |
2959 | - } |
2960 | - my ($dbh, $db, $tbl, $col) = @args{@required_args}; |
2961 | - my $where = $args{where}; |
2962 | - my $q = $self->{Quoter}; |
2963 | - |
2964 | - my $col_type = $args{tbl_struct}->{type_for}->{$col}; |
2965 | - my $col_is_numeric = $args{tbl_struct}->{is_numeric}->{$col}; |
2966 | - |
2967 | - my $db_tbl = $q->quote($db, $tbl); |
2968 | - $col = $q->quote($col); |
2969 | - |
2970 | - my ($min, $max); |
2971 | - eval { |
2972 | - my $sql = "SELECT MIN($col), MAX($col) FROM $db_tbl" |
2973 | - . ($args{index_hint} ? " $args{index_hint}" : "") |
2974 | - . ($where ? " WHERE ($where)" : ''); |
2975 | - MKDEBUG && _d($dbh, $sql); |
2976 | - ($min, $max) = $dbh->selectrow_array($sql); |
2977 | - MKDEBUG && _d("Actual end points:", $min, $max); |
2978 | - |
2979 | - ($min, $max) = $self->get_valid_end_points( |
2980 | - %args, |
2981 | - dbh => $dbh, |
2982 | - db_tbl => $db_tbl, |
2983 | - col => $col, |
2984 | - col_type => $col_type, |
2985 | - min => $min, |
2986 | - max => $max, |
2987 | - ); |
2988 | - MKDEBUG && _d("Valid end points:", $min, $max); |
2989 | - }; |
2990 | - if ( $EVAL_ERROR ) { |
2991 | - die "Error getting min and max values for table $db_tbl " |
2992 | - . "on column $col: $EVAL_ERROR"; |
2993 | - } |
2994 | - |
2995 | - my $sql = "EXPLAIN SELECT * FROM $db_tbl" |
2996 | - . ($args{index_hint} ? " $args{index_hint}" : "") |
2997 | - . ($where ? " WHERE $where" : ''); |
2998 | - MKDEBUG && _d($sql); |
2999 | - my $expl = $dbh->selectrow_hashref($sql); |
3000 | - |
3001 | - return ( |
3002 | - min => $min, |
3003 | - max => $max, |
3004 | - rows_in_range => $expl->{rows}, |
3005 | - ); |
3006 | -} |
3007 | - |
3008 | -sub inject_chunks { |
3009 | - my ( $self, %args ) = @_; |
3010 | - foreach my $arg ( qw(database table chunks chunk_num query) ) { |
3011 | - die "I need a $arg argument" unless defined $args{$arg}; |
3012 | - } |
3013 | - MKDEBUG && _d('Injecting chunk', $args{chunk_num}); |
3014 | - my $query = $args{query}; |
3015 | - my $comment = sprintf("/*%s.%s:%d/%d*/", |
3016 | - $args{database}, $args{table}, |
3017 | - $args{chunk_num} + 1, scalar @{$args{chunks}}); |
3018 | - $query =~ s!/\*PROGRESS_COMMENT\*/!$comment!; |
3019 | - my $where = "WHERE (" . $args{chunks}->[$args{chunk_num}] . ')'; |
3020 | - if ( $args{where} && grep { $_ } @{$args{where}} ) { |
3021 | - $where .= " AND (" |
3022 | - . join(" AND ", map { "($_)" } grep { $_ } @{$args{where}} ) |
3023 | - . ")"; |
3024 | - } |
3025 | - my $db_tbl = $self->{Quoter}->quote(@args{qw(database table)}); |
3026 | - my $index_hint = $args{index_hint} || ''; |
3027 | - |
3028 | - MKDEBUG && _d('Parameters:', |
3029 | - Dumper({WHERE => $where, DB_TBL => $db_tbl, INDEX_HINT => $index_hint})); |
3030 | - $query =~ s!/\*WHERE\*/! $where!; |
3031 | - $query =~ s!/\*DB_TBL\*/!$db_tbl!; |
3032 | - $query =~ s!/\*INDEX_HINT\*/! $index_hint!; |
3033 | - $query =~ s!/\*CHUNK_NUM\*/! $args{chunk_num} AS chunk_num,!; |
3034 | - |
3035 | - return $query; |
3036 | -} |
3037 | - |
3038 | - |
3039 | -sub value_to_number { |
3040 | - my ( $self, %args ) = @_; |
3041 | - my @required_args = qw(column_type dbh); |
3042 | - foreach my $arg ( @required_args ) { |
3043 | - die "I need a $arg argument" unless defined $args{$arg}; |
3044 | - } |
3045 | - my $val = $args{value}; |
3046 | - my ($col_type, $dbh) = @args{@required_args}; |
3047 | - MKDEBUG && _d('Converting MySQL', $col_type, $val); |
3048 | - |
3049 | - return unless defined $val; # value is NULL |
3050 | - |
3051 | - my %mysql_conv_func_for = ( |
3052 | - timestamp => 'UNIX_TIMESTAMP', |
3053 | - date => 'TO_DAYS', |
3054 | - time => 'TIME_TO_SEC', |
3055 | - datetime => 'TO_DAYS', |
3056 | - ); |
3057 | - |
3058 | - my $num; |
3059 | - if ( $col_type =~ m/(?:int|year|float|double|decimal)$/ ) { |
3060 | - $num = $val; |
3061 | - } |
3062 | - elsif ( $col_type =~ m/^(?:timestamp|date|time)$/ ) { |
3063 | - my $func = $mysql_conv_func_for{$col_type}; |
3064 | - my $sql = "SELECT $func(?)"; |
3065 | - MKDEBUG && _d($dbh, $sql, $val); |
3066 | - my $sth = $dbh->prepare($sql); |
3067 | - $sth->execute($val); |
3068 | - ($num) = $sth->fetchrow_array(); |
3069 | - } |
3070 | - elsif ( $col_type eq 'datetime' ) { |
3071 | - $num = $self->timestampdiff($dbh, $val); |
3072 | - } |
3073 | - else { |
3074 | - die "I don't know how to chunk $col_type\n"; |
3075 | - } |
3076 | - MKDEBUG && _d('Converts to', $num); |
3077 | - return $num; |
3078 | -} |
3079 | - |
3080 | -sub range_num { |
3081 | - my ( $self, $dbh, $start, $interval, $max ) = @_; |
3082 | - my $end = min($max, $start + $interval); |
3083 | - |
3084 | - |
3085 | - $start = sprintf('%.17f', $start) if $start =~ /e/; |
3086 | - $end = sprintf('%.17f', $end) if $end =~ /e/; |
3087 | - |
3088 | - $start =~ s/\.(\d{5}).*$/.$1/; |
3089 | - $end =~ s/\.(\d{5}).*$/.$1/; |
3090 | - |
3091 | - if ( $end > $start ) { |
3092 | - return ( $start, $end ); |
3093 | - } |
3094 | - else { |
3095 | - die "Chunk size is too small: $end !> $start\n"; |
3096 | - } |
3097 | -} |
3098 | - |
3099 | -sub range_time { |
3100 | - my ( $self, $dbh, $start, $interval, $max ) = @_; |
3101 | - my $sql = "SELECT SEC_TO_TIME($start), SEC_TO_TIME(LEAST($max, $start + $interval))"; |
3102 | - MKDEBUG && _d($sql); |
3103 | - return $dbh->selectrow_array($sql); |
3104 | -} |
3105 | - |
3106 | -sub range_date { |
3107 | - my ( $self, $dbh, $start, $interval, $max ) = @_; |
3108 | - my $sql = "SELECT FROM_DAYS($start), FROM_DAYS(LEAST($max, $start + $interval))"; |
3109 | - MKDEBUG && _d($sql); |
3110 | - return $dbh->selectrow_array($sql); |
3111 | -} |
3112 | - |
3113 | -sub range_datetime { |
3114 | - my ( $self, $dbh, $start, $interval, $max ) = @_; |
3115 | - my $sql = "SELECT DATE_ADD('$self->{EPOCH}', INTERVAL $start SECOND), " |
3116 | - . "DATE_ADD('$self->{EPOCH}', INTERVAL LEAST($max, $start + $interval) SECOND)"; |
3117 | - MKDEBUG && _d($sql); |
3118 | - return $dbh->selectrow_array($sql); |
3119 | -} |
3120 | - |
3121 | -sub range_timestamp { |
3122 | - my ( $self, $dbh, $start, $interval, $max ) = @_; |
3123 | - my $sql = "SELECT FROM_UNIXTIME($start), FROM_UNIXTIME(LEAST($max, $start + $interval))"; |
3124 | - MKDEBUG && _d($sql); |
3125 | - return $dbh->selectrow_array($sql); |
3126 | -} |
3127 | - |
3128 | -sub timestampdiff { |
3129 | - my ( $self, $dbh, $time ) = @_; |
3130 | - my $sql = "SELECT (COALESCE(TO_DAYS('$time'), 0) * 86400 + TIME_TO_SEC('$time')) " |
3131 | - . "- TO_DAYS('$self->{EPOCH} 00:00:00') * 86400"; |
3132 | - MKDEBUG && _d($sql); |
3133 | - my ( $diff ) = $dbh->selectrow_array($sql); |
3134 | - $sql = "SELECT DATE_ADD('$self->{EPOCH}', INTERVAL $diff SECOND)"; |
3135 | - MKDEBUG && _d($sql); |
3136 | - my ( $check ) = $dbh->selectrow_array($sql); |
3137 | - die <<" EOF" |
3138 | - Incorrect datetime math: given $time, calculated $diff but checked to $check. |
3139 | - This could be due to a version of MySQL that overflows on large interval |
3140 | - values to DATE_ADD(), or the given datetime is not a valid date. If not, |
3141 | - please report this as a bug. |
3142 | - EOF |
3143 | - unless $check eq $time; |
3144 | - return $diff; |
3145 | -} |
3146 | - |
3147 | - |
3148 | - |
3149 | - |
3150 | -sub get_valid_end_points { |
3151 | - my ( $self, %args ) = @_; |
3152 | - my @required_args = qw(dbh db_tbl col col_type); |
3153 | - foreach my $arg ( @required_args ) { |
3154 | - die "I need a $arg argument" unless $args{$arg}; |
3155 | - } |
3156 | - my ($dbh, $db_tbl, $col, $col_type) = @args{@required_args}; |
3157 | - my ($real_min, $real_max) = @args{qw(min max)}; |
3158 | - |
3159 | - my $err_fmt = "Error finding a valid %s value for table $db_tbl on " |
3160 | - . "column $col. The real %s value %s is invalid and " |
3161 | - . "no other valid values were found. Verify that the table " |
3162 | - . "has at least one valid value for this column" |
3163 | - . ($args{where} ? " where $args{where}." : "."); |
3164 | - |
3165 | - my $valid_min = $real_min; |
3166 | - if ( defined $valid_min ) { |
3167 | - MKDEBUG && _d("Validating min end point:", $real_min); |
3168 | - $valid_min = $self->_get_valid_end_point( |
3169 | - %args, |
3170 | - val => $real_min, |
3171 | - endpoint => 'min', |
3172 | - ); |
3173 | - die sprintf($err_fmt, 'minimum', 'minimum', |
3174 | - (defined $real_min ? $real_min : "NULL")) |
3175 | - unless defined $valid_min; |
3176 | - } |
3177 | - |
3178 | - my $valid_max = $real_max; |
3179 | - if ( defined $valid_max ) { |
3180 | - MKDEBUG && _d("Validating max end point:", $real_min); |
3181 | - $valid_max = $self->_get_valid_end_point( |
3182 | - %args, |
3183 | - val => $real_max, |
3184 | - endpoint => 'max', |
3185 | - ); |
3186 | - die sprintf($err_fmt, 'maximum', 'maximum', |
3187 | - (defined $real_max ? $real_max : "NULL")) |
3188 | - unless defined $valid_max; |
3189 | - } |
3190 | - |
3191 | - return $valid_min, $valid_max; |
3192 | -} |
3193 | - |
3194 | -sub _get_valid_end_point { |
3195 | - my ( $self, %args ) = @_; |
3196 | - my @required_args = qw(dbh db_tbl col col_type); |
3197 | - foreach my $arg ( @required_args ) { |
3198 | - die "I need a $arg argument" unless $args{$arg}; |
3199 | - } |
3200 | - my ($dbh, $db_tbl, $col, $col_type) = @args{@required_args}; |
3201 | - my $val = $args{val}; |
3202 | - |
3203 | - return $val unless defined $val; |
3204 | - |
3205 | - my $validate = $col_type =~ m/time|date/ ? \&_validate_temporal_value |
3206 | - : undef; |
3207 | - |
3208 | - if ( !$validate ) { |
3209 | - MKDEBUG && _d("No validator for", $col_type, "values"); |
3210 | - return $val; |
3211 | - } |
3212 | - |
3213 | - return $val if defined $validate->($dbh, $val); |
3214 | - |
3215 | - MKDEBUG && _d("Value is invalid, getting first valid value"); |
3216 | - $val = $self->get_first_valid_value( |
3217 | - %args, |
3218 | - val => $val, |
3219 | - validate => $validate, |
3220 | - ); |
3221 | - |
3222 | - return $val; |
3223 | -} |
3224 | - |
3225 | -sub get_first_valid_value { |
3226 | - my ( $self, %args ) = @_; |
3227 | - my @required_args = qw(dbh db_tbl col validate endpoint); |
3228 | - foreach my $arg ( @required_args ) { |
3229 | - die "I need a $arg argument" unless $args{$arg}; |
3230 | - } |
3231 | - my ($dbh, $db_tbl, $col, $validate, $endpoint) = @args{@required_args}; |
3232 | - my $tries = defined $args{tries} ? $args{tries} : 5; |
3233 | - my $val = $args{val}; |
3234 | - |
3235 | - return unless defined $val; |
3236 | - |
3237 | - my $cmp = $endpoint =~ m/min/i ? '>' |
3238 | - : $endpoint =~ m/max/i ? '<' |
3239 | - : die "Invalid endpoint arg: $endpoint"; |
3240 | - my $sql = "SELECT $col FROM $db_tbl " |
3241 | - . ($args{index_hint} ? "$args{index_hint} " : "") |
3242 | - . "WHERE $col $cmp ? AND $col IS NOT NULL " |
3243 | - . ($args{where} ? "AND ($args{where}) " : "") |
3244 | - . "ORDER BY $col LIMIT 1"; |
3245 | - MKDEBUG && _d($dbh, $sql); |
3246 | - my $sth = $dbh->prepare($sql); |
3247 | - |
3248 | - my $last_val = $val; |
3249 | - while ( $tries-- ) { |
3250 | - $sth->execute($last_val); |
3251 | - my ($next_val) = $sth->fetchrow_array(); |
3252 | - MKDEBUG && _d('Next value:', $next_val, '; tries left:', $tries); |
3253 | - if ( !defined $next_val ) { |
3254 | - MKDEBUG && _d('No more rows in table'); |
3255 | - last; |
3256 | - } |
3257 | - if ( defined $validate->($dbh, $next_val) ) { |
3258 | - MKDEBUG && _d('First valid value:', $next_val); |
3259 | - $sth->finish(); |
3260 | - return $next_val; |
3261 | - } |
3262 | - $last_val = $next_val; |
3263 | - } |
3264 | - $sth->finish(); |
3265 | - $val = undef; # no valid value found |
3266 | - |
3267 | - return $val; |
3268 | -} |
3269 | - |
3270 | -sub _validate_temporal_value { |
3271 | - my ( $dbh, $val ) = @_; |
3272 | - my $sql = "SELECT IF(TIME_FORMAT(?,'%H:%i:%s')=?, TIME_TO_SEC(?), TO_DAYS(?))"; |
3273 | - my $res; |
3274 | - eval { |
3275 | - MKDEBUG && _d($dbh, $sql, $val); |
3276 | - my $sth = $dbh->prepare($sql); |
3277 | - $sth->execute($val, $val, $val, $val); |
3278 | - ($res) = $sth->fetchrow_array(); |
3279 | - $sth->finish(); |
3280 | - }; |
3281 | - if ( $EVAL_ERROR ) { |
3282 | - MKDEBUG && _d($EVAL_ERROR); |
3283 | - } |
3284 | - return $res; |
3285 | -} |
3286 | - |
3287 | -sub get_nonzero_value { |
3288 | - my ( $self, %args ) = @_; |
3289 | - my @required_args = qw(dbh db_tbl col col_type); |
3290 | - foreach my $arg ( @required_args ) { |
3291 | - die "I need a $arg argument" unless $args{$arg}; |
3292 | - } |
3293 | - my ($dbh, $db_tbl, $col, $col_type) = @args{@required_args}; |
3294 | - my $tries = defined $args{tries} ? $args{tries} : 5; |
3295 | - my $val = $args{val}; |
3296 | - |
3297 | - my $is_nonzero = $col_type =~ m/time|date/ ? \&_validate_temporal_value |
3298 | - : sub { return $_[1]; }; |
3299 | - |
3300 | - if ( !$is_nonzero->($dbh, $val) ) { # quasi-double-negative, sorry |
3301 | - MKDEBUG && _d('Discarding zero value:', $val); |
3302 | - my $sql = "SELECT $col FROM $db_tbl " |
3303 | - . ($args{index_hint} ? "$args{index_hint} " : "") |
3304 | - . "WHERE $col > ? AND $col IS NOT NULL " |
3305 | - . ($args{where} ? "AND ($args{where}) " : '') |
3306 | - . "ORDER BY $col LIMIT 1"; |
3307 | - MKDEBUG && _d($sql); |
3308 | - my $sth = $dbh->prepare($sql); |
3309 | - |
3310 | - my $last_val = $val; |
3311 | - while ( $tries-- ) { |
3312 | - $sth->execute($last_val); |
3313 | - my ($next_val) = $sth->fetchrow_array(); |
3314 | - if ( $is_nonzero->($dbh, $next_val) ) { |
3315 | - MKDEBUG && _d('First non-zero value:', $next_val); |
3316 | - $sth->finish(); |
3317 | - return $next_val; |
3318 | - } |
3319 | - $last_val = $next_val; |
3320 | - } |
3321 | - $sth->finish(); |
3322 | - $val = undef; # no non-zero value found |
3323 | - } |
3324 | - |
3325 | - return $val; |
3326 | -} |
3327 | - |
3328 | -sub base_count { |
3329 | - my ( $self, %args ) = @_; |
3330 | - my @required_args = qw(count_to base symbols); |
3331 | - foreach my $arg ( @required_args ) { |
3332 | - die "I need a $arg argument" unless defined $args{$arg}; |
3333 | - } |
3334 | - my ($n, $base, $symbols) = @args{@required_args}; |
3335 | - |
3336 | - return $symbols->[0] if $n == 0; |
3337 | - |
3338 | - my $highest_power = floor(log($n)/log($base)); |
3339 | - if ( $highest_power == 0 ){ |
3340 | - return $symbols->[$n]; |
3341 | - } |
3342 | - |
3343 | - my @base_powers; |
3344 | - for my $power ( 0..$highest_power ) { |
3345 | - push @base_powers, ($base**$power) || 1; |
3346 | - } |
3347 | - |
3348 | - my @base_multiples; |
3349 | - foreach my $base_power ( reverse @base_powers ) { |
3350 | - my $multiples = floor($n / $base_power); |
3351 | - push @base_multiples, $multiples; |
3352 | - $n -= $multiples * $base_power; |
3353 | - } |
3354 | - |
3355 | - return join('', map { $symbols->[$_] } @base_multiples); |
3356 | + push @clause, "$quo = ?"; |
3357 | + push @r_slice, $ord; |
3358 | + push @r_scols, $col; |
3359 | + } |
3360 | + } |
3361 | + |
3362 | + my $ord = $slice[$i]; |
3363 | + my $col = $cols[$ord]; |
3364 | + my $quo = $q->quote($col); |
3365 | + my $end = $i == $#slice; # Last clause of the whole group. |
3366 | + if ( $is_nullable->{$col} ) { |
3367 | + if ( $type =~ m/=/ && $end ) { |
3368 | + push @clause, "(? IS NULL OR $quo $type ?)"; |
3369 | + } |
3370 | + elsif ( $type =~ m/>/ ) { |
3371 | + push @clause, "((? IS NULL AND $quo IS NOT NULL) OR ($quo $cmp ?))"; |
3372 | + } |
3373 | + else { # If $type =~ m/</ ) { |
3374 | + push @clause, "((? IS NOT NULL AND $quo IS NULL) OR ($quo $cmp ?))"; |
3375 | + } |
3376 | + push @r_slice, $ord, $ord; |
3377 | + push @r_scols, $col, $col; |
3378 | + } |
3379 | + else { |
3380 | + push @r_slice, $ord; |
3381 | + push @r_scols, $col; |
3382 | + push @clause, ($type =~ m/=/ && $end ? "$quo $type ?" : "$quo $cmp ?"); |
3383 | + } |
3384 | + |
3385 | + push @clauses, '(' . join(' AND ', @clause) . ')'; |
3386 | + } |
3387 | + my $result = '(' . join(' OR ', @clauses) . ')'; |
3388 | + my $where = { |
3389 | + slice => \@r_slice, |
3390 | + scols => \@r_scols, |
3391 | + where => $result, |
3392 | + }; |
3393 | + return $where; |
3394 | +} |
3395 | + |
3396 | +sub generate_del_stmt { |
3397 | + my ( $self, %args ) = @_; |
3398 | + |
3399 | + my $tbl = $args{tbl_struct}; |
3400 | + my @cols = $args{cols} ? @{$args{cols}} : (); |
3401 | + my $tp = $self->{TableParser}; |
3402 | + my $q = $self->{Quoter}; |
3403 | + |
3404 | + my @del_cols; |
3405 | + my @del_slice; |
3406 | + |
3407 | + my $index = $tp->find_best_index($tbl, $args{index}); |
3408 | + die "Cannot find an ascendable index in table" unless $index; |
3409 | + |
3410 | + if ( $index ) { |
3411 | + @del_cols = @{$tbl->{keys}->{$index}->{cols}}; |
3412 | + } |
3413 | + else { |
3414 | + @del_cols = @{$tbl->{cols}}; |
3415 | + } |
3416 | + MKDEBUG && _d('Columns needed for DELETE:', join(', ', @del_cols)); |
3417 | + |
3418 | + my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols }; |
3419 | + foreach my $col ( @del_cols ) { |
3420 | + if ( !exists $col_posn{$col} ) { |
3421 | + push @cols, $col; |
3422 | + $col_posn{$col} = $#cols; |
3423 | + } |
3424 | + push @del_slice, $col_posn{$col}; |
3425 | + } |
3426 | + MKDEBUG && _d('Ordinals needed for DELETE:', join(', ', @del_slice)); |
3427 | + |
3428 | + my $del_stmt = { |
3429 | + cols => \@cols, |
3430 | + index => $index, |
3431 | + where => '', |
3432 | + slice => [], |
3433 | + scols => [], |
3434 | + }; |
3435 | + |
3436 | + my @clauses; |
3437 | + foreach my $i ( 0 .. $#del_slice ) { |
3438 | + my $ord = $del_slice[$i]; |
3439 | + my $col = $cols[$ord]; |
3440 | + my $quo = $q->quote($col); |
3441 | + if ( $tbl->{is_nullable}->{$col} ) { |
3442 | + push @clauses, "((? IS NULL AND $quo IS NULL) OR ($quo = ?))"; |
3443 | + push @{$del_stmt->{slice}}, $ord, $ord; |
3444 | + push @{$del_stmt->{scols}}, $col, $col; |
3445 | + } |
3446 | + else { |
3447 | + push @clauses, "$quo = ?"; |
3448 | + push @{$del_stmt->{slice}}, $ord; |
3449 | + push @{$del_stmt->{scols}}, $col; |
3450 | + } |
3451 | + } |
3452 | + |
3453 | + $del_stmt->{where} = '(' . join(' AND ', @clauses) . ')'; |
3454 | + |
3455 | + return $del_stmt; |
3456 | +} |
3457 | + |
3458 | +sub generate_ins_stmt { |
3459 | + my ( $self, %args ) = @_; |
3460 | + foreach my $arg ( qw(ins_tbl sel_cols) ) { |
3461 | + die "I need a $arg argument" unless $args{$arg}; |
3462 | + } |
3463 | + my $ins_tbl = $args{ins_tbl}; |
3464 | + my @sel_cols = @{$args{sel_cols}}; |
3465 | + |
3466 | + die "You didn't specify any SELECT columns" unless @sel_cols; |
3467 | + |
3468 | + my @ins_cols; |
3469 | + my @ins_slice; |
3470 | + for my $i ( 0..$#sel_cols ) { |
3471 | + next unless $ins_tbl->{is_col}->{$sel_cols[$i]}; |
3472 | + push @ins_cols, $sel_cols[$i]; |
3473 | + push @ins_slice, $i; |
3474 | + } |
3475 | + |
3476 | + return { |
3477 | + cols => \@ins_cols, |
3478 | + slice => \@ins_slice, |
3479 | + }; |
3480 | } |
3481 | |
3482 | sub _d { |
3483 | @@ -3488,84 +2373,7 @@ |
3484 | 1; |
3485 | } |
3486 | # ########################################################################### |
3487 | -# End TableChunker package |
3488 | -# ########################################################################### |
3489 | - |
3490 | -# ########################################################################### |
3491 | -# Quoter package |
3492 | -# This package is a copy without comments from the original. The original |
3493 | -# with comments and its test file can be found in the Bazaar repository at, |
3494 | -# lib/Quoter.pm |
3495 | -# t/lib/Quoter.t |
3496 | -# See https://launchpad.net/percona-toolkit for more information. |
3497 | -# ########################################################################### |
3498 | -{ |
3499 | -package Quoter; |
3500 | - |
3501 | -use strict; |
3502 | -use warnings FATAL => 'all'; |
3503 | -use English qw(-no_match_vars); |
3504 | -use constant MKDEBUG => $ENV{MKDEBUG} || 0; |
3505 | - |
3506 | -sub new { |
3507 | - my ( $class, %args ) = @_; |
3508 | - return bless {}, $class; |
3509 | -} |
3510 | - |
3511 | -sub quote { |
3512 | - my ( $self, @vals ) = @_; |
3513 | - foreach my $val ( @vals ) { |
3514 | - $val =~ s/`/``/g; |
3515 | - } |
3516 | - return join('.', map { '`' . $_ . '`' } @vals); |
3517 | -} |
3518 | - |
3519 | -sub quote_val { |
3520 | - my ( $self, $val ) = @_; |
3521 | - |
3522 | - return 'NULL' unless defined $val; # undef = NULL |
3523 | - return "''" if $val eq ''; # blank string = '' |
3524 | - return $val if $val =~ m/^0x[0-9a-fA-F]+$/; # hex data |
3525 | - |
3526 | - $val =~ s/(['\\])/\\$1/g; |
3527 | - return "'$val'"; |
3528 | -} |
3529 | - |
3530 | -sub split_unquote { |
3531 | - my ( $self, $db_tbl, $default_db ) = @_; |
3532 | - $db_tbl =~ s/`//g; |
3533 | - my ( $db, $tbl ) = split(/[.]/, $db_tbl); |
3534 | - if ( !$tbl ) { |
3535 | - $tbl = $db; |
3536 | - $db = $default_db; |
3537 | - } |
3538 | - return ($db, $tbl); |
3539 | -} |
3540 | - |
3541 | -sub literal_like { |
3542 | - my ( $self, $like ) = @_; |
3543 | - return unless $like; |
3544 | - $like =~ s/([%_])/\\$1/g; |
3545 | - return "'$like'"; |
3546 | -} |
3547 | - |
3548 | -sub join_quote { |
3549 | - my ( $self, $default_db, $db_tbl ) = @_; |
3550 | - return unless $db_tbl; |
3551 | - my ($db, $tbl) = split(/[.]/, $db_tbl); |
3552 | - if ( !$tbl ) { |
3553 | - $tbl = $db; |
3554 | - $db = $default_db; |
3555 | - } |
3556 | - $db = "`$db`" if $db && $db !~ m/^`/; |
3557 | - $tbl = "`$tbl`" if $tbl && $tbl !~ m/^`/; |
3558 | - return $db ? "$db.$tbl" : $tbl; |
3559 | -} |
3560 | - |
3561 | -1; |
3562 | -} |
3563 | -# ########################################################################### |
3564 | -# End Quoter package |
3565 | +# End TableNibbler package |
3566 | # ########################################################################### |
3567 | |
3568 | # ########################################################################### |
3569 | @@ -3593,6 +2401,54 @@ |
3570 | return bless $self, $class; |
3571 | } |
3572 | |
3573 | +sub get_slaves { |
3574 | + my ($self, %args) = @_; |
3575 | + my @required_args = qw(make_cxn OptionParser DSNParser Quoter); |
3576 | + foreach my $arg ( @required_args ) { |
3577 | + die "I need a $arg argument" unless $args{$arg}; |
3578 | + } |
3579 | + my ($make_cxn, $o, $dp) = @args{@required_args}; |
3580 | + |
3581 | + my $slaves = []; |
3582 | + my $method = $o->get('recursion-method'); |
3583 | + MKDEBUG && _d('Slave recursion method:', $method); |
3584 | + if ( !$method || $method =~ m/proocesslist|hosts/i ) { |
3585 | + my @required_args = qw(dbh dsn); |
3586 | + foreach my $arg ( @required_args ) { |
3587 | + die "I need a $arg argument" unless $args{$arg}; |
3588 | + } |
3589 | + my ($dbh, $dsn) = @args{@required_args}; |
3590 | + $self->recurse_to_slaves( |
3591 | + { dbh => $dbh, |
3592 | + dsn => $dsn, |
3593 | + dsn_parser => $dp, |
3594 | + recurse => $o->get('recurse'), |
3595 | + method => $o->get('recursion-method'), |
3596 | + callback => sub { |
3597 | + my ( $dsn, $dbh, $level, $parent ) = @_; |
3598 | + return unless $level; |
3599 | + MKDEBUG && _d('Found slave:', $dp->as_string($dsn)); |
3600 | + push @$slaves, $make_cxn->(dsn => $dsn, dbh => $dbh); |
3601 | + return; |
3602 | + }, |
3603 | + } |
3604 | + ); |
3605 | + } |
3606 | + elsif ( $method =~ m/^dsn=/i ) { |
3607 | + my ($dsn_table_dsn) = $method =~ m/^dsn=(.+)/i; |
3608 | + $slaves = $self->get_cxn_from_dsn_table( |
3609 | + %args, |
3610 | + dsn_table_dsn => $dsn_table_dsn, |
3611 | + ); |
3612 | + } |
3613 | + else { |
3614 | + die "Invalid --recusion-method: $method. Valid values are: " |
3615 | + . "dsn=DSN, hosts, or processlist.\n"; |
3616 | + } |
3617 | + |
3618 | + return $slaves; |
3619 | +} |
3620 | + |
3621 | sub recurse_to_slaves { |
3622 | my ( $self, $args, $level ) = @_; |
3623 | $level ||= 0; |
3624 | @@ -4169,6 +3025,43 @@ |
3625 | return; |
3626 | } |
3627 | |
3628 | +sub get_cxn_from_dsn_table { |
3629 | + my ($self, %args) = @_; |
3630 | + my @required_args = qw(dsn_table_dsn make_cxn DSNParser Quoter); |
3631 | + foreach my $arg ( @required_args ) { |
3632 | + die "I need a $arg argument" unless $args{$arg}; |
3633 | + } |
3634 | + my ($dsn_table_dsn, $make_cxn, $dp, $q) = @args{@required_args}; |
3635 | + MKDEBUG && _d('DSN table DSN:', $dsn_table_dsn); |
3636 | + |
3637 | + my $dsn = $dp->parse($dsn_table_dsn); |
3638 | + my $dsn_table; |
3639 | + if ( $dsn->{D} && $dsn->{t} ) { |
3640 | + $dsn_table = $q->quote($dsn->{D}, $dsn->{t}); |
3641 | + } |
3642 | + elsif ( $dsn->{t} && $dsn->{t} =~ m/\./ ) { |
3643 | + $dsn_table = $q->quote($q->split_unquote($dsn->{t})); |
3644 | + } |
3645 | + else { |
3646 | + die "DSN table DSN does not specify a database (D) " |
3647 | + . "or a database-qualified table (t)"; |
3648 | + } |
3649 | + |
3650 | + my $dsn_tbl_cxn = $make_cxn->(dsn => $dsn); |
3651 | + my $dbh = $dsn_tbl_cxn->connect(); |
3652 | + my $sql = "SELECT dsn FROM $dsn_table ORDER BY id"; |
3653 | + MKDEBUG && _d($sql); |
3654 | + my $dsn_strings = $dbh->selectcol_arrayref($sql); |
3655 | + my @cxn; |
3656 | + if ( $dsn_strings ) { |
3657 | + foreach my $dsn_string ( @$dsn_strings ) { |
3658 | + MKDEBUG && _d('DSN from DSN table:', $dsn_string); |
3659 | + push @cxn, $make_cxn->(dsn_string => $dsn_string); |
3660 | + } |
3661 | + } |
3662 | + return \@cxn; |
3663 | +} |
3664 | + |
3665 | sub _d { |
3666 | my ($package, undef, $line) = caller 0; |
3667 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
3668 | @@ -4184,6 +3077,1206 @@ |
3669 | # ########################################################################### |
3670 | |
3671 | # ########################################################################### |
3672 | +# RowChecksum package |
3673 | +# This package is a copy without comments from the original. The original |
3674 | +# with comments and its test file can be found in the Bazaar repository at, |
3675 | +# lib/RowChecksum.pm |
3676 | +# t/lib/RowChecksum.t |
3677 | +# See https://launchpad.net/percona-toolkit for more information. |
3678 | +# ########################################################################### |
3679 | +{ |
3680 | +package RowChecksum; |
3681 | + |
3682 | +use strict; |
3683 | +use warnings FATAL => 'all'; |
3684 | +use English qw(-no_match_vars); |
3685 | +use constant MKDEBUG => $ENV{MKDEBUG} || 0; |
3686 | + |
3687 | +use List::Util qw(max); |
3688 | +use Data::Dumper; |
3689 | +$Data::Dumper::Indent = 1; |
3690 | +$Data::Dumper::Sortkeys = 1; |
3691 | +$Data::Dumper::Quotekeys = 0; |
3692 | + |
3693 | +sub new { |
3694 | + my ( $class, %args ) = @_; |
3695 | + foreach my $arg ( qw(OptionParser Quoter) ) { |
3696 | + die "I need a $arg argument" unless defined $args{$arg}; |
3697 | + } |
3698 | + my $self = { %args }; |
3699 | + return bless $self, $class; |
3700 | +} |
3701 | + |
3702 | +sub make_row_checksum { |
3703 | + my ( $self, %args ) = @_; |
3704 | + my @required_args = qw(tbl); |
3705 | + foreach my $arg( @required_args ) { |
3706 | + die "I need a $arg argument" unless $args{$arg}; |
3707 | + } |
3708 | + my ($tbl) = @args{@required_args}; |
3709 | + |
3710 | + my $o = $self->{OptionParser}; |
3711 | + my $q = $self->{Quoter}; |
3712 | + my $tbl_struct = $tbl->{tbl_struct}; |
3713 | + my $func = $args{func} || uc($o->get('function')); |
3714 | + my $cols = $self->get_checksum_columns(%args); |
3715 | + |
3716 | + my $query; |
3717 | + if ( !$args{no_cols} ) { |
3718 | + $query = join(', ', |
3719 | + map { |
3720 | + my $col = $_; |
3721 | + if ( $col =~ m/\+ 0/ ) { |
3722 | + my ($real_col) = /^(\S+)/; |
3723 | + $col .= " AS $real_col"; |
3724 | + } |
3725 | + elsif ( $col =~ m/TRIM/ ) { |
3726 | + my ($real_col) = m/TRIM\(([^\)]+)\)/; |
3727 | + $col .= " AS $real_col"; |
3728 | + } |
3729 | + $col; |
3730 | + } @{$cols->{select}}) |
3731 | + . ', '; |
3732 | + } |
3733 | + |
3734 | + if ( uc $func ne 'FNV_64' && uc $func ne 'FNV1A_64' ) { |
3735 | + my $sep = $o->get('separator') || '#'; |
3736 | + $sep =~ s/'//g; |
3737 | + $sep ||= '#'; |
3738 | + |
3739 | + my @nulls = grep { $cols->{allowed}->{$_} } @{$tbl_struct->{null_cols}}; |
3740 | + if ( @nulls ) { |
3741 | + my $bitmap = "CONCAT(" |
3742 | + . join(', ', map { 'ISNULL(' . $q->quote($_) . ')' } @nulls) |
3743 | + . ")"; |
3744 | + push @{$cols->{select}}, $bitmap; |
3745 | + } |
3746 | + |
3747 | + $query .= @{$cols->{select}} > 1 |
3748 | + ? "$func(CONCAT_WS('$sep', " . join(', ', @{$cols->{select}}) . '))' |
3749 | + : "$func($cols->{select}->[0])"; |
3750 | + } |
3751 | + else { |
3752 | + my $fnv_func = uc $func; |
3753 | + $query .= "$fnv_func(" . join(', ', @{$cols->{select}}) . ')'; |
3754 | + } |
3755 | + |
3756 | + MKDEBUG && _d('Row checksum:', $query); |
3757 | + return $query; |
3758 | +} |
3759 | + |
3760 | +sub make_chunk_checksum { |
3761 | + my ( $self, %args ) = @_; |
3762 | + my @required_args = qw(tbl); |
3763 | + foreach my $arg( @required_args ) { |
3764 | + die "I need a $arg argument" unless $args{$arg}; |
3765 | + } |
3766 | + if ( !$args{dbh} && !($args{func} && $args{crc_width} && $args{crc_type}) ) { |
3767 | + die "I need a dbh argument" |
3768 | + } |
3769 | + my ($tbl) = @args{@required_args}; |
3770 | + my $o = $self->{OptionParser}; |
3771 | + my $q = $self->{Quoter}; |
3772 | + |
3773 | + my %crc_args = $self->get_crc_args(%args); |
3774 | + MKDEBUG && _d("Checksum strat:", Dumper(\%crc_args)); |
3775 | + |
3776 | + my $row_checksum = $self->make_row_checksum( |
3777 | + %args, |
3778 | + %crc_args, |
3779 | + no_cols => 1 |
3780 | + ); |
3781 | + my $crc; |
3782 | + if ( $crc_args{crc_type} =~ m/int$/ ) { |
3783 | + $crc = "COALESCE(LOWER(CONV(BIT_XOR(CAST($row_checksum AS UNSIGNED)), " |
3784 | + . "10, 16)), 0)"; |
3785 | + } |
3786 | + else { |
3787 | + my $slices = $self->_make_xor_slices( |
3788 | + row_checksum => $row_checksum, |
3789 | + %crc_args, |
3790 | + ); |
3791 | + $crc = "COALESCE(LOWER(CONCAT($slices)), 0)"; |
3792 | + } |
3793 | + |
3794 | + my $select = "COUNT(*) AS cnt, $crc AS crc"; |
3795 | + MKDEBUG && _d('Chunk checksum:', $select); |
3796 | + return $select; |
3797 | +} |
3798 | + |
3799 | +sub get_checksum_columns { |
3800 | + my ($self, %args) = @_; |
3801 | + my @required_args = qw(tbl); |
3802 | + foreach my $arg( @required_args ) { |
3803 | + die "I need a $arg argument" unless $args{$arg}; |
3804 | + } |
3805 | + my ($tbl) = @args{@required_args}; |
3806 | + my $o = $self->{OptionParser}; |
3807 | + my $q = $self->{Quoter}; |
3808 | + |
3809 | + my $trim = $o->get('trim'); |
3810 | + my $float_precision = $o->get('float-precision'); |
3811 | + |
3812 | + my $tbl_struct = $tbl->{tbl_struct}; |
3813 | + my $ignore_col = $o->get('ignore-columns') || {}; |
3814 | + my $all_cols = $o->get('columns') || $tbl_struct->{cols}; |
3815 | + my %cols = map { lc($_) => 1 } grep { !$ignore_col->{$_} } @$all_cols; |
3816 | + my %seen; |
3817 | + my @cols = |
3818 | + map { |
3819 | + my $type = $tbl_struct->{type_for}->{$_}; |
3820 | + my $result = $q->quote($_); |
3821 | + if ( $type eq 'timestamp' ) { |
3822 | + $result .= ' + 0'; |
3823 | + } |
3824 | + elsif ( $float_precision && $type =~ m/float|double/ ) { |
3825 | + $result = "ROUND($result, $float_precision)"; |
3826 | + } |
3827 | + elsif ( $trim && $type =~ m/varchar/ ) { |
3828 | + $result = "TRIM($result)"; |
3829 | + } |
3830 | + $result; |
3831 | + } |
3832 | + grep { |
3833 | + $cols{$_} && !$seen{$_}++ |
3834 | + } |
3835 | + @{$tbl_struct->{cols}}; |
3836 | + |
3837 | + return { |
3838 | + select => \@cols, |
3839 | + allowed => \%cols, |
3840 | + }; |
3841 | +} |
3842 | + |
3843 | +sub get_crc_args { |
3844 | + my ($self, %args) = @_; |
3845 | + my $func = $args{func} || $self->_get_hash_func(%args); |
3846 | + my $crc_width = $args{crc_width}|| $self->_get_crc_width(%args, func=>$func); |
3847 | + my $crc_type = $args{crc_type} || $self->_get_crc_type(%args, func=>$func); |
3848 | + my $opt_slice; |
3849 | + if ( $args{dbh} && $crc_type !~ m/int$/ ) { |
3850 | + $opt_slice = $self->_optimize_xor(%args, func=>$func); |
3851 | + } |
3852 | + |
3853 | + return ( |
3854 | + func => $func, |
3855 | + crc_width => $crc_width, |
3856 | + crc_type => $crc_type, |
3857 | + opt_slice => $opt_slice, |
3858 | + ); |
3859 | +} |
3860 | + |
3861 | +sub _get_hash_func { |
3862 | + my ( $self, %args ) = @_; |
3863 | + my @required_args = qw(dbh); |
3864 | + foreach my $arg( @required_args ) { |
3865 | + die "I need a $arg argument" unless $args{$arg}; |
3866 | + } |
3867 | + my ($dbh) = @args{@required_args}; |
3868 | + my $o = $self->{OptionParser}; |
3869 | + my @funcs = qw(CRC32 FNV1A_64 FNV_64 MD5 SHA1); |
3870 | + |
3871 | + if ( my $func = $o->get('function') ) { |
3872 | + unshift @funcs, $func; |
3873 | + } |
3874 | + |
3875 | + my ($result, $error); |
3876 | + foreach my $func ( @funcs ) { |
3877 | + eval { |
3878 | + my $sql = "SELECT $func('test-string')"; |
3879 | + MKDEBUG && _d($sql); |
3880 | + $args{dbh}->do($sql); |
3881 | + }; |
3882 | + if ( $EVAL_ERROR && $EVAL_ERROR =~ m/failed: (.*?) at \S+ line/ ) { |
3883 | + $error .= qq{$func cannot be used because "$1"\n}; |
3884 | + MKDEBUG && _d($func, 'cannot be used because', $1); |
3885 | + } |
3886 | + MKDEBUG && _d('Chosen hash func:', $result); |
3887 | + return $func; |
3888 | + } |
3889 | + die $error || 'No hash functions (CRC32, MD5, etc.) are available'; |
3890 | +} |
3891 | + |
3892 | +sub _get_crc_width { |
3893 | + my ( $self, %args ) = @_; |
3894 | + my @required_args = qw(dbh func); |
3895 | + foreach my $arg( @required_args ) { |
3896 | + die "I need a $arg argument" unless $args{$arg}; |
3897 | + } |
3898 | + my ($dbh, $func) = @args{@required_args}; |
3899 | + |
3900 | + my $crc_width = 16; |
3901 | + if ( uc $func ne 'FNV_64' && uc $func ne 'FNV1A_64' ) { |
3902 | + eval { |
3903 | + my ($val) = $dbh->selectrow_array("SELECT $func('a')"); |
3904 | + $crc_width = max(16, length($val)); |
3905 | + }; |
3906 | + } |
3907 | + return $crc_width; |
3908 | +} |
3909 | + |
3910 | +sub _get_crc_type { |
3911 | + my ( $self, %args ) = @_; |
3912 | + my @required_args = qw(dbh func); |
3913 | + foreach my $arg( @required_args ) { |
3914 | + die "I need a $arg argument" unless $args{$arg}; |
3915 | + } |
3916 | + my ($dbh, $func) = @args{@required_args}; |
3917 | + |
3918 | + my $type = ''; |
3919 | + my $length = 0; |
3920 | + my $sql = "SELECT $func('a')"; |
3921 | + my $sth = $dbh->prepare($sql); |
3922 | + eval { |
3923 | + $sth->execute(); |
3924 | + $type = $sth->{mysql_type_name}->[0]; |
3925 | + $length = $sth->{mysql_length}->[0]; |
3926 | + MKDEBUG && _d($sql, $type, $length); |
3927 | + if ( $type eq 'bigint' && $length < 20 ) { |
3928 | + $type = 'int'; |
3929 | + } |
3930 | + }; |
3931 | + $sth->finish; |
3932 | + MKDEBUG && _d('crc_type:', $type, 'length:', $length); |
3933 | + return $type; |
3934 | +} |
3935 | + |
3936 | +sub _optimize_xor { |
3937 | + my ( $self, %args ) = @_; |
3938 | + my @required_args = qw(dbh func); |
3939 | + foreach my $arg( @required_args ) { |
3940 | + die "I need a $arg argument" unless $args{$arg}; |
3941 | + } |
3942 | + my ($dbh, $func) = @args{@required_args}; |
3943 | + |
3944 | + die "$func never needs BIT_XOR optimization" |
3945 | + if $func =~ m/^(?:FNV1A_64|FNV_64|CRC32)$/i; |
3946 | + |
3947 | + my $opt_slice = 0; |
3948 | + my $unsliced = uc $dbh->selectall_arrayref("SELECT $func('a')")->[0]->[0]; |
3949 | + my $sliced = ''; |
3950 | + my $start = 1; |
3951 | + my $crc_width = length($unsliced) < 16 ? 16 : length($unsliced); |
3952 | + |
3953 | + do { # Try different positions till sliced result equals non-sliced. |
3954 | + MKDEBUG && _d('Trying slice', $opt_slice); |
3955 | + $dbh->do('SET @crc := "", @cnt := 0'); |
3956 | + my $slices = $self->_make_xor_slices( |
3957 | + row_checksum => "\@crc := $func('a')", |
3958 | + crc_width => $crc_width, |
3959 | + opt_slice => $opt_slice, |
3960 | + ); |
3961 | + |
3962 | + my $sql = "SELECT CONCAT($slices) AS TEST FROM (SELECT NULL) AS x"; |
3963 | + $sliced = ($dbh->selectrow_array($sql))[0]; |
3964 | + if ( $sliced ne $unsliced ) { |
3965 | + MKDEBUG && _d('Slice', $opt_slice, 'does not work'); |
3966 | + $start += 16; |
3967 | + ++$opt_slice; |
3968 | + } |
3969 | + } while ( $start < $crc_width && $sliced ne $unsliced ); |
3970 | + |
3971 | + if ( $sliced eq $unsliced ) { |
3972 | + MKDEBUG && _d('Slice', $opt_slice, 'works'); |
3973 | + return $opt_slice; |
3974 | + } |
3975 | + else { |
3976 | + MKDEBUG && _d('No slice works'); |
3977 | + return undef; |
3978 | + } |
3979 | +} |
3980 | + |
3981 | +sub _make_xor_slices { |
3982 | + my ( $self, %args ) = @_; |
3983 | + my @required_args = qw(row_checksum crc_width); |
3984 | + foreach my $arg( @required_args ) { |
3985 | + die "I need a $arg argument" unless $args{$arg}; |
3986 | + } |
3987 | + my ($row_checksum, $crc_width) = @args{@required_args}; |
3988 | + my ($opt_slice) = $args{opt_slice}; |
3989 | + |
3990 | + my @slices; |
3991 | + for ( my $start = 1; $start <= $crc_width; $start += 16 ) { |
3992 | + my $len = $crc_width - $start + 1; |
3993 | + if ( $len > 16 ) { |
3994 | + $len = 16; |
3995 | + } |
3996 | + push @slices, |
3997 | + "LPAD(CONV(BIT_XOR(" |
3998 | + . "CAST(CONV(SUBSTRING(\@crc, $start, $len), 16, 10) AS UNSIGNED))" |
3999 | + . ", 10, 16), $len, '0')"; |
4000 | + } |
4001 | + |
4002 | + if ( defined $opt_slice && $opt_slice < @slices ) { |
4003 | + $slices[$opt_slice] =~ s/\@crc/\@crc := $row_checksum/; |
4004 | + } |
4005 | + else { |
4006 | + map { s/\@crc/$row_checksum/ } @slices; |
4007 | + } |
4008 | + |
4009 | + return join(', ', @slices); |
4010 | +} |
4011 | + |
4012 | +sub find_replication_differences { |
4013 | + my ($self, %args) = @_; |
4014 | + my @required_args = qw(dbh repl_table); |
4015 | + foreach my $arg( @required_args ) { |
4016 | + die "I need a $arg argument" unless $args{$arg}; |
4017 | + } |
4018 | + my ($dbh, $repl_table) = @args{@required_args}; |
4019 | + |
4020 | + my $sql |
4021 | + = "SELECT CONCAT(db, '.', tbl) AS `table`, " |
4022 | + . "chunk, chunk_index, lower_boundary, upper_boundary, " |
4023 | + . "COALESCE(this_cnt-master_cnt, 0) AS cnt_diff, " |
4024 | + . "COALESCE(" |
4025 | + . "this_crc <> master_crc OR ISNULL(master_crc) <> ISNULL(this_crc), 0" |
4026 | + . ") AS crc_diff, this_cnt, master_cnt, this_crc, master_crc " |
4027 | + . "FROM $repl_table " |
4028 | + . "WHERE (master_cnt <> this_cnt OR master_crc <> this_crc " |
4029 | + . "OR ISNULL(master_crc) <> ISNULL(this_crc))" |
4030 | + . ($args{where} ? " AND ($args{where})" : ""); |
4031 | + MKDEBUG && _d($sql); |
4032 | + my $diffs = $dbh->selectall_arrayref($sql, { Slice => {} }); |
4033 | + return $diffs; |
4034 | +} |
4035 | + |
4036 | +sub _d { |
4037 | + my ($package, undef, $line) = caller 0; |
4038 | + @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
4039 | + map { defined $_ ? $_ : 'undef' } |
4040 | + @_; |
4041 | + print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; |
4042 | +} |
4043 | + |
4044 | +1; |
4045 | +} |
4046 | +# ########################################################################### |
4047 | +# End RowChecksum package |
4048 | +# ########################################################################### |
4049 | + |
4050 | +# ########################################################################### |
4051 | +# NibbleIterator package |
4052 | +# This package is a copy without comments from the original. The original |
4053 | +# with comments and its test file can be found in the Bazaar repository at, |
4054 | +# lib/NibbleIterator.pm |
4055 | +# t/lib/NibbleIterator.t |
4056 | +# See https://launchpad.net/percona-toolkit for more information. |
4057 | +# ########################################################################### |
4058 | +{ |
4059 | +package NibbleIterator; |
4060 | + |
4061 | +use strict; |
4062 | +use warnings FATAL => 'all'; |
4063 | +use English qw(-no_match_vars); |
4064 | +use constant MKDEBUG => $ENV{MKDEBUG} || 0; |
4065 | + |
4066 | +use Data::Dumper; |
4067 | +$Data::Dumper::Indent = 1; |
4068 | +$Data::Dumper::Sortkeys = 1; |
4069 | +$Data::Dumper::Quotekeys = 0; |
4070 | + |
4071 | +sub new { |
4072 | + my ( $class, %args ) = @_; |
4073 | + my @required_args = qw(Cxn tbl chunk_size OptionParser Quoter TableNibbler TableParser); |
4074 | + foreach my $arg ( @required_args ) { |
4075 | + die "I need a $arg argument" unless $args{$arg}; |
4076 | + } |
4077 | + my ($cxn, $tbl, $chunk_size, $o, $q) = @args{@required_args}; |
4078 | + |
4079 | + my $where = $o->get('where'); |
4080 | + my ($row_est, $mysql_index) = get_row_estimate(%args, where => $where); |
4081 | + my $one_nibble = !defined $args{one_nibble} || $args{one_nibble} |
4082 | + ? $row_est <= $chunk_size * $o->get('chunk-size-limit') |
4083 | + : 0; |
4084 | + MKDEBUG && _d('One nibble:', $one_nibble ? 'yes' : 'no'); |
4085 | + |
4086 | + if ( $args{resume} |
4087 | + && !defined $args{resume}->{lower_boundary} |
4088 | + && !defined $args{resume}->{upper_boundary} ) { |
4089 | + MKDEBUG && _d('Resuming from one nibble table'); |
4090 | + $one_nibble = 1; |
4091 | + } |
4092 | + |
4093 | + my $index = _find_best_index(%args, mysql_index => $mysql_index); |
4094 | + if ( !$index && !$one_nibble ) { |
4095 | + die "There is no good index and the table is oversized."; |
4096 | + } |
4097 | + |
4098 | + my $tbl_struct = $tbl->{tbl_struct}; |
4099 | + my $ignore_col = $o->get('ignore-columns') || {}; |
4100 | + my $all_cols = $o->get('columns') || $tbl_struct->{cols}; |
4101 | + my @cols = grep { !$ignore_col->{$_} } @$all_cols; |
4102 | + my $self; |
4103 | + if ( $one_nibble ) { |
4104 | + my $nibble_sql |
4105 | + = ($args{dml} ? "$args{dml} " : "SELECT ") |
4106 | + . ($args{select} ? $args{select} |
4107 | + : join(', ', map { $q->quote($_) } @cols)) |
4108 | + . " FROM " . $q->quote(@{$tbl}{qw(db tbl)}) |
4109 | + . ($where ? " WHERE $where" : '') |
4110 | + . " /*checksum table*/"; |
4111 | + MKDEBUG && _d('One nibble statement:', $nibble_sql); |
4112 | + |
4113 | + my $explain_nibble_sql |
4114 | + = "EXPLAIN SELECT " |
4115 | + . ($args{select} ? $args{select} |
4116 | + : join(', ', map { $q->quote($_) } @cols)) |
4117 | + . " FROM " . $q->quote(@{$tbl}{qw(db tbl)}) |
4118 | + . ($where ? " WHERE $where" : '') |
4119 | + . " /*explain checksum table*/"; |
4120 | + MKDEBUG && _d('Explain one nibble statement:', $explain_nibble_sql); |
4121 | + |
4122 | + $self = { |
4123 | + %args, |
4124 | + one_nibble => 1, |
4125 | + limit => 0, |
4126 | + nibble_sql => $nibble_sql, |
4127 | + explain_nibble_sql => $explain_nibble_sql, |
4128 | + }; |
4129 | + } |
4130 | + else { |
4131 | + my $index_cols = $tbl->{tbl_struct}->{keys}->{$index}->{cols}; |
4132 | + |
4133 | + my $asc = $args{TableNibbler}->generate_asc_stmt( |
4134 | + %args, |
4135 | + tbl_struct => $tbl->{tbl_struct}, |
4136 | + index => $index, |
4137 | + cols => \@cols, |
4138 | + asc_only => 1, |
4139 | + ); |
4140 | + MKDEBUG && _d('Ascend params:', Dumper($asc)); |
4141 | + |
4142 | + my $from = $q->quote(@{$tbl}{qw(db tbl)}) . " FORCE INDEX(`$index`)"; |
4143 | + my $order_by = join(', ', map {$q->quote($_)} @{$index_cols}); |
4144 | + |
4145 | + my $first_lb_sql |
4146 | + = "SELECT /*!40001 SQL_NO_CACHE */ " |
4147 | + . join(', ', map { $q->quote($_) } @{$asc->{scols}}) |
4148 | + . " FROM $from" |
4149 | + . ($where ? " WHERE $where" : '') |
4150 | + . " ORDER BY $order_by" |
4151 | + . " LIMIT 1" |
4152 | + . " /*first lower boundary*/"; |
4153 | + MKDEBUG && _d('First lower boundary statement:', $first_lb_sql); |
4154 | + |
4155 | + my $resume_lb_sql; |
4156 | + if ( $args{resume} ) { |
4157 | + $resume_lb_sql |
4158 | + = "SELECT /*!40001 SQL_NO_CACHE */ " |
4159 | + . join(', ', map { $q->quote($_) } @{$asc->{scols}}) |
4160 | + . " FROM $from" |
4161 | + . " WHERE " . $asc->{boundaries}->{'>'} |
4162 | + . ($where ? " AND ($where)" : '') |
4163 | + . " ORDER BY $order_by" |
4164 | + . " LIMIT 1" |
4165 | + . " /*resume lower boundary*/"; |
4166 | + MKDEBUG && _d('Resume lower boundary statement:', $resume_lb_sql); |
4167 | + } |
4168 | + |
4169 | + my $last_ub_sql |
4170 | + = "SELECT /*!40001 SQL_NO_CACHE */ " |
4171 | + . join(', ', map { $q->quote($_) } @{$asc->{scols}}) |
4172 | + . " FROM $from" |
4173 | + . ($where ? " WHERE $where" : '') |
4174 | + . " ORDER BY " |
4175 | + . join(' DESC, ', map {$q->quote($_)} @{$index_cols}) . ' DESC' |
4176 | + . " LIMIT 1" |
4177 | + . " /*last upper boundary*/"; |
4178 | + MKDEBUG && _d('Last upper boundary statement:', $last_ub_sql); |
4179 | + |
4180 | + my $ub_sql |
4181 | + = "SELECT /*!40001 SQL_NO_CACHE */ " |
4182 | + . join(', ', map { $q->quote($_) } @{$asc->{scols}}) |
4183 | + . " FROM $from" |
4184 | + . " WHERE " . $asc->{boundaries}->{'>='} |
4185 | + . ($where ? " AND ($where)" : '') |
4186 | + . " ORDER BY $order_by" |
4187 | + . " LIMIT ?, 2" |
4188 | + . " /*next chunk boundary*/"; |
4189 | + MKDEBUG && _d('Upper boundary statement:', $ub_sql); |
4190 | + |
4191 | + my $nibble_sql |
4192 | + = ($args{dml} ? "$args{dml} " : "SELECT ") |
4193 | + . ($args{select} ? $args{select} |
4194 | + : join(', ', map { $q->quote($_) } @{$asc->{cols}})) |
4195 | + . " FROM $from" |
4196 | + . " WHERE " . $asc->{boundaries}->{'>='} # lower boundary |
4197 | + . " AND " . $asc->{boundaries}->{'<='} # upper boundary |
4198 | + . ($where ? " AND ($where)" : '') |
4199 | + . ($args{order_by} ? " ORDER BY $order_by" : "") |
4200 | + . " /*checksum chunk*/"; |
4201 | + MKDEBUG && _d('Nibble statement:', $nibble_sql); |
4202 | + |
4203 | + my $explain_nibble_sql |
4204 | + = "EXPLAIN SELECT " |
4205 | + . ($args{select} ? $args{select} |
4206 | + : join(', ', map { $q->quote($_) } @{$asc->{cols}})) |
4207 | + . " FROM $from" |
4208 | + . " WHERE " . $asc->{boundaries}->{'>='} # lower boundary |
4209 | + . " AND " . $asc->{boundaries}->{'<='} # upper boundary |
4210 | + . ($where ? " AND ($where)" : '') |
4211 | + . ($args{order_by} ? " ORDER BY $order_by" : "") |
4212 | + . " /*explain checksum chunk*/"; |
4213 | + MKDEBUG && _d('Explain nibble statement:', $explain_nibble_sql); |
4214 | + |
4215 | + my $limit = $chunk_size - 1; |
4216 | + MKDEBUG && _d('Initial chunk size (LIMIT):', $limit); |
4217 | + |
4218 | + $self = { |
4219 | + %args, |
4220 | + index => $index, |
4221 | + limit => $limit, |
4222 | + first_lb_sql => $first_lb_sql, |
4223 | + last_ub_sql => $last_ub_sql, |
4224 | + ub_sql => $ub_sql, |
4225 | + nibble_sql => $nibble_sql, |
4226 | + explain_ub_sql => "EXPLAIN $ub_sql", |
4227 | + explain_nibble_sql => $explain_nibble_sql, |
4228 | + resume_lb_sql => $resume_lb_sql, |
4229 | + sql => { |
4230 | + columns => $asc->{scols}, |
4231 | + from => $from, |
4232 | + where => $where, |
4233 | + boundaries => $asc->{boundaries}, |
4234 | + order_by => $order_by, |
4235 | + }, |
4236 | + }; |
4237 | + } |
4238 | + |
4239 | + $self->{row_est} = $row_est; |
4240 | + $self->{nibbleno} = 0; |
4241 | + $self->{have_rows} = 0; |
4242 | + $self->{rowno} = 0; |
4243 | + $self->{oktonibble} = 1; |
4244 | + |
4245 | + return bless $self, $class; |
4246 | +} |
4247 | + |
4248 | +sub next { |
4249 | + my ($self) = @_; |
4250 | + |
4251 | + if ( !$self->{oktonibble} ) { |
4252 | + MKDEBUG && _d('Not ok to nibble'); |
4253 | + return; |
4254 | + } |
4255 | + |
4256 | + my %callback_args = ( |
4257 | + Cxn => $self->{Cxn}, |
4258 | + tbl => $self->{tbl}, |
4259 | + NibbleIterator => $self, |
4260 | + ); |
4261 | + |
4262 | + if ($self->{nibbleno} == 0) { |
4263 | + $self->_prepare_sths(); |
4264 | + $self->_get_bounds(); |
4265 | + if ( my $callback = $self->{callbacks}->{init} ) { |
4266 | + $self->{oktonibble} = $callback->(%callback_args); |
4267 | + MKDEBUG && _d('init callback returned', $self->{oktonibble}); |
4268 | + if ( !$self->{oktonibble} ) { |
4269 | + $self->{no_more_boundaries} = 1; |
4270 | + return; |
4271 | + } |
4272 | + } |
4273 | + } |
4274 | + |
4275 | + NIBBLE: |
4276 | + while ( $self->{have_rows} || $self->_next_boundaries() ) { |
4277 | + if ( !$self->{have_rows} ) { |
4278 | + $self->{nibbleno}++; |
4279 | + MKDEBUG && _d($self->{nibble_sth}->{Statement}, 'params:', |
4280 | + join(', ', (@{$self->{lower}}, @{$self->{upper}}))); |
4281 | + if ( my $callback = $self->{callbacks}->{exec_nibble} ) { |
4282 | + $self->{have_rows} = $callback->(%callback_args); |
4283 | + } |
4284 | + else { |
4285 | + $self->{nibble_sth}->execute(@{$self->{lower}}, @{$self->{upper}}); |
4286 | + $self->{have_rows} = $self->{nibble_sth}->rows(); |
4287 | + } |
4288 | + MKDEBUG && _d($self->{have_rows}, 'rows in nibble', $self->{nibbleno}); |
4289 | + } |
4290 | + |
4291 | + if ( $self->{have_rows} ) { |
4292 | + my $row = $self->{nibble_sth}->fetchrow_arrayref(); |
4293 | + if ( $row ) { |
4294 | + $self->{rowno}++; |
4295 | + MKDEBUG && _d('Row', $self->{rowno}, 'in nibble',$self->{nibbleno}); |
4296 | + return [ @$row ]; |
4297 | + } |
4298 | + } |
4299 | + |
4300 | + MKDEBUG && _d('No rows in nibble or nibble skipped'); |
4301 | + if ( my $callback = $self->{callbacks}->{after_nibble} ) { |
4302 | + $callback->(%callback_args); |
4303 | + } |
4304 | + $self->{rowno} = 0; |
4305 | + $self->{have_rows} = 0; |
4306 | + } |
4307 | + |
4308 | + MKDEBUG && _d('Done nibbling'); |
4309 | + if ( my $callback = $self->{callbacks}->{done} ) { |
4310 | + $callback->(%callback_args); |
4311 | + } |
4312 | + |
4313 | + return; |
4314 | +} |
4315 | + |
4316 | +sub nibble_number { |
4317 | + my ($self) = @_; |
4318 | + return $self->{nibbleno}; |
4319 | +} |
4320 | + |
4321 | +sub set_nibble_number { |
4322 | + my ($self, $n) = @_; |
4323 | + die "I need a number" unless $n; |
4324 | + $self->{nibbleno} = $n; |
4325 | + MKDEBUG && _d('Set new nibble number:', $n); |
4326 | + return; |
4327 | +} |
4328 | + |
4329 | +sub nibble_index { |
4330 | + my ($self) = @_; |
4331 | + return $self->{index}; |
4332 | +} |
4333 | + |
4334 | +sub statements { |
4335 | + my ($self) = @_; |
4336 | + return { |
4337 | + nibble => $self->{nibble_sth}, |
4338 | + explain_nibble => $self->{explain_nibble_sth}, |
4339 | + upper_boundary => $self->{ub_sth}, |
4340 | + explain_upper_boundary => $self->{explain_ub_sth}, |
4341 | + } |
4342 | +} |
4343 | + |
4344 | +sub boundaries { |
4345 | + my ($self) = @_; |
4346 | + return { |
4347 | + first_lower => $self->{first_lower}, |
4348 | + lower => $self->{lower}, |
4349 | + upper => $self->{upper}, |
4350 | + next_lower => $self->{next_lower}, |
4351 | + last_upper => $self->{last_upper}, |
4352 | + }; |
4353 | +} |
4354 | + |
4355 | +sub set_boundary { |
4356 | + my ($self, $boundary, $values) = @_; |
4357 | + die "I need a boundary parameter" |
4358 | + unless $boundary; |
4359 | + die "Invalid boundary: $boundary" |
4360 | + unless $boundary =~ m/^(?:lower|upper|next_lower|last_upper)$/; |
4361 | + die "I need a values arrayref parameter" |
4362 | + unless $values && ref $values eq 'ARRAY'; |
4363 | + $self->{$boundary} = $values; |
4364 | + MKDEBUG && _d('Set new', $boundary, 'boundary:', Dumper($values)); |
4365 | + return; |
4366 | +} |
4367 | + |
4368 | +sub one_nibble { |
4369 | + my ($self) = @_; |
4370 | + return $self->{one_nibble}; |
4371 | +} |
4372 | + |
4373 | +sub chunk_size { |
4374 | + my ($self) = @_; |
4375 | + return $self->{limit} + 1; |
4376 | +} |
4377 | + |
4378 | +sub set_chunk_size { |
4379 | + my ($self, $limit) = @_; |
4380 | + return if $self->{one_nibble}; |
4381 | + die "Chunk size must be > 0" unless $limit; |
4382 | + $self->{limit} = $limit - 1; |
4383 | + MKDEBUG && _d('Set new chunk size (LIMIT):', $limit); |
4384 | + return; |
4385 | +} |
4386 | + |
4387 | +sub sql { |
4388 | + my ($self) = @_; |
4389 | + return $self->{sql}; |
4390 | +} |
4391 | + |
4392 | +sub more_boundaries { |
4393 | + my ($self) = @_; |
4394 | + return !$self->{no_more_boundaries}; |
4395 | +} |
4396 | + |
4397 | +sub row_estimate { |
4398 | + my ($self) = @_; |
4399 | + return $self->{row_est}; |
4400 | +} |
4401 | + |
4402 | +sub _find_best_index { |
4403 | + my (%args) = @_; |
4404 | + my @required_args = qw(Cxn tbl TableParser); |
4405 | + my ($cxn, $tbl, $tp) = @args{@required_args}; |
4406 | + my $tbl_struct = $tbl->{tbl_struct}; |
4407 | + my $indexes = $tbl_struct->{keys}; |
4408 | + |
4409 | + my $want_index = $args{chunk_index}; |
4410 | + if ( $want_index ) { |
4411 | + MKDEBUG && _d('User wants to use index', $want_index); |
4412 | + if ( !exists $indexes->{$want_index} ) { |
4413 | + MKDEBUG && _d('Cannot use user index because it does not exist'); |
4414 | + $want_index = undef; |
4415 | + } |
4416 | + } |
4417 | + |
4418 | + if ( !$want_index && $args{mysql_index} ) { |
4419 | + MKDEBUG && _d('MySQL wants to use index', $args{mysql_index}); |
4420 | + $want_index = $args{mysql_index}; |
4421 | + } |
4422 | + |
4423 | + my $best_index; |
4424 | + my @possible_indexes; |
4425 | + if ( $want_index ) { |
4426 | + if ( $indexes->{$want_index}->{is_unique} ) { |
4427 | + MKDEBUG && _d('Will use wanted index'); |
4428 | + $best_index = $want_index; |
4429 | + } |
4430 | + else { |
4431 | + MKDEBUG && _d('Wanted index is a possible index'); |
4432 | + push @possible_indexes, $want_index; |
4433 | + } |
4434 | + } |
4435 | + else { |
4436 | + MKDEBUG && _d('Auto-selecting best index'); |
4437 | + foreach my $index ( $tp->sort_indexes($tbl_struct) ) { |
4438 | + if ( $index eq 'PRIMARY' || $indexes->{$index}->{is_unique} ) { |
4439 | + $best_index = $index; |
4440 | + last; |
4441 | + } |
4442 | + else { |
4443 | + push @possible_indexes, $index; |
4444 | + } |
4445 | + } |
4446 | + } |
4447 | + |
4448 | + if ( !$best_index && @possible_indexes ) { |
4449 | + MKDEBUG && _d('No PRIMARY or unique indexes;', |
4450 | + 'will use index with highest cardinality'); |
4451 | + foreach my $index ( @possible_indexes ) { |
4452 | + $indexes->{$index}->{cardinality} = _get_index_cardinality( |
4453 | + %args, |
4454 | + index => $index, |
4455 | + ); |
4456 | + } |
4457 | + @possible_indexes = sort { |
4458 | + my $cmp |
4459 | + = $indexes->{$b}->{cardinality} <=> $indexes->{$b}->{cardinality}; |
4460 | + if ( $cmp == 0 ) { |
4461 | + $cmp = scalar @{$indexes->{$b}->{cols}} |
4462 | + <=> scalar @{$indexes->{$a}->{cols}}; |
4463 | + } |
4464 | + $cmp; |
4465 | + } @possible_indexes; |
4466 | + $best_index = $possible_indexes[0]; |
4467 | + } |
4468 | + |
4469 | + MKDEBUG && _d('Best index:', $best_index); |
4470 | + return $best_index; |
4471 | +} |
4472 | + |
4473 | +sub _get_index_cardinality { |
4474 | + my (%args) = @_; |
4475 | + my @required_args = qw(Cxn tbl index Quoter); |
4476 | + my ($cxn, $tbl, $index, $q) = @args{@required_args}; |
4477 | + |
4478 | + my $sql = "SHOW INDEXES FROM " . $q->quote(@{$tbl}{qw(db tbl)}) |
4479 | + . " WHERE Key_name = '$index'"; |
4480 | + MKDEBUG && _d($sql); |
4481 | + my $cardinality = 1; |
4482 | + my $rows = $cxn->dbh()->selectall_hashref($sql, 'key_name'); |
4483 | + foreach my $row ( values %$rows ) { |
4484 | + $cardinality *= $row->{cardinality} if $row->{cardinality}; |
4485 | + } |
4486 | + MKDEBUG && _d('Index', $index, 'cardinality:', $cardinality); |
4487 | + return $cardinality; |
4488 | +} |
4489 | + |
4490 | +sub get_row_estimate { |
4491 | + my (%args) = @_; |
4492 | + my @required_args = qw(Cxn tbl OptionParser TableParser Quoter); |
4493 | + my ($cxn, $tbl, $o, $tp, $q) = @args{@required_args}; |
4494 | + |
4495 | + if ( $args{where} ) { |
4496 | + MKDEBUG && _d('WHERE clause, using explain plan for row estimate'); |
4497 | + my $table = $q->quote(@{$tbl}{qw(db tbl)}); |
4498 | + my $sql = "EXPLAIN SELECT * FROM $table WHERE $args{where}"; |
4499 | + MKDEBUG && _d($sql); |
4500 | + my $expl = $cxn->dbh()->selectrow_hashref($sql); |
4501 | + MKDEBUG && _d(Dumper($expl)); |
4502 | + return ($expl->{rows} || 0), $expl->{key}; |
4503 | + } |
4504 | + else { |
4505 | + MKDEBUG && _d('No WHERE clause, using table status for row estimate'); |
4506 | + return $tbl->{tbl_status}->{rows} || 0; |
4507 | + } |
4508 | +} |
4509 | + |
4510 | +sub _prepare_sths { |
4511 | + my ($self) = @_; |
4512 | + MKDEBUG && _d('Preparing statement handles'); |
4513 | + |
4514 | + my $dbh = $self->{Cxn}->dbh(); |
4515 | + |
4516 | + $self->{nibble_sth} = $dbh->prepare($self->{nibble_sql}); |
4517 | + $self->{explain_nibble_sth} = $dbh->prepare($self->{explain_nibble_sql}); |
4518 | + |
4519 | + if ( !$self->{one_nibble} ) { |
4520 | + $self->{ub_sth} = $dbh->prepare($self->{ub_sql}); |
4521 | + $self->{explain_ub_sth} = $dbh->prepare($self->{explain_ub_sql}); |
4522 | + } |
4523 | + |
4524 | + return; |
4525 | +} |
4526 | + |
4527 | +sub _get_bounds { |
4528 | + my ($self) = @_; |
4529 | + |
4530 | + if ( $self->{one_nibble} ) { |
4531 | + if ( $self->{resume} ) { |
4532 | + $self->{no_more_boundaries} = 1; |
4533 | + } |
4534 | + return; |
4535 | + } |
4536 | + |
4537 | + my $dbh = $self->{Cxn}->dbh(); |
4538 | + |
4539 | + $self->{first_lower} = $dbh->selectrow_arrayref($self->{first_lb_sql}); |
4540 | + MKDEBUG && _d('First lower boundary:', Dumper($self->{first_lower})); |
4541 | + |
4542 | + if ( my $nibble = $self->{resume} ) { |
4543 | + if ( defined $nibble->{lower_boundary} |
4544 | + && defined $nibble->{upper_boundary} ) { |
4545 | + my $sth = $dbh->prepare($self->{resume_lb_sql}); |
4546 | + my @ub = split ',', $nibble->{upper_boundary}; |
4547 | + MKDEBUG && _d($sth->{Statement}, 'params:', @ub); |
4548 | + $sth->execute(@ub); |
4549 | + $self->{next_lower} = $sth->fetchrow_arrayref(); |
4550 | + $sth->finish(); |
4551 | + } |
4552 | + } |
4553 | + else { |
4554 | + $self->{next_lower} = $self->{first_lower}; |
4555 | + } |
4556 | + MKDEBUG && _d('Next lower boundary:', Dumper($self->{next_lower})); |
4557 | + |
4558 | + if ( !$self->{next_lower} ) { |
4559 | + MKDEBUG && _d('At end of table, or no more boundaries to resume'); |
4560 | + $self->{no_more_boundaries} = 1; |
4561 | + } |
4562 | + |
4563 | + $self->{last_upper} = $dbh->selectrow_arrayref($self->{last_ub_sql}); |
4564 | + MKDEBUG && _d('Last upper boundary:', Dumper($self->{last_upper})); |
4565 | + |
4566 | + return; |
4567 | +} |
4568 | + |
4569 | +sub _next_boundaries { |
4570 | + my ($self) = @_; |
4571 | + |
4572 | + if ( $self->{no_more_boundaries} ) { |
4573 | + MKDEBUG && _d('No more boundaries'); |
4574 | + return; # stop nibbling |
4575 | + } |
4576 | + |
4577 | + if ( $self->{one_nibble} ) { |
4578 | + $self->{lower} = $self->{upper} = []; |
4579 | + $self->{no_more_boundaries} = 1; # for next call |
4580 | + return 1; # continue nibbling |
4581 | + } |
4582 | + |
4583 | + if ( $self->identical_boundaries($self->{lower}, $self->{next_lower}) ) { |
4584 | + MKDEBUG && _d('Infinite loop detected'); |
4585 | + my $tbl = $self->{tbl}; |
4586 | + my $index = $tbl->{tbl_struct}->{keys}->{$self->{index}}; |
4587 | + my $n_cols = scalar @{$index->{cols}}; |
4588 | + my $chunkno = $self->{nibbleno}; |
4589 | + die "Possible infinite loop detected! " |
4590 | + . "The lower boundary for chunk $chunkno is " |
4591 | + . "<" . join(', ', @{$self->{lower}}) . "> and the lower " |
4592 | + . "boundary for chunk " . ($chunkno + 1) . " is also " |
4593 | + . "<" . join(', ', @{$self->{next_lower}}) . ">. " |
4594 | + . "This usually happens when using a non-unique single " |
4595 | + . "column index. The current chunk index for table " |
4596 | + . "$tbl->{db}.$tbl->{tbl} is $self->{index} which is" |
4597 | + . ($index->{is_unique} ? '' : ' not') . " unique and covers " |
4598 | + . ($n_cols > 1 ? "$n_cols columns" : "1 column") . ".\n"; |
4599 | + } |
4600 | + $self->{lower} = $self->{next_lower}; |
4601 | + |
4602 | + if ( my $callback = $self->{callbacks}->{next_boundaries} ) { |
4603 | + my $oktonibble = $callback->( |
4604 | + Cxn => $self->{Cxn}, |
4605 | + tbl => $self->{tbl}, |
4606 | + NibbleIterator => $self, |
4607 | + ); |
4608 | + MKDEBUG && _d('next_boundaries callback returned', $oktonibble); |
4609 | + if ( !$oktonibble ) { |
4610 | + $self->{no_more_boundaries} = 1; |
4611 | + return; # stop nibbling |
4612 | + } |
4613 | + } |
4614 | + |
4615 | + MKDEBUG && _d($self->{ub_sth}->{Statement}, 'params:', |
4616 | + join(', ', @{$self->{lower}}), $self->{limit}); |
4617 | + $self->{ub_sth}->execute(@{$self->{lower}}, $self->{limit}); |
4618 | + my $boundary = $self->{ub_sth}->fetchall_arrayref(); |
4619 | + MKDEBUG && _d('Next boundary:', Dumper($boundary)); |
4620 | + if ( $boundary && @$boundary ) { |
4621 | + $self->{upper} = $boundary->[0]; # this nibble |
4622 | + if ( $boundary->[1] ) { |
4623 | + $self->{next_lower} = $boundary->[1]; # next nibble |
4624 | + } |
4625 | + else { |
4626 | + $self->{no_more_boundaries} = 1; # for next call |
4627 | + MKDEBUG && _d('Last upper boundary:', Dumper($boundary->[0])); |
4628 | + } |
4629 | + } |
4630 | + else { |
4631 | + $self->{no_more_boundaries} = 1; # for next call |
4632 | + $self->{upper} = $self->{last_upper}; |
4633 | + MKDEBUG && _d('Last upper boundary:', Dumper($self->{upper})); |
4634 | + } |
4635 | + $self->{ub_sth}->finish(); |
4636 | + |
4637 | + return 1; # continue nibbling |
4638 | +} |
4639 | + |
4640 | +sub identical_boundaries { |
4641 | + my ($self, $b1, $b2) = @_; |
4642 | + |
4643 | + return 0 if ($b1 && !$b2) || (!$b1 && $b2); |
4644 | + |
4645 | + return 1 if !$b1 && !$b2; |
4646 | + |
4647 | + die "Boundaries have different numbers of values" |
4648 | + if scalar @$b1 != scalar @$b2; # shouldn't happen |
4649 | + my $n_vals = scalar @$b1; |
4650 | + for my $i ( 0..($n_vals-1) ) { |
4651 | + return 0 if $b1->[$i] ne $b2->[$i]; # diff |
4652 | + } |
4653 | + return 1; |
4654 | +} |
4655 | + |
4656 | +sub DESTROY { |
4657 | + my ( $self ) = @_; |
4658 | + foreach my $key ( keys %$self ) { |
4659 | + if ( $key =~ m/_sth$/ ) { |
4660 | + MKDEBUG && _d('Finish', $key); |
4661 | + $self->{$key}->finish(); |
4662 | + } |
4663 | + } |
4664 | + return; |
4665 | +} |
4666 | + |
4667 | +sub _d { |
4668 | + my ($package, undef, $line) = caller 0; |
4669 | + @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
4670 | + map { defined $_ ? $_ : 'undef' } |
4671 | + @_; |
4672 | + print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; |
4673 | +} |
4674 | + |
4675 | +1; |
4676 | +} |
4677 | +# ########################################################################### |
4678 | +# End NibbleIterator package |
4679 | +# ########################################################################### |
4680 | + |
4681 | +# ########################################################################### |
4682 | +# OobNibbleIterator package |
4683 | +# This package is a copy without comments from the original. The original |
4684 | +# with comments and its test file can be found in the Bazaar repository at, |
4685 | +# lib/OobNibbleIterator.pm |
4686 | +# t/lib/OobNibbleIterator.t |
4687 | +# See https://launchpad.net/percona-toolkit for more information. |
4688 | +# ########################################################################### |
4689 | +{ |
4690 | +package OobNibbleIterator; |
4691 | +use base 'NibbleIterator'; |
4692 | + |
4693 | +use strict; |
4694 | +use warnings FATAL => 'all'; |
4695 | +use English qw(-no_match_vars); |
4696 | +use constant MKDEBUG => $ENV{MKDEBUG} || 0; |
4697 | + |
4698 | +use Data::Dumper; |
4699 | +$Data::Dumper::Indent = 1; |
4700 | +$Data::Dumper::Sortkeys = 1; |
4701 | +$Data::Dumper::Quotekeys = 0; |
4702 | + |
4703 | +sub new { |
4704 | + my ( $class, %args ) = @_; |
4705 | + my @required_args = qw(); |
4706 | + foreach my $arg ( @required_args ) { |
4707 | + die "I need a $arg argument" unless $args{$arg}; |
4708 | + } |
4709 | + |
4710 | + my $self = $class->SUPER::new(%args); |
4711 | + |
4712 | + my $q = $self->{Quoter}; |
4713 | + my $o = $self->{OptionParser}; |
4714 | + my $where = $o->get('where'); |
4715 | + |
4716 | + if ( !$self->one_nibble() ) { |
4717 | + my $head_sql |
4718 | + = ($args{past_dml} || "SELECT ") |
4719 | + . ($args{past_select} |
4720 | + || join(', ', map { $q->quote($_) } @{$self->{sql}->{columns}})) |
4721 | + . " FROM " . $self->{sql}->{from}; |
4722 | + |
4723 | + my $tail_sql |
4724 | + = ($where ? " AND ($where)" : '') |
4725 | + . " ORDER BY " . $self->{sql}->{order_by}; |
4726 | + |
4727 | + my $past_lower_sql |
4728 | + = $head_sql |
4729 | + . " WHERE " . $self->{sql}->{boundaries}->{'<'} |
4730 | + . $tail_sql |
4731 | + . " /*past lower chunk*/"; |
4732 | + MKDEBUG && _d('Past lower statement:', $past_lower_sql); |
4733 | + |
4734 | + my $explain_past_lower_sql |
4735 | + = "EXPLAIN SELECT " |
4736 | + . ($args{past_select} |
4737 | + || join(', ', map { $q->quote($_) } @{$self->{sql}->{columns}})) |
4738 | + . " FROM " . $self->{sql}->{from} |
4739 | + . " WHERE " . $self->{sql}->{boundaries}->{'<'} |
4740 | + . $tail_sql |
4741 | + . " /*explain past lower chunk*/"; |
4742 | + MKDEBUG && _d('Past lower statement:', $explain_past_lower_sql); |
4743 | + |
4744 | + my $past_upper_sql |
4745 | + = $head_sql |
4746 | + . " WHERE " . $self->{sql}->{boundaries}->{'>'} |
4747 | + . $tail_sql |
4748 | + . " /*past upper chunk*/"; |
4749 | + MKDEBUG && _d('Past upper statement:', $past_upper_sql); |
4750 | + |
4751 | + my $explain_past_upper_sql |
4752 | + = "EXPLAIN SELECT " |
4753 | + . ($args{past_select} |
4754 | + || join(', ', map { $q->quote($_) } @{$self->{sql}->{columns}})) |
4755 | + . " FROM " . $self->{sql}->{from} |
4756 | + . " WHERE " . $self->{sql}->{boundaries}->{'>'} |
4757 | + . $tail_sql |
4758 | + . " /*explain past upper chunk*/"; |
4759 | + MKDEBUG && _d('Past upper statement:', $explain_past_upper_sql); |
4760 | + |
4761 | + $self->{past_lower_sql} = $past_lower_sql; |
4762 | + $self->{past_upper_sql} = $past_upper_sql; |
4763 | + $self->{explain_past_lower_sql} = $explain_past_lower_sql; |
4764 | + $self->{explain_past_upper_sql} = $explain_past_upper_sql; |
4765 | + |
4766 | + $self->{past_nibbles} = [qw(lower upper)]; |
4767 | + if ( my $nibble = $args{resume} ) { |
4768 | + if ( !defined $nibble->{lower_boundary} |
4769 | + || !defined $nibble->{upper_boundary} ) { |
4770 | + $self->{past_nibbles} = !defined $nibble->{lower_boundary} |
4771 | + ? ['upper'] |
4772 | + : []; |
4773 | + } |
4774 | + } |
4775 | + MKDEBUG && _d('Nibble past', @{$self->{past_nibbles}}); |
4776 | + |
4777 | + } # not one nibble |
4778 | + |
4779 | + return bless $self, $class; |
4780 | +} |
4781 | + |
4782 | +sub more_boundaries { |
4783 | + my ($self) = @_; |
4784 | + return $self->SUPER::more_boundaries() if $self->{one_nibble}; |
4785 | + return scalar @{$self->{past_nibbles}} ? 1 : 0; |
4786 | +} |
4787 | + |
4788 | +sub statements { |
4789 | + my ($self) = @_; |
4790 | + |
4791 | + my $sths = $self->SUPER::statements(); |
4792 | + |
4793 | + $sths->{past_lower_boundary} = $self->{past_lower_sth}; |
4794 | + $sths->{past_upper_boundary} = $self->{past_upper_sth}; |
4795 | + |
4796 | + return $sths; |
4797 | +} |
4798 | + |
4799 | +sub _prepare_sths { |
4800 | + my ($self) = @_; |
4801 | + MKDEBUG && _d('Preparing out-of-bound statement handles'); |
4802 | + |
4803 | + if ( !$self->{one_nibble} ) { |
4804 | + my $dbh = $self->{Cxn}->dbh(); |
4805 | + $self->{past_lower_sth} = $dbh->prepare($self->{past_lower_sql}); |
4806 | + $self->{past_upper_sth} = $dbh->prepare($self->{past_upper_sql}); |
4807 | + $self->{explain_past_lower_sth} = $dbh->prepare($self->{explain_past_lower_sql}); |
4808 | + $self->{explain_past_upper_sth} = $dbh->prepare($self->{explain_past_upper_sql}); |
4809 | + } |
4810 | + |
4811 | + return $self->SUPER::_prepare_sths(); |
4812 | +} |
4813 | + |
4814 | +sub _next_boundaries { |
4815 | + my ($self) = @_; |
4816 | + |
4817 | + return $self->SUPER::_next_boundaries() unless $self->{no_more_boundaries}; |
4818 | + |
4819 | + if ( my $past = shift @{$self->{past_nibbles}} ) { |
4820 | + if ( $past eq 'lower' ) { |
4821 | + MKDEBUG && _d('Nibbling values below lower boundary'); |
4822 | + $self->{nibble_sth} = $self->{past_lower_sth}; |
4823 | + $self->{explain_nibble_sth} = $self->{explain_past_lower_sth}; |
4824 | + $self->{lower} = []; |
4825 | + $self->{upper} = $self->boundaries()->{first_lower}; |
4826 | + $self->{next_lower} = undef; |
4827 | + } |
4828 | + elsif ( $past eq 'upper' ) { |
4829 | + MKDEBUG && _d('Nibbling values above upper boundary'); |
4830 | + $self->{nibble_sth} = $self->{past_upper_sth}; |
4831 | + $self->{explain_nibble_sth} = $self->{explain_past_upper_sth}; |
4832 | + $self->{lower} = $self->boundaries()->{last_upper}; |
4833 | + $self->{upper} = []; |
4834 | + $self->{next_lower} = undef; |
4835 | + } |
4836 | + else { |
4837 | + die "Invalid past nibble: $past"; |
4838 | + } |
4839 | + return 1; # continue nibbling |
4840 | + } |
4841 | + |
4842 | + MKDEBUG && _d('Done nibbling past boundaries'); |
4843 | + return; # stop nibbling |
4844 | +} |
4845 | + |
4846 | +sub DESTROY { |
4847 | + my ( $self ) = @_; |
4848 | + foreach my $key ( keys %$self ) { |
4849 | + if ( $key =~ m/_sth$/ ) { |
4850 | + MKDEBUG && _d('Finish', $key); |
4851 | + $self->{$key}->finish(); |
4852 | + } |
4853 | + } |
4854 | + return; |
4855 | +} |
4856 | + |
4857 | +sub _d { |
4858 | + my ($package, undef, $line) = caller 0; |
4859 | + @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
4860 | + map { defined $_ ? $_ : 'undef' } |
4861 | + @_; |
4862 | + print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; |
4863 | +} |
4864 | + |
4865 | +1; |
4866 | +} |
4867 | +# ########################################################################### |
4868 | +# End OobNibbleIterator package |
4869 | +# ########################################################################### |
4870 | + |
4871 | +# ########################################################################### |
4872 | # Daemon package |
4873 | # This package is a copy without comments from the original. The original |
4874 | # with comments and its test file can be found in the Bazaar repository at, |
4875 | @@ -4370,12 +4463,16 @@ |
4876 | # ########################################################################### |
4877 | |
4878 | # ########################################################################### |
4879 | -# SchemaIterator r7512 |
4880 | -# Don't update this package! |
4881 | +# SchemaIterator package |
4882 | +# This package is a copy without comments from the original. The original |
4883 | +# with comments and its test file can be found in the Bazaar repository at, |
4884 | +# lib/SchemaIterator.pm |
4885 | +# t/lib/SchemaIterator.t |
4886 | +# See https://launchpad.net/percona-toolkit for more information. |
4887 | # ########################################################################### |
4888 | +{ |
4889 | package SchemaIterator; |
4890 | |
4891 | -{ # package scope |
4892 | use strict; |
4893 | use warnings FATAL => 'all'; |
4894 | use English qw(-no_match_vars); |
4895 | @@ -4407,8 +4504,19 @@ |
4896 | die "I need either a dbh or file_itr argument" |
4897 | if (!$dbh && !$file_itr) || ($dbh && $file_itr); |
4898 | |
4899 | + my %resume; |
4900 | + if ( my $table = $args{resume} ) { |
4901 | + MKDEBUG && _d('Will resume from or after', $table); |
4902 | + my ($db, $tbl) = $args{Quoter}->split_unquote($table); |
4903 | + die "Resume table must be database-qualified: $table" |
4904 | + unless $db && $tbl; |
4905 | + $resume{db} = $db; |
4906 | + $resume{tbl} = $tbl; |
4907 | + } |
4908 | + |
4909 | my $self = { |
4910 | %args, |
4911 | + resume => \%resume, |
4912 | filters => _make_filters(%args), |
4913 | }; |
4914 | |
4915 | @@ -4469,19 +4577,43 @@ |
4916 | return \%filters; |
4917 | } |
4918 | |
4919 | -sub next_schema_object { |
4920 | +sub next { |
4921 | my ( $self ) = @_; |
4922 | |
4923 | - my %schema_object; |
4924 | + if ( !$self->{initialized} ) { |
4925 | + $self->{initialized} = 1; |
4926 | + if ( $self->{resume}->{tbl} |
4927 | + && !$self->table_is_allowed(@{$self->{resume}}{qw(db tbl)}) ) { |
4928 | + MKDEBUG && _d('Will resume after', |
4929 | + join('.', @{$self->{resume}}{qw(db tbl)})); |
4930 | + $self->{resume}->{after} = 1; |
4931 | + } |
4932 | + } |
4933 | + |
4934 | + my $schema_obj; |
4935 | if ( $self->{file_itr} ) { |
4936 | - %schema_object = $self->_iterate_files(); |
4937 | + $schema_obj= $self->_iterate_files(); |
4938 | } |
4939 | else { # dbh |
4940 | - %schema_object = $self->_iterate_dbh(); |
4941 | - } |
4942 | - |
4943 | - MKDEBUG && _d('Next schema object:', Dumper(\%schema_object)); |
4944 | - return %schema_object; |
4945 | + $schema_obj= $self->_iterate_dbh(); |
4946 | + } |
4947 | + |
4948 | + if ( $schema_obj ) { |
4949 | + if ( $schema_obj->{ddl} && $self->{TableParser} ) { |
4950 | + $schema_obj->{tbl_struct} |
4951 | + = $self->{TableParser}->parse($schema_obj->{ddl}); |
4952 | + } |
4953 | + |
4954 | + delete $schema_obj->{ddl} unless $self->{keep_ddl}; |
4955 | + delete $schema_obj->{tbl_status} unless $self->{keep_tbl_status}; |
4956 | + |
4957 | + if ( my $schema = $self->{Schema} ) { |
4958 | + $schema->add_schema_object($schema_obj); |
4959 | + } |
4960 | + MKDEBUG && _d('Next schema object:', $schema_obj->{db}, $schema_obj->{tbl}); |
4961 | + } |
4962 | + |
4963 | + return $schema_obj; |
4964 | } |
4965 | |
4966 | sub _iterate_files { |
4967 | @@ -4506,7 +4638,8 @@ |
4968 | my $db = $1; # XXX |
4969 | $db =~ s/^`//; # strip leading ` |
4970 | $db =~ s/`$//; # and trailing ` |
4971 | - if ( $self->database_is_allowed($db) ) { |
4972 | + if ( $self->database_is_allowed($db) |
4973 | + && $self->_resume_from_database($db) ) { |
4974 | $self->{db} = $db; |
4975 | } |
4976 | } |
4977 | @@ -4519,7 +4652,8 @@ |
4978 | my ($tbl) = $chunk =~ m/$tbl_name/; |
4979 | $tbl =~ s/^\s*`//; |
4980 | $tbl =~ s/`\s*$//; |
4981 | - if ( $self->table_is_allowed($self->{db}, $tbl) ) { |
4982 | + if ( $self->_resume_from_table($tbl) |
4983 | + && $self->table_is_allowed($self->{db}, $tbl) ) { |
4984 | my ($ddl) = $chunk =~ m/^(?:$open_comment)?(CREATE TABLE.+?;)$/ms; |
4985 | if ( !$ddl ) { |
4986 | warn "Failed to parse CREATE TABLE from\n" . $chunk; |
4987 | @@ -4530,11 +4664,11 @@ |
4988 | my ($engine) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; |
4989 | |
4990 | if ( !$engine || $self->engine_is_allowed($engine) ) { |
4991 | - return ( |
4992 | + return { |
4993 | db => $self->{db}, |
4994 | tbl => $tbl, |
4995 | ddl => $ddl, |
4996 | - ); |
4997 | + }; |
4998 | } |
4999 | } |
5000 | } |
The diff has been truncated for viewing.