Merge lp:~baron-xaprb/percona-toolkit/ptc-2.0.1-docs into lp:percona-toolkit/2.0

Proposed by Daniel Nichter
Status: Merged
Approved by: Daniel Nichter
Approved revision: 256
Merged at revision: 121
Proposed branch: lp:~baron-xaprb/percona-toolkit/ptc-2.0.1-docs
Merge into: lp:percona-toolkit/2.0
Diff against target: 26750 lines (+12207/-10315) (has conflicts)
175 files modified
Changelog (+8/-2)
bin/pt-table-checksum (+5087/-5507)
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/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 (+498/-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/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 (+46/-79)
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 (+233/-41)
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 (+16/-0)
t/pt-table-checksum/samples/chunkidx005.txt (+16/-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 (+16/-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:~baron-xaprb/percona-toolkit/ptc-2.0.1-docs
Reviewer Review Type Date Requested Status
Daniel Nichter Approve
Review via email: mp+86961@code.launchpad.net
To post a comment you must log in.
Revision history for this message
Daniel Nichter (daniel-nichter) :
review: Approve

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-27 16:17:26 +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-27 16:17:26 +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 ? " AND ($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 ? " AND ($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.

Subscribers

People subscribed via source and target branches