Merge lp:~percona-toolkit-dev/percona-toolkit/pt-osc-2.1.1 into lp:percona-toolkit/2.1

Proposed by Daniel Nichter
Status: Merged
Merged at revision: 228
Proposed branch: lp:~percona-toolkit-dev/percona-toolkit/pt-osc-2.1.1
Merge into: lp:percona-toolkit/2.1
Diff against target: 9987 lines (+6370/-2594) (has conflicts)
24 files modified
bin/pt-online-schema-change (+4615/-1243)
bin/pt-table-checksum (+114/-37)
lib/CleanupTask.pm (+7/-2)
lib/MySQLStatusWaiter.pm (+34/-12)
lib/NibbleIterator.pm (+165/-49)
lib/OSCCaptureSync.pm (+0/-142)
lib/OobNibbleIterator.pm (+1/-1)
lib/SchemaIterator.pm (+12/-0)
t/lib/CleanupTask.t (+18/-1)
t/lib/MySQLStatusWaiter.t (+38/-4)
t/lib/NibbleIterator.t (+42/-4)
t/lib/OSCCaptureSync.t (+0/-131)
t/lib/OobNibbleIterator.t (+8/-3)
t/pt-online-schema-change/alter_active_table.t (+56/-46)
t/pt-online-schema-change/basics.t (+541/-218)
t/pt-online-schema-change/check_tables.t (+0/-126)
t/pt-online-schema-change/option_sanity.t (+12/-12)
t/pt-online-schema-change/samples/basic_no_fks.data (+500/-500)
t/pt-online-schema-change/samples/basic_no_fks.sql (+30/-0)
t/pt-online-schema-change/samples/basic_with_fks.sql (+56/-0)
t/pt-online-schema-change/samples/fk_tables_schema.sql (+0/-31)
t/pt-online-schema-change/samples/query_table.pl (+8/-5)
t/pt-online-schema-change/samples/small_table.sql (+0/-27)
t/pt-online-schema-change/sanity_checks.t (+113/-0)
Text conflict in bin/pt-online-schema-change
Text conflict in bin/pt-table-checksum
Text conflict in lib/NibbleIterator.pm
Text conflict in lib/SchemaIterator.pm
To merge this branch: bzr merge lp:~percona-toolkit-dev/percona-toolkit/pt-osc-2.1.1
Reviewer Review Type Date Requested Status
Baron Schwartz (community) Approve
Daniel Nichter Approve
Brian Fraser Pending
Review via email: mp+100540@code.launchpad.net
To post a comment you must log in.
Revision history for this message
Daniel Nichter (daniel-nichter) :
review: Approve
Revision history for this message
Baron Schwartz (baron-xaprb) :
review: Approve
251. By Daniel Nichter

Add comment about code that will fail with new Cxn due to NAME_lc.

252. By Daniel Nichter

Catch lost cleanup task (should rarely happen).

253. By Daniel Nichter

Handle Key_name or key_name in NibbleIterator::_get_index_cardinality().

254. By Daniel Nichter

Add XXX comment about improperly copying .

255. By Daniel Nichter

Uncomment cleanup lines in alter_active_table.t.

256. By Daniel Nichter

Update modules in pt-online-schema-change.

257. By Daniel Nichter

Fix typo.

Preview Diff

[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
=== modified file 'bin/pt-online-schema-change'
--- bin/pt-online-schema-change 2012-03-30 16:37:16 +0000
+++ bin/pt-online-schema-change 2012-04-03 02:13:24 +0000
@@ -1784,245 +1784,246 @@
1784# ###########################################################################1784# ###########################################################################
17851785
1786# ###########################################################################1786# ###########################################################################
1787# Transformers package1787# TableNibbler package
1788# This package is a copy without comments from the original. The original1788# This package is a copy without comments from the original. The original
1789# with comments and its test file can be found in the Bazaar repository at,1789# with comments and its test file can be found in the Bazaar repository at,
1790# lib/Transformers.pm1790# lib/TableNibbler.pm
1791# t/lib/Transformers.t1791# t/lib/TableNibbler.t
1792# See https://launchpad.net/percona-toolkit for more information.1792# See https://launchpad.net/percona-toolkit for more information.
1793# ###########################################################################1793# ###########################################################################
1794{1794{
1795package Transformers;1795package TableNibbler;
17961796
1797use strict;1797use strict;
1798use warnings FATAL => 'all';1798use warnings FATAL => 'all';
1799use English qw(-no_match_vars);1799use English qw(-no_match_vars);
1800use constant PTDEBUG => $ENV{PTDEBUG} || 0;1800use constant PTDEBUG => $ENV{PTDEBUG} || 0;
18011801
1802use Time::Local qw(timegm timelocal);1802sub new {
1803use Digest::MD5 qw(md5_hex);1803 my ( $class, %args ) = @_;
18041804 my @required_args = qw(TableParser Quoter);
1805require Exporter;1805 foreach my $arg ( @required_args ) {
1806our @ISA = qw(Exporter);1806 die "I need a $arg argument" unless $args{$arg};
1807our %EXPORT_TAGS = ();1807 }
1808our @EXPORT = ();1808 my $self = { %args };
1809our @EXPORT_OK = qw(1809 return bless $self, $class;
1810 micro_t1810}
1811 percentage_of1811
1812 secs_to_time1812sub generate_asc_stmt {
1813 time_to_secs1813 my ( $self, %args ) = @_;
1814 shorten1814 my @required_args = qw(tbl_struct index);
1815 ts1815 foreach my $arg ( @required_args ) {
1816 parse_timestamp1816 die "I need a $arg argument" unless defined $args{$arg};
1817 unix_timestamp1817 }
1818 any_unix_timestamp1818 my ($tbl_struct, $index) = @args{@required_args};
1819 make_checksum1819 my @cols = $args{cols} ? @{$args{cols}} : @{$tbl_struct->{cols}};
1820 crc321820 my $q = $self->{Quoter};
1821);1821
18221822 die "Index '$index' does not exist in table"
1823our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;1823 unless exists $tbl_struct->{keys}->{$index};
1824our $proper_ts = qr/(\d\d\d\d)-(\d\d)-(\d\d)[T ](\d\d):(\d\d):(\d\d)(\.\d+)?/;1824 PTDEBUG && _d('Will ascend index', $index);
1825our $n_ts = qr/(\d{1,5})([shmd]?)/; # Limit \d{1,5} because \d{6} looks1825
18261826 my @asc_cols = @{$tbl_struct->{keys}->{$index}->{cols}};
1827sub micro_t {1827 if ( $args{asc_first} ) {
1828 my ( $t, %args ) = @_;1828 @asc_cols = $asc_cols[0];
1829 my $p_ms = defined $args{p_ms} ? $args{p_ms} : 0; # precision for ms vals1829 PTDEBUG && _d('Ascending only first column');
1830 my $p_s = defined $args{p_s} ? $args{p_s} : 0; # precision for s vals1830 }
1831 my $f;1831 PTDEBUG && _d('Will ascend columns', join(', ', @asc_cols));
18321832
1833 $t = 0 if $t < 0;1833 my @asc_slice;
18341834 my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols };
1835 $t = sprintf('%.17f', $t) if $t =~ /e/;1835 foreach my $col ( @asc_cols ) {
18361836 if ( !exists $col_posn{$col} ) {
1837 $t =~ s/\.(\d{1,6})\d*/\.$1/;1837 push @cols, $col;
18381838 $col_posn{$col} = $#cols;
1839 if ($t > 0 && $t <= 0.000999) {1839 }
1840 $f = ($t * 1000000) . 'us';1840 push @asc_slice, $col_posn{$col};
1841 }1841 }
1842 elsif ($t >= 0.001000 && $t <= 0.999999) {1842 PTDEBUG && _d('Will ascend, in ordinal position:', join(', ', @asc_slice));
1843 $f = sprintf("%.${p_ms}f", $t * 1000);1843
1844 $f = ($f * 1) . 'ms'; # * 1 to remove insignificant zeros1844 my $asc_stmt = {
1845 }1845 cols => \@cols,
1846 elsif ($t >= 1) {1846 index => $index,
1847 $f = sprintf("%.${p_s}f", $t);1847 where => '',
1848 $f = ($f * 1) . 's'; # * 1 to remove insignificant zeros1848 slice => [],
1849 }1849 scols => [],
1850 else {1850 };
1851 $f = 0; # $t should = 0 at this point1851
1852 }1852 if ( @asc_slice ) {
18531853 my $cmp_where;
1854 return $f;1854 foreach my $cmp ( qw(< <= >= >) ) {
1855}1855 $cmp_where = $self->generate_cmp_where(
18561856 type => $cmp,
1857sub percentage_of {1857 slice => \@asc_slice,
1858 my ( $is, $of, %args ) = @_;1858 cols => \@cols,
1859 my $p = $args{p} || 0; # float precision1859 quoter => $q,
1860 my $fmt = $p ? "%.${p}f" : "%d";1860 is_nullable => $tbl_struct->{is_nullable},
1861 return sprintf $fmt, ($is * 100) / ($of ||= 1);1861 );
1862}1862 $asc_stmt->{boundaries}->{$cmp} = $cmp_where->{where};
18631863 }
1864sub secs_to_time {1864 my $cmp = $args{asc_only} ? '>' : '>=';
1865 my ( $secs, $fmt ) = @_;1865 $asc_stmt->{where} = $asc_stmt->{boundaries}->{$cmp};
1866 $secs ||= 0;1866 $asc_stmt->{slice} = $cmp_where->{slice};
1867 return '00:00' unless $secs;1867 $asc_stmt->{scols} = $cmp_where->{scols};
18681868 }
1869 $fmt ||= $secs >= 86_400 ? 'd'1869
1870 : $secs >= 3_600 ? 'h'1870 return $asc_stmt;
1871 : 'm';1871}
18721872
1873 return1873sub generate_cmp_where {
1874 $fmt eq 'd' ? sprintf(1874 my ( $self, %args ) = @_;
1875 "%d+%02d:%02d:%02d",1875 foreach my $arg ( qw(type slice cols is_nullable) ) {
1876 int($secs / 86_400),1876 die "I need a $arg arg" unless defined $args{$arg};
1877 int(($secs % 86_400) / 3_600),1877 }
1878 int(($secs % 3_600) / 60),1878 my @slice = @{$args{slice}};
1879 $secs % 60)1879 my @cols = @{$args{cols}};
1880 : $fmt eq 'h' ? sprintf(1880 my $is_nullable = $args{is_nullable};
1881 "%02d:%02d:%02d",1881 my $type = $args{type};
1882 int(($secs % 86_400) / 3_600),1882 my $q = $self->{Quoter};
1883 int(($secs % 3_600) / 60),1883
1884 $secs % 60)1884 (my $cmp = $type) =~ s/=//;
1885 : sprintf(1885
1886 "%02d:%02d",1886 my @r_slice; # Resulting slice columns, by ordinal
1887 int(($secs % 3_600) / 60),1887 my @r_scols; # Ditto, by name
1888 $secs % 60);1888
1889}1889 my @clauses;
18901890 foreach my $i ( 0 .. $#slice ) {
1891sub time_to_secs {1891 my @clause;
1892 my ( $val, $default_suffix ) = @_;1892
1893 die "I need a val argument" unless defined $val;1893 foreach my $j ( 0 .. $i - 1 ) {
1894 my $t = 0;1894 my $ord = $slice[$j];
1895 my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/;1895 my $col = $cols[$ord];
1896 $suffix = $suffix || $default_suffix || 's';1896 my $quo = $q->quote($col);
1897 if ( $suffix =~ m/[smhd]/ ) {1897 if ( $is_nullable->{$col} ) {
1898 $t = $suffix eq 's' ? $num * 1 # Seconds1898 push @clause, "((? IS NULL AND $quo IS NULL) OR ($quo = ?))";
1899 : $suffix eq 'm' ? $num * 60 # Minutes1899 push @r_slice, $ord, $ord;
1900 : $suffix eq 'h' ? $num * 3600 # Hours1900 push @r_scols, $col, $col;
1901 : $num * 86400; # Days1901 }
19021902 else {
1903 $t *= -1 if $prefix && $prefix eq '-';1903 push @clause, "$quo = ?";
1904 }1904 push @r_slice, $ord;
1905 else {1905 push @r_scols, $col;
1906 die "Invalid suffix for $val: $suffix";1906 }
1907 }1907 }
1908 return $t;1908
1909}1909 my $ord = $slice[$i];
19101910 my $col = $cols[$ord];
1911sub shorten {1911 my $quo = $q->quote($col);
1912 my ( $num, %args ) = @_;1912 my $end = $i == $#slice; # Last clause of the whole group.
1913 my $p = defined $args{p} ? $args{p} : 2; # float precision1913 if ( $is_nullable->{$col} ) {
1914 my $d = defined $args{d} ? $args{d} : 1_024; # divisor1914 if ( $type =~ m/=/ && $end ) {
1915 my $n = 0;1915 push @clause, "(? IS NULL OR $quo $type ?)";
1916 my @units = ('', qw(k M G T P E Z Y));1916 }
1917 while ( $num >= $d && $n < @units - 1 ) {1917 elsif ( $type =~ m/>/ ) {
1918 $num /= $d;1918 push @clause, "((? IS NULL AND $quo IS NOT NULL) OR ($quo $cmp ?))";
1919 ++$n;1919 }
1920 }1920 else { # If $type =~ m/</ ) {
1921 return sprintf(1921 push @clause, "((? IS NOT NULL AND $quo IS NULL) OR ($quo $cmp ?))";
1922 $num =~ m/\./ || $n1922 }
1923 ? "%.${p}f%s"1923 push @r_slice, $ord, $ord;
1924 : '%d',1924 push @r_scols, $col, $col;
1925 $num, $units[$n]);1925 }
1926}1926 else {
19271927 push @r_slice, $ord;
1928sub ts {1928 push @r_scols, $col;
1929 my ( $time, $gmt ) = @_;1929 push @clause, ($type =~ m/=/ && $end ? "$quo $type ?" : "$quo $cmp ?");
1930 my ( $sec, $min, $hour, $mday, $mon, $year )1930 }
1931 = $gmt ? gmtime($time) : localtime($time);1931
1932 $mon += 1;1932 push @clauses, '(' . join(' AND ', @clause) . ')';
1933 $year += 1900;1933 }
1934 my $val = sprintf("%d-%02d-%02dT%02d:%02d:%02d",1934 my $result = '(' . join(' OR ', @clauses) . ')';
1935 $year, $mon, $mday, $hour, $min, $sec);1935 my $where = {
1936 if ( my ($us) = $time =~ m/(\.\d+)$/ ) {1936 slice => \@r_slice,
1937 $us = sprintf("%.6f", $us);1937 scols => \@r_scols,
1938 $us =~ s/^0\././;1938 where => $result,
1939 $val .= $us;1939 };
1940 }1940 return $where;
1941 return $val;1941}
1942}1942
19431943sub generate_del_stmt {
1944sub parse_timestamp {1944 my ( $self, %args ) = @_;
1945 my ( $val ) = @_;1945
1946 if ( my($y, $m, $d, $h, $i, $s, $f)1946 my $tbl = $args{tbl_struct};
1947 = $val =~ m/^$mysql_ts$/ )1947 my @cols = $args{cols} ? @{$args{cols}} : ();
1948 {1948 my $tp = $self->{TableParser};
1949 return sprintf "%d-%02d-%02d %02d:%02d:"1949 my $q = $self->{Quoter};
1950 . (defined $f ? '%09.6f' : '%02d'),1950
1951 $y + 2000, $m, $d, $h, $i, (defined $f ? $s + $f : $s);1951 my @del_cols;
1952 }1952 my @del_slice;
1953 return $val;1953
1954}1954 my $index = $tp->find_best_index($tbl, $args{index});
19551955 die "Cannot find an ascendable index in table" unless $index;
1956sub unix_timestamp {1956
1957 my ( $val, $gmt ) = @_;1957 if ( $index ) {
1958 if ( my($y, $m, $d, $h, $i, $s, $us) = $val =~ m/^$proper_ts$/ ) {1958 @del_cols = @{$tbl->{keys}->{$index}->{cols}};
1959 $val = $gmt1959 }
1960 ? timegm($s, $i, $h, $d, $m - 1, $y)1960 else {
1961 : timelocal($s, $i, $h, $d, $m - 1, $y);1961 @del_cols = @{$tbl->{cols}};
1962 if ( defined $us ) {1962 }
1963 $us = sprintf('%.6f', $us);1963 PTDEBUG && _d('Columns needed for DELETE:', join(', ', @del_cols));
1964 $us =~ s/^0\././;1964
1965 $val .= $us;1965 my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols };
1966 }1966 foreach my $col ( @del_cols ) {
1967 }1967 if ( !exists $col_posn{$col} ) {
1968 return $val;1968 push @cols, $col;
1969}1969 $col_posn{$col} = $#cols;
19701970 }
1971sub any_unix_timestamp {1971 push @del_slice, $col_posn{$col};
1972 my ( $val, $callback ) = @_;1972 }
19731973 PTDEBUG && _d('Ordinals needed for DELETE:', join(', ', @del_slice));
1974 if ( my ($n, $suffix) = $val =~ m/^$n_ts$/ ) {1974
1975 $n = $suffix eq 's' ? $n # Seconds1975 my $del_stmt = {
1976 : $suffix eq 'm' ? $n * 60 # Minutes1976 cols => \@cols,
1977 : $suffix eq 'h' ? $n * 3600 # Hours1977 index => $index,
1978 : $suffix eq 'd' ? $n * 86400 # Days1978 where => '',
1979 : $n; # default: Seconds1979 slice => [],
1980 PTDEBUG && _d('ts is now - N[shmd]:', $n);1980 scols => [],
1981 return time - $n;1981 };
1982 }1982
1983 elsif ( $val =~ m/^\d{9,}/ ) {1983 my @clauses;
1984 PTDEBUG && _d('ts is already a unix timestamp');1984 foreach my $i ( 0 .. $#del_slice ) {
1985 return $val;1985 my $ord = $del_slice[$i];
1986 }1986 my $col = $cols[$ord];
1987 elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) {1987 my $quo = $q->quote($col);
1988 PTDEBUG && _d('ts is MySQL slow log timestamp');1988 if ( $tbl->{is_nullable}->{$col} ) {
1989 $val .= ' 00:00:00' unless $hms;1989 push @clauses, "((? IS NULL AND $quo IS NULL) OR ($quo = ?))";
1990 return unix_timestamp(parse_timestamp($val));1990 push @{$del_stmt->{slice}}, $ord, $ord;
1991 }1991 push @{$del_stmt->{scols}}, $col, $col;
1992 elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) {1992 }
1993 PTDEBUG && _d('ts is properly formatted timestamp');1993 else {
1994 $val .= ' 00:00:00' unless $hms;1994 push @clauses, "$quo = ?";
1995 return unix_timestamp($val);1995 push @{$del_stmt->{slice}}, $ord;
1996 }1996 push @{$del_stmt->{scols}}, $col;
1997 else {1997 }
1998 PTDEBUG && _d('ts is MySQL expression');1998 }
1999 return $callback->($val) if $callback && ref $callback eq 'CODE';1999
2000 }2000 $del_stmt->{where} = '(' . join(' AND ', @clauses) . ')';
20012001
2002 PTDEBUG && _d('Unknown ts type:', $val);2002 return $del_stmt;
2003 return;2003}
2004}2004
20052005sub generate_ins_stmt {
2006sub make_checksum {2006 my ( $self, %args ) = @_;
2007 my ( $val ) = @_;2007 foreach my $arg ( qw(ins_tbl sel_cols) ) {
2008 my $checksum = uc substr(md5_hex($val), -16);2008 die "I need a $arg argument" unless $args{$arg};
2009 PTDEBUG && _d($checksum, 'checksum for', $val);2009 }
2010 return $checksum;2010 my $ins_tbl = $args{ins_tbl};
2011}2011 my @sel_cols = @{$args{sel_cols}};
20122012
2013sub crc32 {2013 die "You didn't specify any SELECT columns" unless @sel_cols;
2014 my ( $string ) = @_;2014
2015 return unless $string;2015 my @ins_cols;
2016 my $poly = 0xEDB88320;2016 my @ins_slice;
2017 my $crc = 0xFFFFFFFF;2017 for my $i ( 0..$#sel_cols ) {
2018 foreach my $char ( split(//, $string) ) {2018 next unless $ins_tbl->{is_col}->{$sel_cols[$i]};
2019 my $comp = ($crc ^ ord($char)) & 0xFF;2019 push @ins_cols, $sel_cols[$i];
2020 for ( 1 .. 8 ) {2020 push @ins_slice, $i;
2021 $comp = $comp & 1 ? $poly ^ ($comp >> 1) : $comp >> 1;2021 }
2022 }2022
2023 $crc = (($crc >> 8) & 0x00FFFFFF) ^ $comp;2023 return {
2024 }2024 cols => \@ins_cols,
2025 return $crc ^ 0xFFFFFFFF;2025 slice => \@ins_slice,
2026 };
2026}2027}
20272028
2028sub _d {2029sub _d {
@@ -2036,7 +2037,7 @@
20361;20371;
2037}2038}
2038# ###########################################################################2039# ###########################################################################
2039# End Transformers package2040# End TableNibbler package
2040# ###########################################################################2041# ###########################################################################
20412042
2042# ###########################################################################2043# ###########################################################################
@@ -2077,41 +2078,43 @@
2077 die "I need a tbl parameter" unless $tbl;2078 die "I need a tbl parameter" unless $tbl;
2078 my $q = $self->{Quoter};2079 my $q = $self->{Quoter};
20792080
2080 my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, '2081 my $new_sql_mode
2081 . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), }2082 = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, '
2082 . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, '2083 . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), }
2083 . '@@SQL_QUOTE_SHOW_CREATE := 1 */';2084 . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, '
2084 PTDEBUG && _d($sql);2085 . '@@SQL_QUOTE_SHOW_CREATE := 1 */';
2085 eval { $dbh->do($sql); };2086
2087 my $old_sql_mode = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, '
2088 . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */';
2089
2090 PTDEBUG && _d($new_sql_mode);
2091 eval { $dbh->do($new_sql_mode); };
2086 PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);2092 PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);
20872093
2088 $sql = 'USE ' . $q->quote($db);2094 my $use_sql = 'USE ' . $q->quote($db);
2089 PTDEBUG && _d($dbh, $sql);2095 PTDEBUG && _d($dbh, $use_sql);
2090 $dbh->do($sql);2096 $dbh->do($use_sql);
20912097
2092 $sql = "SHOW CREATE TABLE " . $q->quote($db, $tbl);2098 my $show_sql = "SHOW CREATE TABLE " . $q->quote($db, $tbl);
2093 PTDEBUG && _d($sql);2099 PTDEBUG && _d($show_sql);
2094 my $href;2100 my $href;
2095 eval { $href = $dbh->selectrow_hashref($sql); };2101 eval { $href = $dbh->selectrow_hashref($show_sql); };
2096 if ( $EVAL_ERROR ) {2102 if ( $EVAL_ERROR ) {
2097 PTDEBUG && _d($EVAL_ERROR);2103 PTDEBUG && _d($EVAL_ERROR);
2104
2105 PTDEBUG && _d($old_sql_mode);
2106 $dbh->do($old_sql_mode);
2107
2098 return;2108 return;
2099 }2109 }
21002110
2101 $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, '2111 PTDEBUG && _d($old_sql_mode);
2102 . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */';2112 $dbh->do($old_sql_mode);
2103 PTDEBUG && _d($sql);
2104 $dbh->do($sql);
21052113
2106 my ($key) = grep { m/create table/i } keys %$href;2114 my ($key) = grep { m/create (?:table|view)/i } keys %$href;
2107 if ( $key ) {2115 if ( !$key ) {
2108 PTDEBUG && _d('This table is a base table');2116 die "Error: no 'Create Table' or 'Create View' in result set from "
2109 $href->{$key} =~ s/\b[ ]{2,}/ /g;2117 . "$show_sql: " . Dumper($href);
2110 $href->{$key} .= "\n";
2111 }
2112 else {
2113 PTDEBUG && _d('This table is a view');
2114 ($key) = grep { m/create view/i } keys %$href;
2115 }2118 }
21162119
2117 return $href->{$key};2120 return $href->{$key};
@@ -2468,6 +2471,7 @@
2468# ###########################################################################2471# ###########################################################################
24692472
2470# ###########################################################################2473# ###########################################################################
2474<<<<<<< TREE
2471# TableChunker package2475# TableChunker package
2472# This package is a copy without comments from the original. The original2476# This package is a copy without comments from the original. The original
2473# with comments and its test file can be found in the Bazaar repository at,2477# with comments and its test file can be found in the Bazaar repository at,
@@ -3399,6 +3403,8 @@
3399# ###########################################################################3403# ###########################################################################
34003404
3401# ###########################################################################3405# ###########################################################################
3406=======
3407>>>>>>> MERGE-SOURCE
3402# Progress package3408# Progress package
3403# This package is a copy without comments from the original. The original3409# This package is a copy without comments from the original. The original
3404# with comments and its test file can be found in the Bazaar repository at,3410# with comments and its test file can be found in the Bazaar repository at,
@@ -3547,241 +3553,6 @@
3547# ###########################################################################3553# ###########################################################################
35483554
3549# ###########################################################################3555# ###########################################################################
3550# OSCCaptureSync package
3551# This package is a copy without comments from the original. The original
3552# with comments and its test file can be found in the Bazaar repository at,
3553# lib/OSCCaptureSync.pm
3554# t/lib/OSCCaptureSync.t
3555# See https://launchpad.net/percona-toolkit for more information.
3556# ###########################################################################
3557{
3558package OSCCaptureSync;
3559
3560use strict;
3561use warnings FATAL => 'all';
3562use English qw(-no_match_vars);
3563use constant PTDEBUG => $ENV{PTDEBUG} || 0;
3564
3565sub new {
3566 my ( $class, %args ) = @_;
3567 my @required_args = qw(Quoter);
3568 foreach my $arg ( @required_args ) {
3569 die "I need a $arg argument" unless $args{$arg};
3570 }
3571
3572 my $self = {
3573 Quoter => $args{Quoter},
3574 };
3575
3576 return bless $self, $class;
3577}
3578
3579sub capture {
3580 my ( $self, %args ) = @_;
3581 my @required_args = qw(msg dbh db tbl tmp_tbl columns chunk_column);
3582 foreach my $arg ( @required_args ) {
3583 die "I need a $arg argument" unless $args{$arg};
3584 }
3585 my ($msg, $dbh) = @args{@required_args};
3586
3587 my @triggers = $self->_make_triggers(%args);
3588 foreach my $sql ( @triggers ) {
3589 $msg->($sql);
3590 $dbh->do($sql) unless $args{print};
3591 }
3592
3593 return;
3594}
3595
3596sub _make_triggers {
3597 my ( $self, %args ) = @_;
3598 my @required_args = qw(db tbl tmp_tbl chunk_column columns);
3599 foreach my $arg ( @required_args ) {
3600 die "I need a $arg argument" unless $args{$arg};
3601 }
3602 my ($db, $tbl, $tmp_tbl, $chunk_column) = @args{@required_args};
3603 my $q = $self->{Quoter};
3604
3605 $chunk_column = $q->quote($chunk_column);
3606
3607 my $old_table = $q->quote($db, $tbl);
3608 my $new_table = $q->quote($db, $tmp_tbl);
3609 my $new_values = join(', ', map { "NEW.".$q->quote($_) } @{$args{columns}});
3610 my $columns = join(', ', map { $q->quote($_) } @{$args{columns}});
3611
3612 my $delete_trigger = "CREATE TRIGGER mk_osc_del AFTER DELETE ON $old_table "
3613 . "FOR EACH ROW "
3614 . "DELETE IGNORE FROM $new_table "
3615 . "WHERE $new_table.$chunk_column = OLD.$chunk_column";
3616
3617 my $insert_trigger = "CREATE TRIGGER mk_osc_ins AFTER INSERT ON $old_table "
3618 . "FOR EACH ROW "
3619 . "REPLACE INTO $new_table ($columns) "
3620 . "VALUES($new_values)";
3621
3622 my $update_trigger = "CREATE TRIGGER mk_osc_upd AFTER UPDATE ON $old_table "
3623 . "FOR EACH ROW "
3624 . "REPLACE INTO $new_table ($columns) "
3625 . "VALUES ($new_values)";
3626
3627 return $delete_trigger, $update_trigger, $insert_trigger;
3628}
3629
3630sub sync {
3631 my ( $self, %args ) = @_;
3632 my @required_args = qw();
3633 foreach my $arg ( @required_args ) {
3634 die "I need a $arg argument" unless $args{$arg};
3635 }
3636 return;
3637}
3638
3639sub cleanup {
3640 my ( $self, %args ) = @_;
3641 my @required_args = qw(dbh db msg);
3642 foreach my $arg ( @required_args ) {
3643 die "I need a $arg argument" unless $args{$arg};
3644 }
3645 my ($dbh, $db, $msg) = @args{@required_args};
3646 my $q = $self->{Quoter};
3647
3648 foreach my $trigger ( qw(del ins upd) ) {
3649 my $sql = "DROP TRIGGER IF EXISTS " . $q->quote($db, "mk_osc_$trigger");
3650 $msg->($sql);
3651 $dbh->do($sql) unless $args{print};
3652 }
3653
3654 return;
3655}
3656
3657sub _d {
3658 my ($package, undef, $line) = caller 0;
3659 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
3660 map { defined $_ ? $_ : 'undef' }
3661 @_;
3662 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
3663}
3664
36651;
3666}
3667# ###########################################################################
3668# End OSCCaptureSync package
3669# ###########################################################################
3670
3671# ###########################################################################
3672# CopyRowsInsertSelect 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/CopyRowsInsertSelect.pm
3676# t/lib/CopyRowsInsertSelect.t
3677# See https://launchpad.net/percona-toolkit for more information.
3678# ###########################################################################
3679{
3680package CopyRowsInsertSelect;
3681
3682use strict;
3683use warnings FATAL => 'all';
3684use English qw(-no_match_vars);
3685use constant PTDEBUG => $ENV{PTDEBUG} || 0;
3686
3687sub new {
3688 my ( $class, %args ) = @_;
3689 my @required_args = qw(Retry Quoter);
3690 foreach my $arg ( @required_args ) {
3691 die "I need a $arg argument" unless $args{$arg};
3692 }
3693
3694 my $self = {
3695 Retry => $args{Retry},
3696 Quoter => $args{Quoter},
3697 };
3698
3699 return bless $self, $class;
3700}
3701
3702sub copy {
3703 my ( $self, %args ) = @_;
3704 my @required_args = qw(dbh msg from_table to_table chunks columns);
3705 foreach my $arg ( @required_args ) {
3706 die "I need a $arg argument" unless $args{$arg};
3707 }
3708 my ($dbh, $msg, $from_table, $to_table, $chunks) = @args{@required_args};
3709 my $q = $self->{Quoter};
3710 my $pr = $args{Progress};
3711 my $sleep = $args{sleep};
3712 my $columns = join(', ', map { $q->quote($_) } @{$args{columns}});
3713 my $n_chunks = @$chunks - 1;
3714
3715 for my $chunkno ( 0..$n_chunks ) {
3716 if ( !$chunks->[$chunkno] ) {
3717 warn "Chunk number ", ($chunkno + 1), "is undefined";
3718 next;
3719 }
3720
3721 my $sql = "INSERT IGNORE INTO $to_table ($columns) "
3722 . "SELECT $columns FROM $from_table "
3723 . "WHERE ($chunks->[$chunkno])"
3724 . ($args{where} ? " AND ($args{where})" : "")
3725 . ($args{engine_flags} ? " $args{engine_flags}" : "");
3726
3727 if ( $args{print} ) {
3728 $msg->($sql);
3729 }
3730 else {
3731 PTDEBUG && _d($dbh, $sql);
3732 my $error;
3733 $self->{Retry}->retry(
3734 wait => sub { sleep 1; },
3735 tries => 3,
3736 try => sub {
3737 $dbh->do($sql);
3738 return;
3739 },
3740 fail => sub {
3741 my (%args) = @_;
3742 my $error = $args{error};
3743 PTDEBUG && _d($error);
3744 if ( $error =~ m/Lock wait timeout exceeded/ ) {
3745 $msg->("Lock wait timeout exceeded; retrying $sql");
3746 return 1; # call wait, call try
3747 }
3748 return 0; # call final_fail
3749 },
3750 final_fail => sub {
3751 my (%args) = @_;
3752 die $args{error};
3753 },
3754 );
3755 }
3756
3757 $pr->update(sub { return $chunkno + 1; }) if $pr;
3758
3759 $sleep->($chunkno + 1) if $sleep && $chunkno < $n_chunks;
3760 }
3761
3762 return;
3763}
3764
3765sub cleanup {
3766 my ( $self, %args ) = @_;
3767 return;
3768}
3769
3770sub _d {
3771 my ($package, undef, $line) = caller 0;
3772 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
3773 map { defined $_ ? $_ : 'undef' }
3774 @_;
3775 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
3776}
3777
37781;
3779}
3780# ###########################################################################
3781# End CopyRowsInsertSelect package
3782# ###########################################################################
3783
3784# ###########################################################################
3785# Retry package3556# Retry package
3786# This package is a copy without comments from the original. The original3557# This package is a copy without comments from the original. The original
3787# with comments and its test file can be found in the Bazaar repository at,3558# with comments and its test file can be found in the Bazaar repository at,
@@ -3860,6 +3631,2187 @@
3860# ###########################################################################3631# ###########################################################################
38613632
3862# ###########################################################################3633# ###########################################################################
3634# Cxn package
3635# This package is a copy without comments from the original. The original
3636# with comments and its test file can be found in the Bazaar repository at,
3637# lib/Cxn.pm
3638# t/lib/Cxn.t
3639# See https://launchpad.net/percona-toolkit for more information.
3640# ###########################################################################
3641{
3642package Cxn;
3643
3644use strict;
3645use warnings FATAL => 'all';
3646use English qw(-no_match_vars);
3647use constant PTDEBUG => $ENV{PTDEBUG} || 0;
3648
3649use constant PERCONA_TOOLKIT_TEST_USE_DSN_NAMES => $ENV{PERCONA_TOOLKIT_TEST_USE_DSN_NAMES} || 0;
3650
3651sub new {
3652 my ( $class, %args ) = @_;
3653 my @required_args = qw(DSNParser OptionParser);
3654 foreach my $arg ( @required_args ) {
3655 die "I need a $arg argument" unless $args{$arg};
3656 };
3657 my ($dp, $o) = @args{@required_args};
3658
3659 my $dsn_defaults = $dp->parse_options($o);
3660 my $prev_dsn = $args{prev_dsn};
3661 my $dsn = $args{dsn};
3662 if ( !$dsn ) {
3663 $args{dsn_string} ||= 'h=' . ($dsn_defaults->{h} || 'localhost');
3664
3665 $dsn = $dp->parse(
3666 $args{dsn_string}, $prev_dsn, $dsn_defaults);
3667 }
3668 elsif ( $prev_dsn ) {
3669 $dsn = $dp->copy($prev_dsn, $dsn);
3670 }
3671
3672 my $self = {
3673 dsn => $dsn,
3674 dbh => $args{dbh},
3675 dsn_name => $dp->as_string($dsn, [qw(h P S)]),
3676 hostname => '',
3677 set => $args{set},
3678 dbh_set => 0,
3679 OptionParser => $o,
3680 DSNParser => $dp,
3681 };
3682
3683 return bless $self, $class;
3684}
3685
3686sub connect {
3687 my ( $self ) = @_;
3688 my $dsn = $self->{dsn};
3689 my $dp = $self->{DSNParser};
3690 my $o = $self->{OptionParser};
3691
3692 my $dbh = $self->{dbh};
3693 if ( !$dbh || !$dbh->ping() ) {
3694 if ( $o->get('ask-pass') && !$self->{asked_for_pass} ) {
3695 $dsn->{p} = OptionParser::prompt_noecho("Enter MySQL password: ");
3696 $self->{asked_for_pass} = 1;
3697 }
3698 $dbh = $dp->get_dbh($dp->get_cxn_params($dsn), { AutoCommit => 1 });
3699 }
3700 PTDEBUG && _d($dbh, 'Connected dbh to', $self->{name});
3701
3702 return $self->set_dbh($dbh);
3703}
3704
3705sub set_dbh {
3706 my ($self, $dbh) = @_;
3707
3708 if ( $self->{dbh} && $self->{dbh} == $dbh && $self->{dbh_set} ) {
3709 PTDEBUG && _d($dbh, 'Already set dbh');
3710 return $dbh;
3711 }
3712
3713 PTDEBUG && _d($dbh, 'Setting dbh');
3714
3715 $dbh->{FetchHashKeyName} = 'NAME_lc';
3716
3717 my $sql = 'SELECT @@hostname, @@server_id';
3718 PTDEBUG && _d($dbh, $sql);
3719 my ($hostname, $server_id) = $dbh->selectrow_array($sql);
3720 PTDEBUG && _d($dbh, 'hostname:', $hostname, $server_id);
3721 if ( $hostname ) {
3722 $self->{hostname} = $hostname;
3723 }
3724
3725 if ( my $set = $self->{set}) {
3726 $set->($dbh);
3727 }
3728
3729 $self->{dbh} = $dbh;
3730 $self->{dbh_set} = 1;
3731 return $dbh;
3732}
3733
3734sub dbh {
3735 my ($self) = @_;
3736 return $self->{dbh};
3737}
3738
3739sub dsn {
3740 my ($self) = @_;
3741 return $self->{dsn};
3742}
3743
3744sub name {
3745 my ($self) = @_;
3746 return $self->{dsn_name} if PERCONA_TOOLKIT_TEST_USE_DSN_NAMES;
3747 return $self->{hostname} || $self->{dsn_name} || 'unknown host';
3748}
3749
3750sub DESTROY {
3751 my ($self) = @_;
3752 if ( $self->{dbh} ) {
3753 PTDEBUG && _d('Disconnecting dbh', $self->{dbh}, $self->{name});
3754 $self->{dbh}->disconnect();
3755 }
3756 return;
3757}
3758
3759sub _d {
3760 my ($package, undef, $line) = caller 0;
3761 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
3762 map { defined $_ ? $_ : 'undef' }
3763 @_;
3764 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
3765}
3766
37671;
3768}
3769# ###########################################################################
3770# End Cxn package
3771# ###########################################################################
3772
3773# ###########################################################################
3774# MasterSlave package
3775# This package is a copy without comments from the original. The original
3776# with comments and its test file can be found in the Bazaar repository at,
3777# lib/MasterSlave.pm
3778# t/lib/MasterSlave.t
3779# See https://launchpad.net/percona-toolkit for more information.
3780# ###########################################################################
3781{
3782package MasterSlave;
3783
3784use strict;
3785use warnings FATAL => 'all';
3786use English qw(-no_match_vars);
3787use constant PTDEBUG => $ENV{PTDEBUG} || 0;
3788
3789sub new {
3790 my ( $class, %args ) = @_;
3791 my $self = {
3792 %args,
3793 replication_thread => {},
3794 };
3795 return bless $self, $class;
3796}
3797
3798sub get_slaves {
3799 my ($self, %args) = @_;
3800 my @required_args = qw(make_cxn OptionParser DSNParser Quoter);
3801 foreach my $arg ( @required_args ) {
3802 die "I need a $arg argument" unless $args{$arg};
3803 }
3804 my ($make_cxn, $o, $dp) = @args{@required_args};
3805
3806 my $slaves = [];
3807 my $method = $o->get('recursion-method');
3808 PTDEBUG && _d('Slave recursion method:', $method);
3809 if ( !$method || $method =~ m/processlist|hosts/i ) {
3810 my @required_args = qw(dbh dsn);
3811 foreach my $arg ( @required_args ) {
3812 die "I need a $arg argument" unless $args{$arg};
3813 }
3814 my ($dbh, $dsn) = @args{@required_args};
3815 $self->recurse_to_slaves(
3816 { dbh => $dbh,
3817 dsn => $dsn,
3818 dsn_parser => $dp,
3819 recurse => $o->get('recurse'),
3820 method => $o->get('recursion-method'),
3821 callback => sub {
3822 my ( $dsn, $dbh, $level, $parent ) = @_;
3823 return unless $level;
3824 PTDEBUG && _d('Found slave:', $dp->as_string($dsn));
3825 push @$slaves, $make_cxn->(dsn => $dsn, dbh => $dbh);
3826 return;
3827 },
3828 }
3829 );
3830 }
3831 elsif ( $method =~ m/^dsn=/i ) {
3832 my ($dsn_table_dsn) = $method =~ m/^dsn=(.+)/i;
3833 $slaves = $self->get_cxn_from_dsn_table(
3834 %args,
3835 dsn_table_dsn => $dsn_table_dsn,
3836 );
3837 }
3838 else {
3839 die "Invalid --recursion-method: $method. Valid values are: "
3840 . "dsn=DSN, hosts, or processlist.\n";
3841 }
3842
3843 return $slaves;
3844}
3845
3846sub recurse_to_slaves {
3847 my ( $self, $args, $level ) = @_;
3848 $level ||= 0;
3849 my $dp = $args->{dsn_parser};
3850 my $dsn = $args->{dsn};
3851
3852 my $dbh;
3853 eval {
3854 $dbh = $args->{dbh} || $dp->get_dbh(
3855 $dp->get_cxn_params($dsn), { AutoCommit => 1 });
3856 PTDEBUG && _d('Connected to', $dp->as_string($dsn));
3857 };
3858 if ( $EVAL_ERROR ) {
3859 print STDERR "Cannot connect to ", $dp->as_string($dsn), "\n"
3860 or die "Cannot print: $OS_ERROR";
3861 return;
3862 }
3863
3864 my $sql = 'SELECT @@SERVER_ID';
3865 PTDEBUG && _d($sql);
3866 my ($id) = $dbh->selectrow_array($sql);
3867 PTDEBUG && _d('Working on server ID', $id);
3868 my $master_thinks_i_am = $dsn->{server_id};
3869 if ( !defined $id
3870 || ( defined $master_thinks_i_am && $master_thinks_i_am != $id )
3871 || $args->{server_ids_seen}->{$id}++
3872 ) {
3873 PTDEBUG && _d('Server ID seen, or not what master said');
3874 if ( $args->{skip_callback} ) {
3875 $args->{skip_callback}->($dsn, $dbh, $level, $args->{parent});
3876 }
3877 return;
3878 }
3879
3880 $args->{callback}->($dsn, $dbh, $level, $args->{parent});
3881
3882 if ( !defined $args->{recurse} || $level < $args->{recurse} ) {
3883
3884 my @slaves =
3885 grep { !$_->{master_id} || $_->{master_id} == $id } # Only my slaves.
3886 $self->find_slave_hosts($dp, $dbh, $dsn, $args->{method});
3887
3888 foreach my $slave ( @slaves ) {
3889 PTDEBUG && _d('Recursing from',
3890 $dp->as_string($dsn), 'to', $dp->as_string($slave));
3891 $self->recurse_to_slaves(
3892 { %$args, dsn => $slave, dbh => undef, parent => $dsn }, $level + 1 );
3893 }
3894 }
3895}
3896
3897sub find_slave_hosts {
3898 my ( $self, $dsn_parser, $dbh, $dsn, $method ) = @_;
3899
3900 my @methods = qw(processlist hosts);
3901 if ( $method ) {
3902 @methods = grep { $_ ne $method } @methods;
3903 unshift @methods, $method;
3904 }
3905 else {
3906 if ( ($dsn->{P} || 3306) != 3306 ) {
3907 PTDEBUG && _d('Port number is non-standard; using only hosts method');
3908 @methods = qw(hosts);
3909 }
3910 }
3911 PTDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn),
3912 'using methods', @methods);
3913
3914 my @slaves;
3915 METHOD:
3916 foreach my $method ( @methods ) {
3917 my $find_slaves = "_find_slaves_by_$method";
3918 PTDEBUG && _d('Finding slaves with', $find_slaves);
3919 @slaves = $self->$find_slaves($dsn_parser, $dbh, $dsn);
3920 last METHOD if @slaves;
3921 }
3922
3923 PTDEBUG && _d('Found', scalar(@slaves), 'slaves');
3924 return @slaves;
3925}
3926
3927sub _find_slaves_by_processlist {
3928 my ( $self, $dsn_parser, $dbh, $dsn ) = @_;
3929
3930 my @slaves = map {
3931 my $slave = $dsn_parser->parse("h=$_", $dsn);
3932 $slave->{source} = 'processlist';
3933 $slave;
3934 }
3935 grep { $_ }
3936 map {
3937 my ( $host ) = $_->{host} =~ m/^([^:]+):/;
3938 if ( $host eq 'localhost' ) {
3939 $host = '127.0.0.1'; # Replication never uses sockets.
3940 }
3941 $host;
3942 } $self->get_connected_slaves($dbh);
3943
3944 return @slaves;
3945}
3946
3947sub _find_slaves_by_hosts {
3948 my ( $self, $dsn_parser, $dbh, $dsn ) = @_;
3949
3950 my @slaves;
3951 my $sql = 'SHOW SLAVE HOSTS';
3952 PTDEBUG && _d($dbh, $sql);
3953 @slaves = @{$dbh->selectall_arrayref($sql, { Slice => {} })};
3954
3955 if ( @slaves ) {
3956 PTDEBUG && _d('Found some SHOW SLAVE HOSTS info');
3957 @slaves = map {
3958 my %hash;
3959 @hash{ map { lc $_ } keys %$_ } = values %$_;
3960 my $spec = "h=$hash{host},P=$hash{port}"
3961 . ( $hash{user} ? ",u=$hash{user}" : '')
3962 . ( $hash{password} ? ",p=$hash{password}" : '');
3963 my $dsn = $dsn_parser->parse($spec, $dsn);
3964 $dsn->{server_id} = $hash{server_id};
3965 $dsn->{master_id} = $hash{master_id};
3966 $dsn->{source} = 'hosts';
3967 $dsn;
3968 } @slaves;
3969 }
3970
3971 return @slaves;
3972}
3973
3974sub get_connected_slaves {
3975 my ( $self, $dbh ) = @_;
3976
3977 my $show = "SHOW GRANTS FOR ";
3978 my $user = 'CURRENT_USER()';
3979 my $vp = $self->{VersionParser};
3980 if ( $vp && !$vp->version_ge($dbh, '4.1.2') ) {
3981 $user = $dbh->selectrow_arrayref('SELECT USER()')->[0];
3982 $user =~ s/([^@]+)@(.+)/'$1'\@'$2'/;
3983 }
3984 my $sql = $show . $user;
3985 PTDEBUG && _d($dbh, $sql);
3986
3987 my $proc;
3988 eval {
3989 $proc = grep {
3990 m/ALL PRIVILEGES.*?\*\.\*|PROCESS/
3991 } @{$dbh->selectcol_arrayref($sql)};
3992 };
3993 if ( $EVAL_ERROR ) {
3994
3995 if ( $EVAL_ERROR =~ m/no such grant defined for user/ ) {
3996 PTDEBUG && _d('Retrying SHOW GRANTS without host; error:',
3997 $EVAL_ERROR);
3998 ($user) = split('@', $user);
3999 $sql = $show . $user;
4000 PTDEBUG && _d($sql);
4001 eval {
4002 $proc = grep {
4003 m/ALL PRIVILEGES.*?\*\.\*|PROCESS/
4004 } @{$dbh->selectcol_arrayref($sql)};
4005 };
4006 }
4007
4008 die "Failed to $sql: $EVAL_ERROR" if $EVAL_ERROR;
4009 }
4010 if ( !$proc ) {
4011 die "You do not have the PROCESS privilege";
4012 }
4013
4014 $sql = 'SHOW PROCESSLIST';
4015 PTDEBUG && _d($dbh, $sql);
4016 grep { $_->{command} =~ m/Binlog Dump/i }
4017 map { # Lowercase the column names
4018 my %hash;
4019 @hash{ map { lc $_ } keys %$_ } = values %$_;
4020 \%hash;
4021 }
4022 @{$dbh->selectall_arrayref($sql, { Slice => {} })};
4023}
4024
4025sub is_master_of {
4026 my ( $self, $master, $slave ) = @_;
4027 my $master_status = $self->get_master_status($master)
4028 or die "The server specified as a master is not a master";
4029 my $slave_status = $self->get_slave_status($slave)
4030 or die "The server specified as a slave is not a slave";
4031 my @connected = $self->get_connected_slaves($master)
4032 or die "The server specified as a master has no connected slaves";
4033 my (undef, $port) = $master->selectrow_array('SHOW VARIABLES LIKE "port"');
4034
4035 if ( $port != $slave_status->{master_port} ) {
4036 die "The slave is connected to $slave_status->{master_port} "
4037 . "but the master's port is $port";
4038 }
4039
4040 if ( !grep { $slave_status->{master_user} eq $_->{user} } @connected ) {
4041 die "I don't see any slave I/O thread connected with user "
4042 . $slave_status->{master_user};
4043 }
4044
4045 if ( ($slave_status->{slave_io_state} || '')
4046 eq 'Waiting for master to send event' )
4047 {
4048 my ( $master_log_name, $master_log_num )
4049 = $master_status->{file} =~ m/^(.*?)\.0*([1-9][0-9]*)$/;
4050 my ( $slave_log_name, $slave_log_num )
4051 = $slave_status->{master_log_file} =~ m/^(.*?)\.0*([1-9][0-9]*)$/;
4052 if ( $master_log_name ne $slave_log_name
4053 || abs($master_log_num - $slave_log_num) > 1 )
4054 {
4055 die "The slave thinks it is reading from "
4056 . "$slave_status->{master_log_file}, but the "
4057 . "master is writing to $master_status->{file}";
4058 }
4059 }
4060 return 1;
4061}
4062
4063sub get_master_dsn {
4064 my ( $self, $dbh, $dsn, $dsn_parser ) = @_;
4065 my $master = $self->get_slave_status($dbh) or return undef;
4066 my $spec = "h=$master->{master_host},P=$master->{master_port}";
4067 return $dsn_parser->parse($spec, $dsn);
4068}
4069
4070sub get_slave_status {
4071 my ( $self, $dbh ) = @_;
4072 if ( !$self->{not_a_slave}->{$dbh} ) {
4073 my $sth = $self->{sths}->{$dbh}->{SLAVE_STATUS}
4074 ||= $dbh->prepare('SHOW SLAVE STATUS');
4075 PTDEBUG && _d($dbh, 'SHOW SLAVE STATUS');
4076 $sth->execute();
4077 my ($ss) = @{$sth->fetchall_arrayref({})};
4078
4079 if ( $ss && %$ss ) {
4080 $ss = { map { lc($_) => $ss->{$_} } keys %$ss }; # lowercase the keys
4081 return $ss;
4082 }
4083
4084 PTDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS');
4085 $self->{not_a_slave}->{$dbh}++;
4086 }
4087}
4088
4089sub get_master_status {
4090 my ( $self, $dbh ) = @_;
4091
4092 if ( $self->{not_a_master}->{$dbh} ) {
4093 PTDEBUG && _d('Server on dbh', $dbh, 'is not a master');
4094 return;
4095 }
4096
4097 my $sth = $self->{sths}->{$dbh}->{MASTER_STATUS}
4098 ||= $dbh->prepare('SHOW MASTER STATUS');
4099 PTDEBUG && _d($dbh, 'SHOW MASTER STATUS');
4100 $sth->execute();
4101 my ($ms) = @{$sth->fetchall_arrayref({})};
4102 PTDEBUG && _d(
4103 $ms ? map { "$_=" . (defined $ms->{$_} ? $ms->{$_} : '') } keys %$ms
4104 : '');
4105
4106 if ( !$ms || scalar keys %$ms < 2 ) {
4107 PTDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master');
4108 $self->{not_a_master}->{$dbh}++;
4109 }
4110
4111 return { map { lc($_) => $ms->{$_} } keys %$ms }; # lowercase the keys
4112}
4113
4114sub wait_for_master {
4115 my ( $self, %args ) = @_;
4116 my @required_args = qw(master_status slave_dbh);
4117 foreach my $arg ( @required_args ) {
4118 die "I need a $arg argument" unless $args{$arg};
4119 }
4120 my ($master_status, $slave_dbh) = @args{@required_args};
4121 my $timeout = $args{timeout} || 60;
4122
4123 my $result;
4124 my $waited;
4125 if ( $master_status ) {
4126 my $sql = "SELECT MASTER_POS_WAIT('$master_status->{file}', "
4127 . "$master_status->{position}, $timeout)";
4128 PTDEBUG && _d($slave_dbh, $sql);
4129 my $start = time;
4130 ($result) = $slave_dbh->selectrow_array($sql);
4131
4132 $waited = time - $start;
4133
4134 PTDEBUG && _d('Result of waiting:', $result);
4135 PTDEBUG && _d("Waited", $waited, "seconds");
4136 }
4137 else {
4138 PTDEBUG && _d('Not waiting: this server is not a master');
4139 }
4140
4141 return {
4142 result => $result,
4143 waited => $waited,
4144 };
4145}
4146
4147sub stop_slave {
4148 my ( $self, $dbh ) = @_;
4149 my $sth = $self->{sths}->{$dbh}->{STOP_SLAVE}
4150 ||= $dbh->prepare('STOP SLAVE');
4151 PTDEBUG && _d($dbh, $sth->{Statement});
4152 $sth->execute();
4153}
4154
4155sub start_slave {
4156 my ( $self, $dbh, $pos ) = @_;
4157 if ( $pos ) {
4158 my $sql = "START SLAVE UNTIL MASTER_LOG_FILE='$pos->{file}', "
4159 . "MASTER_LOG_POS=$pos->{position}";
4160 PTDEBUG && _d($dbh, $sql);
4161 $dbh->do($sql);
4162 }
4163 else {
4164 my $sth = $self->{sths}->{$dbh}->{START_SLAVE}
4165 ||= $dbh->prepare('START SLAVE');
4166 PTDEBUG && _d($dbh, $sth->{Statement});
4167 $sth->execute();
4168 }
4169}
4170
4171sub catchup_to_master {
4172 my ( $self, $slave, $master, $timeout ) = @_;
4173 $self->stop_slave($master);
4174 $self->stop_slave($slave);
4175 my $slave_status = $self->get_slave_status($slave);
4176 my $slave_pos = $self->repl_posn($slave_status);
4177 my $master_status = $self->get_master_status($master);
4178 my $master_pos = $self->repl_posn($master_status);
4179 PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos),
4180 'Slave position:', $self->pos_to_string($slave_pos));
4181
4182 my $result;
4183 if ( $self->pos_cmp($slave_pos, $master_pos) < 0 ) {
4184 PTDEBUG && _d('Waiting for slave to catch up to master');
4185 $self->start_slave($slave, $master_pos);
4186
4187 $result = $self->wait_for_master(
4188 master_status => $master_status,
4189 slave_dbh => $slave,
4190 timeout => $timeout,
4191 master_status => $master_status
4192 );
4193 if ( !defined $result->{result} ) {
4194 $slave_status = $self->get_slave_status($slave);
4195 if ( !$self->slave_is_running($slave_status) ) {
4196 PTDEBUG && _d('Master position:',
4197 $self->pos_to_string($master_pos),
4198 'Slave position:', $self->pos_to_string($slave_pos));
4199 $slave_pos = $self->repl_posn($slave_status);
4200 if ( $self->pos_cmp($slave_pos, $master_pos) != 0 ) {
4201 die "MASTER_POS_WAIT() returned NULL but slave has not "
4202 . "caught up to master";
4203 }
4204 PTDEBUG && _d('Slave is caught up to master and stopped');
4205 }
4206 else {
4207 die "Slave has not caught up to master and it is still running";
4208 }
4209 }
4210 }
4211 else {
4212 PTDEBUG && _d("Slave is already caught up to master");
4213 }
4214
4215 return $result;
4216}
4217
4218sub catchup_to_same_pos {
4219 my ( $self, $s1_dbh, $s2_dbh ) = @_;
4220 $self->stop_slave($s1_dbh);
4221 $self->stop_slave($s2_dbh);
4222 my $s1_status = $self->get_slave_status($s1_dbh);
4223 my $s2_status = $self->get_slave_status($s2_dbh);
4224 my $s1_pos = $self->repl_posn($s1_status);
4225 my $s2_pos = $self->repl_posn($s2_status);
4226 if ( $self->pos_cmp($s1_pos, $s2_pos) < 0 ) {
4227 $self->start_slave($s1_dbh, $s2_pos);
4228 }
4229 elsif ( $self->pos_cmp($s2_pos, $s1_pos) < 0 ) {
4230 $self->start_slave($s2_dbh, $s1_pos);
4231 }
4232
4233 $s1_status = $self->get_slave_status($s1_dbh);
4234 $s2_status = $self->get_slave_status($s2_dbh);
4235 $s1_pos = $self->repl_posn($s1_status);
4236 $s2_pos = $self->repl_posn($s2_status);
4237
4238 if ( $self->slave_is_running($s1_status)
4239 || $self->slave_is_running($s2_status)
4240 || $self->pos_cmp($s1_pos, $s2_pos) != 0)
4241 {
4242 die "The servers aren't both stopped at the same position";
4243 }
4244
4245}
4246
4247sub slave_is_running {
4248 my ( $self, $slave_status ) = @_;
4249 return ($slave_status->{slave_sql_running} || 'No') eq 'Yes';
4250}
4251
4252sub has_slave_updates {
4253 my ( $self, $dbh ) = @_;
4254 my $sql = q{SHOW VARIABLES LIKE 'log_slave_updates'};
4255 PTDEBUG && _d($dbh, $sql);
4256 my ($name, $value) = $dbh->selectrow_array($sql);
4257 return $value && $value =~ m/^(1|ON)$/;
4258}
4259
4260sub repl_posn {
4261 my ( $self, $status ) = @_;
4262 if ( exists $status->{file} && exists $status->{position} ) {
4263 return {
4264 file => $status->{file},
4265 position => $status->{position},
4266 };
4267 }
4268 else {
4269 return {
4270 file => $status->{relay_master_log_file},
4271 position => $status->{exec_master_log_pos},
4272 };
4273 }
4274}
4275
4276sub get_slave_lag {
4277 my ( $self, $dbh ) = @_;
4278 my $stat = $self->get_slave_status($dbh);
4279 return unless $stat; # server is not a slave
4280 return $stat->{seconds_behind_master};
4281}
4282
4283sub pos_cmp {
4284 my ( $self, $a, $b ) = @_;
4285 return $self->pos_to_string($a) cmp $self->pos_to_string($b);
4286}
4287
4288sub short_host {
4289 my ( $self, $dsn ) = @_;
4290 my ($host, $port);
4291 if ( $dsn->{master_host} ) {
4292 $host = $dsn->{master_host};
4293 $port = $dsn->{master_port};
4294 }
4295 else {
4296 $host = $dsn->{h};
4297 $port = $dsn->{P};
4298 }
4299 return ($host || '[default]') . ( ($port || 3306) == 3306 ? '' : ":$port" );
4300}
4301
4302sub is_replication_thread {
4303 my ( $self, $query, %args ) = @_;
4304 return unless $query;
4305
4306 my $type = lc($args{type} || 'all');
4307 die "Invalid type: $type"
4308 unless $type =~ m/^binlog_dump|slave_io|slave_sql|all$/i;
4309
4310 my $match = 0;
4311 if ( $type =~ m/binlog_dump|all/i ) {
4312 $match = 1
4313 if ($query->{Command} || $query->{command} || '') eq "Binlog Dump";
4314 }
4315 if ( !$match ) {
4316 if ( ($query->{User} || $query->{user} || '') eq "system user" ) {
4317 PTDEBUG && _d("Slave replication thread");
4318 if ( $type ne 'all' ) {
4319 my $state = $query->{State} || $query->{state} || '';
4320
4321 if ( $state =~ m/^init|end$/ ) {
4322 PTDEBUG && _d("Special state:", $state);
4323 $match = 1;
4324 }
4325 else {
4326 my ($slave_sql) = $state =~ m/
4327 ^(Waiting\sfor\sthe\snext\sevent
4328 |Reading\sevent\sfrom\sthe\srelay\slog
4329 |Has\sread\sall\srelay\slog;\swaiting
4330 |Making\stemp\sfile
4331 |Waiting\sfor\sslave\smutex\son\sexit)/xi;
4332
4333 $match = $type eq 'slave_sql' && $slave_sql ? 1
4334 : $type eq 'slave_io' && !$slave_sql ? 1
4335 : 0;
4336 }
4337 }
4338 else {
4339 $match = 1;
4340 }
4341 }
4342 else {
4343 PTDEBUG && _d('Not system user');
4344 }
4345
4346 if ( !defined $args{check_known_ids} || $args{check_known_ids} ) {
4347 my $id = $query->{Id} || $query->{id};
4348 if ( $match ) {
4349 $self->{replication_thread}->{$id} = 1;
4350 }
4351 else {
4352 if ( $self->{replication_thread}->{$id} ) {
4353 PTDEBUG && _d("Thread ID is a known replication thread ID");
4354 $match = 1;
4355 }
4356 }
4357 }
4358 }
4359
4360 PTDEBUG && _d('Matches', $type, 'replication thread:',
4361 ($match ? 'yes' : 'no'), '; match:', $match);
4362
4363 return $match;
4364}
4365
4366
4367sub get_replication_filters {
4368 my ( $self, %args ) = @_;
4369 my @required_args = qw(dbh);
4370 foreach my $arg ( @required_args ) {
4371 die "I need a $arg argument" unless $args{$arg};
4372 }
4373 my ($dbh) = @args{@required_args};
4374
4375 my %filters = ();
4376
4377 my $status = $self->get_master_status($dbh);
4378 if ( $status ) {
4379 map { $filters{$_} = $status->{$_} }
4380 grep { defined $status->{$_} && $status->{$_} ne '' }
4381 qw(
4382 binlog_do_db
4383 binlog_ignore_db
4384 );
4385 }
4386
4387 $status = $self->get_slave_status($dbh);
4388 if ( $status ) {
4389 map { $filters{$_} = $status->{$_} }
4390 grep { defined $status->{$_} && $status->{$_} ne '' }
4391 qw(
4392 replicate_do_db
4393 replicate_ignore_db
4394 replicate_do_table
4395 replicate_ignore_table
4396 replicate_wild_do_table
4397 replicate_wild_ignore_table
4398 );
4399
4400 my $sql = "SHOW VARIABLES LIKE 'slave_skip_errors'";
4401 PTDEBUG && _d($dbh, $sql);
4402 my $row = $dbh->selectrow_arrayref($sql);
4403 $filters{slave_skip_errors} = $row->[1] if $row->[1] && $row->[1] ne 'OFF';
4404 }
4405
4406 return \%filters;
4407}
4408
4409
4410sub pos_to_string {
4411 my ( $self, $pos ) = @_;
4412 my $fmt = '%s/%020d';
4413 return sprintf($fmt, @{$pos}{qw(file position)});
4414}
4415
4416sub reset_known_replication_threads {
4417 my ( $self ) = @_;
4418 $self->{replication_thread} = {};
4419 return;
4420}
4421
4422sub get_cxn_from_dsn_table {
4423 my ($self, %args) = @_;
4424 my @required_args = qw(dsn_table_dsn make_cxn DSNParser Quoter);
4425 foreach my $arg ( @required_args ) {
4426 die "I need a $arg argument" unless $args{$arg};
4427 }
4428 my ($dsn_table_dsn, $make_cxn, $dp, $q) = @args{@required_args};
4429 PTDEBUG && _d('DSN table DSN:', $dsn_table_dsn);
4430
4431 my $dsn = $dp->parse($dsn_table_dsn);
4432 my $dsn_table;
4433 if ( $dsn->{D} && $dsn->{t} ) {
4434 $dsn_table = $q->quote($dsn->{D}, $dsn->{t});
4435 }
4436 elsif ( $dsn->{t} && $dsn->{t} =~ m/\./ ) {
4437 $dsn_table = $q->quote($q->split_unquote($dsn->{t}));
4438 }
4439 else {
4440 die "DSN table DSN does not specify a database (D) "
4441 . "or a database-qualified table (t)";
4442 }
4443
4444 my $dsn_tbl_cxn = $make_cxn->(dsn => $dsn);
4445 my $dbh = $dsn_tbl_cxn->connect();
4446 my $sql = "SELECT dsn FROM $dsn_table ORDER BY id";
4447 PTDEBUG && _d($sql);
4448 my $dsn_strings = $dbh->selectcol_arrayref($sql);
4449 my @cxn;
4450 if ( $dsn_strings ) {
4451 foreach my $dsn_string ( @$dsn_strings ) {
4452 PTDEBUG && _d('DSN from DSN table:', $dsn_string);
4453 push @cxn, $make_cxn->(dsn_string => $dsn_string);
4454 }
4455 }
4456 return \@cxn;
4457}
4458
4459sub _d {
4460 my ($package, undef, $line) = caller 0;
4461 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
4462 map { defined $_ ? $_ : 'undef' }
4463 @_;
4464 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
4465}
4466
44671;
4468}
4469# ###########################################################################
4470# End MasterSlave package
4471# ###########################################################################
4472
4473# ###########################################################################
4474# ReplicaLagWaiter package
4475# This package is a copy without comments from the original. The original
4476# with comments and its test file can be found in the Bazaar repository at,
4477# lib/ReplicaLagWaiter.pm
4478# t/lib/ReplicaLagWaiter.t
4479# See https://launchpad.net/percona-toolkit for more information.
4480# ###########################################################################
4481{
4482package ReplicaLagWaiter;
4483
4484use strict;
4485use warnings FATAL => 'all';
4486use English qw(-no_match_vars);
4487use constant PTDEBUG => $ENV{PTDEBUG} || 0;
4488
4489use Time::HiRes qw(sleep time);
4490use Data::Dumper;
4491
4492sub new {
4493 my ( $class, %args ) = @_;
4494 my @required_args = qw(oktorun get_lag sleep max_lag slaves);
4495 foreach my $arg ( @required_args ) {
4496 die "I need a $arg argument" unless defined $args{$arg};
4497 }
4498
4499 my $self = {
4500 %args,
4501 };
4502
4503 return bless $self, $class;
4504}
4505
4506sub wait {
4507 my ( $self, %args ) = @_;
4508 my @required_args = qw();
4509 foreach my $arg ( @required_args ) {
4510 die "I need a $arg argument" unless $args{$arg};
4511 }
4512 my $pr = $args{Progress};
4513
4514 my $oktorun = $self->{oktorun};
4515 my $get_lag = $self->{get_lag};
4516 my $sleep = $self->{sleep};
4517 my $slaves = $self->{slaves};
4518 my $max_lag = $self->{max_lag};
4519
4520 my $worst; # most lagging slave
4521 my $pr_callback;
4522 my $pr_first_report;
4523 if ( $pr ) {
4524 $pr_callback = sub {
4525 my ($fraction, $elapsed, $remaining, $eta, $completed) = @_;
4526 my $dsn_name = $worst->{cxn}->name();
4527 if ( defined $worst->{lag} ) {
4528 print STDERR "Replica lag is " . ($worst->{lag} || '?')
4529 . " seconds on $dsn_name. Waiting.\n";
4530 }
4531 else {
4532 print STDERR "Replica $dsn_name is stopped. Waiting.\n";
4533 }
4534 return;
4535 };
4536 $pr->set_callback($pr_callback);
4537
4538 $pr_first_report = sub {
4539 my $dsn_name = $worst->{cxn}->name();
4540 if ( !defined $worst->{lag} ) {
4541 print STDERR "Replica $dsn_name is stopped. Waiting.\n";
4542 }
4543 return;
4544 };
4545 }
4546
4547 my @lagged_slaves = map { {cxn=>$_, lag=>undef} } @$slaves;
4548 while ( $oktorun->() && @lagged_slaves ) {
4549 PTDEBUG && _d('Checking slave lag');
4550 for my $i ( 0..$#lagged_slaves ) {
4551 my $lag = $get_lag->($lagged_slaves[$i]->{cxn});
4552 PTDEBUG && _d($lagged_slaves[$i]->{cxn}->name(),
4553 'slave lag:', $lag);
4554 if ( !defined $lag || $lag > $max_lag ) {
4555 $lagged_slaves[$i]->{lag} = $lag;
4556 }
4557 else {
4558 delete $lagged_slaves[$i];
4559 }
4560 }
4561
4562 @lagged_slaves = grep { defined $_ } @lagged_slaves;
4563 if ( @lagged_slaves ) {
4564 @lagged_slaves = reverse sort {
4565 defined $a->{lag} && defined $b->{lag} ? $a->{lag} <=> $b->{lag}
4566 : defined $a->{lag} ? -1
4567 : 1;
4568 } @lagged_slaves;
4569 $worst = $lagged_slaves[0];
4570 PTDEBUG && _d(scalar @lagged_slaves, 'slaves are lagging, worst:',
4571 $worst->{lag}, 'on', Dumper($worst->{cxn}->dsn()));
4572
4573 if ( $pr ) {
4574 $pr->update(
4575 sub { return 0; },
4576 first_report => $pr_first_report,
4577 );
4578 }
4579
4580 PTDEBUG && _d('Calling sleep callback');
4581 $sleep->($worst->{cxn}, $worst->{lag});
4582 }
4583 }
4584
4585 PTDEBUG && _d('All slaves caught up');
4586 return;
4587}
4588
4589sub _d {
4590 my ($package, undef, $line) = caller 0;
4591 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
4592 map { defined $_ ? $_ : 'undef' }
4593 @_;
4594 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
4595}
4596
45971;
4598}
4599# ###########################################################################
4600# End ReplicaLagWaiter package
4601# ###########################################################################
4602
4603# ###########################################################################
4604# MySQLStatusWaiter package
4605# This package is a copy without comments from the original. The original
4606# with comments and its test file can be found in the Bazaar repository at,
4607# lib/MySQLStatusWaiter.pm
4608# t/lib/MySQLStatusWaiter.t
4609# See https://launchpad.net/percona-toolkit for more information.
4610# ###########################################################################
4611{
4612package MySQLStatusWaiter;
4613
4614use strict;
4615use warnings FATAL => 'all';
4616use English qw(-no_match_vars);
4617use constant PTDEBUG => $ENV{PTDEBUG} || 0;
4618
4619sub new {
4620 my ( $class, %args ) = @_;
4621 my @required_args = qw(max_spec get_status sleep oktorun);
4622 foreach my $arg ( @required_args ) {
4623 die "I need a $arg argument" unless defined $args{$arg};
4624 }
4625
4626 PTDEBUG && _d('Parsing spec for max thresholds');
4627 my $max_val_for = _parse_spec(
4628 spec => $args{max_spec},
4629 get_status => $args{get_status},
4630 threshold_factor => 0.2, # +20%
4631 );
4632
4633 PTDEBUG && _d('Parsing spec for critical thresholds');
4634 my $critical_val_for = _parse_spec(
4635 spec => $args{critical_spec} || [],
4636 get_status => $args{get_status},
4637 threshold_factor => 1.0, # double (x2; +100%)
4638 );
4639
4640 my $self = {
4641 get_status => $args{get_status},
4642 sleep => $args{sleep},
4643 oktorun => $args{oktorun},
4644 max_val_for => $max_val_for,
4645 critical_val_for => $critical_val_for,
4646 };
4647
4648 return bless $self, $class;
4649}
4650
4651sub _parse_spec {
4652 my ( %args ) = @_;
4653 my @required_args = qw(spec get_status);
4654 foreach my $arg ( @required_args ) {
4655 die "I need a $arg argument" unless defined $args{$arg};
4656 }
4657 my ($spec, $get_status) = @args{@required_args};
4658
4659 return unless $spec && scalar @$spec;
4660 my $threshold_factor = $args{threshold_factor} || 0.20;
4661
4662 my %max_val_for;
4663 foreach my $var_val ( @$spec ) {
4664 my ($var, $val) = split /[:=]/, $var_val;
4665 die "Invalid spec: $var_val" unless $var;
4666 if ( !$val ) {
4667 my $init_val = $get_status->($var);
4668 PTDEBUG && _d('Initial', $var, 'value:', $init_val);
4669 $val = int(($init_val * $threshold_factor) + $init_val);
4670 }
4671 PTDEBUG && _d('Wait if', $var, '>=', $val);
4672 $max_val_for{$var} = $val;
4673 }
4674
4675 return \%max_val_for;
4676}
4677
4678sub max_values {
4679 my ($self) = @_;
4680 return $self->{max_val_for};
4681}
4682
4683sub critical_values {
4684 my ($self) = @_;
4685 return $self->{critical_val_for};
4686}
4687
4688sub wait {
4689 my ( $self, %args ) = @_;
4690
4691 return unless $self->{max_val_for};
4692
4693 my $pr = $args{Progress}; # optional
4694
4695 my $oktorun = $self->{oktorun};
4696 my $get_status = $self->{get_status};
4697 my $sleep = $self->{sleep};
4698
4699 my %vals_too_high = %{$self->{max_val_for}};
4700 my $pr_callback;
4701 if ( $pr ) {
4702 $pr_callback = sub {
4703 print STDERR "Pausing because "
4704 . join(', ',
4705 map {
4706 "$_="
4707 . (defined $vals_too_high{$_} ? $vals_too_high{$_}
4708 : 'unknown')
4709 } sort keys %vals_too_high
4710 )
4711 . ".\n";
4712 return;
4713 };
4714 $pr->set_callback($pr_callback);
4715 }
4716
4717 while ( $oktorun->() ) {
4718 PTDEBUG && _d('Checking status variables');
4719 foreach my $var ( sort keys %vals_too_high ) {
4720 my $val = $get_status->($var);
4721 PTDEBUG && _d($var, '=', $val);
4722 if ( $val
4723 && exists $self->{critical_val_for}->{$var}
4724 && $val >= $self->{critical_val_for}->{$var} ) {
4725 die "$var=$val exceeds its critical threshold "
4726 . "$self->{critical_val_for}->{$var}\n";
4727 }
4728 if ( !$val || $val >= $self->{max_val_for}->{$var} ) {
4729 $vals_too_high{$var} = $val;
4730 }
4731 else {
4732 delete $vals_too_high{$var};
4733 }
4734 }
4735
4736 last unless scalar keys %vals_too_high;
4737
4738 PTDEBUG && _d(scalar keys %vals_too_high, 'values are too high:',
4739 %vals_too_high);
4740 if ( $pr ) {
4741 $pr->update(sub { return 0; });
4742 }
4743 PTDEBUG && _d('Calling sleep callback');
4744 $sleep->();
4745 %vals_too_high = %{$self->{max_val_for}}; # recheck all vars
4746 }
4747
4748 PTDEBUG && _d('All var vals are low enough');
4749 return;
4750}
4751
4752sub _d {
4753 my ($package, undef, $line) = caller 0;
4754 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
4755 map { defined $_ ? $_ : 'undef' }
4756 @_;
4757 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
4758}
4759
47601;
4761}
4762# ###########################################################################
4763# End MySQLStatusWaiter package
4764# ###########################################################################
4765
4766# ###########################################################################
4767# WeightedAvgRate package
4768# This package is a copy without comments from the original. The original
4769# with comments and its test file can be found in the Bazaar repository at,
4770# lib/WeightedAvgRate.pm
4771# t/lib/WeightedAvgRate.t
4772# See https://launchpad.net/percona-toolkit for more information.
4773# ###########################################################################
4774{
4775package WeightedAvgRate;
4776
4777use strict;
4778use warnings FATAL => 'all';
4779use English qw(-no_match_vars);
4780use constant PTDEBUG => $ENV{PTDEBUG} || 0;
4781
4782sub new {
4783 my ( $class, %args ) = @_;
4784 my @required_args = qw(target_t);
4785 foreach my $arg ( @required_args ) {
4786 die "I need a $arg argument" unless defined $args{$arg};
4787 }
4788
4789 my $self = {
4790 %args,
4791 avg_n => 0,
4792 avg_t => 0,
4793 weight => $args{weight} || 0.75,
4794 };
4795
4796 return bless $self, $class;
4797}
4798
4799sub update {
4800 my ($self, $n, $t) = @_;
4801 PTDEBUG && _d('Master op time:', $n, 'n /', $t, 's');
4802
4803 if ( $self->{avg_n} && $self->{avg_t} ) {
4804 $self->{avg_n} = ($self->{avg_n} * $self->{weight}) + $n;
4805 $self->{avg_t} = ($self->{avg_t} * $self->{weight}) + $t;
4806 $self->{avg_rate} = $self->{avg_n} / $self->{avg_t};
4807 PTDEBUG && _d('Weighted avg rate:', $self->{avg_rate}, 'n/s');
4808 }
4809 else {
4810 $self->{avg_n} = $n;
4811 $self->{avg_t} = $t;
4812 $self->{avg_rate} = $self->{avg_n} / $self->{avg_t};
4813 PTDEBUG && _d('Initial avg rate:', $self->{avg_rate}, 'n/s');
4814 }
4815
4816 my $new_n = int($self->{avg_rate} * $self->{target_t});
4817 PTDEBUG && _d('Adjust n to', $new_n);
4818 return $new_n;
4819}
4820
4821sub _d {
4822 my ($package, undef, $line) = caller 0;
4823 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
4824 map { defined $_ ? $_ : 'undef' }
4825 @_;
4826 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
4827}
4828
48291;
4830}
4831# ###########################################################################
4832# End WeightedAvgRate package
4833# ###########################################################################
4834
4835# ###########################################################################
4836# NibbleIterator package
4837# This package is a copy without comments from the original. The original
4838# with comments and its test file can be found in the Bazaar repository at,
4839# lib/NibbleIterator.pm
4840# t/lib/NibbleIterator.t
4841# See https://launchpad.net/percona-toolkit for more information.
4842# ###########################################################################
4843{
4844package NibbleIterator;
4845
4846use strict;
4847use warnings FATAL => 'all';
4848use English qw(-no_match_vars);
4849use constant PTDEBUG => $ENV{PTDEBUG} || 0;
4850
4851use Data::Dumper;
4852$Data::Dumper::Indent = 1;
4853$Data::Dumper::Sortkeys = 1;
4854$Data::Dumper::Quotekeys = 0;
4855
4856sub new {
4857 my ( $class, %args ) = @_;
4858 my @required_args = qw(Cxn tbl chunk_size OptionParser Quoter TableNibbler TableParser);
4859 foreach my $arg ( @required_args ) {
4860 die "I need a $arg argument" unless $args{$arg};
4861 }
4862 my ($cxn, $tbl, $chunk_size, $o, $q) = @args{@required_args};
4863
4864 my $nibble_params = can_nibble(%args);
4865
4866 my %comments = (
4867 bite => "bite table",
4868 nibble => "nibble table",
4869 );
4870 if ( $args{comments} ) {
4871 map { $comments{$_} = $args{comments}->{$_} }
4872 grep { defined $args{comments}->{$_} }
4873 keys %{$args{comments}};
4874 }
4875
4876 my $where = $o->has('where') ? $o->get('where') : '';
4877 my $tbl_struct = $tbl->{tbl_struct};
4878 my $ignore_col = $o->has('ignore-columns')
4879 ? ($o->get('ignore-columns') || {})
4880 : {};
4881 my $all_cols = $o->has('columns')
4882 ? ($o->get('columns') || $tbl_struct->{cols})
4883 : $tbl_struct->{cols};
4884 my @cols = grep { !$ignore_col->{$_} } @$all_cols;
4885 my $self;
4886 if ( $nibble_params->{one_nibble} ) {
4887 my $nibble_sql
4888 = ($args{dml} ? "$args{dml} " : "SELECT ")
4889 . ($args{select} ? $args{select}
4890 : join(', ', map { $q->quote($_) } @cols))
4891 . " FROM $tbl->{name}"
4892 . ($where ? " WHERE $where" : '')
4893 . " /*$comments{bite}*/";
4894 PTDEBUG && _d('One nibble statement:', $nibble_sql);
4895
4896 my $explain_nibble_sql
4897 = "EXPLAIN SELECT "
4898 . ($args{select} ? $args{select}
4899 : join(', ', map { $q->quote($_) } @cols))
4900 . " FROM $tbl->{name}"
4901 . ($where ? " WHERE $where" : '')
4902 . " /*explain $comments{bite}*/";
4903 PTDEBUG && _d('Explain one nibble statement:', $explain_nibble_sql);
4904
4905 $self = {
4906 %args,
4907 one_nibble => 1,
4908 limit => 0,
4909 nibble_sql => $nibble_sql,
4910 explain_nibble_sql => $explain_nibble_sql,
4911 };
4912 }
4913 else {
4914 my $index = $nibble_params->{index}; # brevity
4915 my $index_cols = $tbl->{tbl_struct}->{keys}->{$index}->{cols};
4916
4917 my $asc = $args{TableNibbler}->generate_asc_stmt(
4918 %args,
4919 tbl_struct => $tbl->{tbl_struct},
4920 index => $index,
4921 cols => \@cols,
4922 asc_only => 1,
4923 );
4924 PTDEBUG && _d('Ascend params:', Dumper($asc));
4925
4926 my $from = "$tbl->{name} FORCE INDEX(`$index`)";
4927 my $order_by = join(', ', map {$q->quote($_)} @{$index_cols});
4928
4929 my $first_lb_sql
4930 = "SELECT /*!40001 SQL_NO_CACHE */ "
4931 . join(', ', map { $q->quote($_) } @{$asc->{scols}})
4932 . " FROM $from"
4933 . ($where ? " WHERE $where" : '')
4934 . " ORDER BY $order_by"
4935 . " LIMIT 1"
4936 . " /*first lower boundary*/";
4937 PTDEBUG && _d('First lower boundary statement:', $first_lb_sql);
4938
4939 my $resume_lb_sql;
4940 if ( $args{resume} ) {
4941 $resume_lb_sql
4942 = "SELECT /*!40001 SQL_NO_CACHE */ "
4943 . join(', ', map { $q->quote($_) } @{$asc->{scols}})
4944 . " FROM $from"
4945 . " WHERE " . $asc->{boundaries}->{'>'}
4946 . ($where ? " AND ($where)" : '')
4947 . " ORDER BY $order_by"
4948 . " LIMIT 1"
4949 . " /*resume lower boundary*/";
4950 PTDEBUG && _d('Resume lower boundary statement:', $resume_lb_sql);
4951 }
4952
4953 my $last_ub_sql
4954 = "SELECT /*!40001 SQL_NO_CACHE */ "
4955 . join(', ', map { $q->quote($_) } @{$asc->{scols}})
4956 . " FROM $from"
4957 . ($where ? " WHERE $where" : '')
4958 . " ORDER BY "
4959 . join(' DESC, ', map {$q->quote($_)} @{$index_cols}) . ' DESC'
4960 . " LIMIT 1"
4961 . " /*last upper boundary*/";
4962 PTDEBUG && _d('Last upper boundary statement:', $last_ub_sql);
4963
4964 my $ub_sql
4965 = "SELECT /*!40001 SQL_NO_CACHE */ "
4966 . join(', ', map { $q->quote($_) } @{$asc->{scols}})
4967 . " FROM $from"
4968 . " WHERE " . $asc->{boundaries}->{'>='}
4969 . ($where ? " AND ($where)" : '')
4970 . " ORDER BY $order_by"
4971 . " LIMIT ?, 2"
4972 . " /*next chunk boundary*/";
4973 PTDEBUG && _d('Upper boundary statement:', $ub_sql);
4974
4975 my $nibble_sql
4976 = ($args{dml} ? "$args{dml} " : "SELECT ")
4977 . ($args{select} ? $args{select}
4978 : join(', ', map { $q->quote($_) } @{$asc->{cols}}))
4979 . " FROM $from"
4980 . " WHERE " . $asc->{boundaries}->{'>='} # lower boundary
4981 . " AND " . $asc->{boundaries}->{'<='} # upper boundary
4982 . ($where ? " AND ($where)" : '')
4983 . ($args{order_by} ? " ORDER BY $order_by" : "")
4984 . " /*$comments{nibble}*/";
4985 PTDEBUG && _d('Nibble statement:', $nibble_sql);
4986
4987 my $explain_nibble_sql
4988 = "EXPLAIN SELECT "
4989 . ($args{select} ? $args{select}
4990 : join(', ', map { $q->quote($_) } @{$asc->{cols}}))
4991 . " FROM $from"
4992 . " WHERE " . $asc->{boundaries}->{'>='} # lower boundary
4993 . " AND " . $asc->{boundaries}->{'<='} # upper boundary
4994 . ($where ? " AND ($where)" : '')
4995 . ($args{order_by} ? " ORDER BY $order_by" : "")
4996 . " /*explain $comments{nibble}*/";
4997 PTDEBUG && _d('Explain nibble statement:', $explain_nibble_sql);
4998
4999 my $limit = $chunk_size - 1;
5000 PTDEBUG && _d('Initial chunk size (LIMIT):', $limit);
5001
5002 $self = {
5003 %args,
5004 index => $index,
5005 limit => $limit,
5006 first_lb_sql => $first_lb_sql,
5007 last_ub_sql => $last_ub_sql,
5008 ub_sql => $ub_sql,
5009 nibble_sql => $nibble_sql,
5010 explain_ub_sql => "EXPLAIN $ub_sql",
5011 explain_nibble_sql => $explain_nibble_sql,
5012 resume_lb_sql => $resume_lb_sql,
5013 sql => {
5014 columns => $asc->{scols},
5015 from => $from,
5016 where => $where,
5017 boundaries => $asc->{boundaries},
5018 order_by => $order_by,
5019 },
5020 };
5021 }
5022
5023 $self->{row_est} = $nibble_params->{row_est},
5024 $self->{nibbleno} = 0;
5025 $self->{have_rows} = 0;
5026 $self->{rowno} = 0;
5027 $self->{oktonibble} = 1;
5028
5029 return bless $self, $class;
5030}
5031
5032sub next {
5033 my ($self) = @_;
5034
5035 if ( !$self->{oktonibble} ) {
5036 PTDEBUG && _d('Not ok to nibble');
5037 return;
5038 }
5039
5040 my %callback_args = (
5041 Cxn => $self->{Cxn},
5042 tbl => $self->{tbl},
5043 NibbleIterator => $self,
5044 );
5045
5046 if ($self->{nibbleno} == 0) {
5047 $self->_prepare_sths();
5048 $self->_get_bounds();
5049 if ( my $callback = $self->{callbacks}->{init} ) {
5050 $self->{oktonibble} = $callback->(%callback_args);
5051 PTDEBUG && _d('init callback returned', $self->{oktonibble});
5052 if ( !$self->{oktonibble} ) {
5053 $self->{no_more_boundaries} = 1;
5054 return;
5055 }
5056 }
5057 }
5058
5059 NIBBLE:
5060 while ( $self->{have_rows} || $self->_next_boundaries() ) {
5061 if ( !$self->{have_rows} ) {
5062 $self->{nibbleno}++;
5063 PTDEBUG && _d($self->{nibble_sth}->{Statement}, 'params:',
5064 join(', ', (@{$self->{lower}}, @{$self->{upper}})));
5065 if ( my $callback = $self->{callbacks}->{exec_nibble} ) {
5066 $self->{have_rows} = $callback->(%callback_args);
5067 }
5068 else {
5069 $self->{nibble_sth}->execute(@{$self->{lower}}, @{$self->{upper}});
5070 $self->{have_rows} = $self->{nibble_sth}->rows();
5071 }
5072 PTDEBUG && _d($self->{have_rows}, 'rows in nibble', $self->{nibbleno});
5073 }
5074
5075 if ( $self->{have_rows} ) {
5076 my $row = $self->{nibble_sth}->fetchrow_arrayref();
5077 if ( $row ) {
5078 $self->{rowno}++;
5079 PTDEBUG && _d('Row', $self->{rowno}, 'in nibble',$self->{nibbleno});
5080 return [ @$row ];
5081 }
5082 }
5083
5084 PTDEBUG && _d('No rows in nibble or nibble skipped');
5085 if ( my $callback = $self->{callbacks}->{after_nibble} ) {
5086 $callback->(%callback_args);
5087 }
5088 $self->{rowno} = 0;
5089 $self->{have_rows} = 0;
5090 }
5091
5092 PTDEBUG && _d('Done nibbling');
5093 if ( my $callback = $self->{callbacks}->{done} ) {
5094 $callback->(%callback_args);
5095 }
5096
5097 return;
5098}
5099
5100sub nibble_number {
5101 my ($self) = @_;
5102 return $self->{nibbleno};
5103}
5104
5105sub set_nibble_number {
5106 my ($self, $n) = @_;
5107 die "I need a number" unless $n;
5108 $self->{nibbleno} = $n;
5109 PTDEBUG && _d('Set new nibble number:', $n);
5110 return;
5111}
5112
5113sub nibble_index {
5114 my ($self) = @_;
5115 return $self->{index};
5116}
5117
5118sub statements {
5119 my ($self) = @_;
5120 return {
5121 nibble => $self->{nibble_sth},
5122 explain_nibble => $self->{explain_nibble_sth},
5123 upper_boundary => $self->{ub_sth},
5124 explain_upper_boundary => $self->{explain_ub_sth},
5125 }
5126}
5127
5128sub boundaries {
5129 my ($self) = @_;
5130 return {
5131 first_lower => $self->{first_lower},
5132 lower => $self->{lower},
5133 upper => $self->{upper},
5134 next_lower => $self->{next_lower},
5135 last_upper => $self->{last_upper},
5136 };
5137}
5138
5139sub set_boundary {
5140 my ($self, $boundary, $values) = @_;
5141 die "I need a boundary parameter"
5142 unless $boundary;
5143 die "Invalid boundary: $boundary"
5144 unless $boundary =~ m/^(?:lower|upper|next_lower|last_upper)$/;
5145 die "I need a values arrayref parameter"
5146 unless $values && ref $values eq 'ARRAY';
5147 $self->{$boundary} = $values;
5148 PTDEBUG && _d('Set new', $boundary, 'boundary:', Dumper($values));
5149 return;
5150}
5151
5152sub one_nibble {
5153 my ($self) = @_;
5154 return $self->{one_nibble};
5155}
5156
5157sub chunk_size {
5158 my ($self) = @_;
5159 return $self->{limit} + 1;
5160}
5161
5162sub set_chunk_size {
5163 my ($self, $limit) = @_;
5164 return if $self->{one_nibble};
5165 die "Chunk size must be > 0" unless $limit;
5166 $self->{limit} = $limit - 1;
5167 PTDEBUG && _d('Set new chunk size (LIMIT):', $limit);
5168 return;
5169}
5170
5171sub sql {
5172 my ($self) = @_;
5173 return $self->{sql};
5174}
5175
5176sub more_boundaries {
5177 my ($self) = @_;
5178 return !$self->{no_more_boundaries};
5179}
5180
5181sub row_estimate {
5182 my ($self) = @_;
5183 return $self->{row_est};
5184}
5185
5186sub can_nibble {
5187 my (%args) = @_;
5188 my @required_args = qw(Cxn tbl chunk_size OptionParser TableParser);
5189 foreach my $arg ( @required_args ) {
5190 die "I need a $arg argument" unless $args{$arg};
5191 }
5192 my ($cxn, $tbl, $chunk_size, $o) = @args{@required_args};
5193
5194 my ($row_est, $mysql_index) = get_row_estimate(
5195 Cxn => $cxn,
5196 tbl => $tbl,
5197 where => $o->has('where') ? $o->get('where') : '',
5198 );
5199
5200 my $one_nibble = !defined $args{one_nibble} || $args{one_nibble}
5201 ? $row_est <= $chunk_size * $o->get('chunk-size-limit')
5202 : 0;
5203 PTDEBUG && _d('One nibble:', $one_nibble ? 'yes' : 'no');
5204
5205 if ( $args{resume}
5206 && !defined $args{resume}->{lower_boundary}
5207 && !defined $args{resume}->{upper_boundary} ) {
5208 PTDEBUG && _d('Resuming from one nibble table');
5209 $one_nibble = 1;
5210 }
5211
5212 my $index = _find_best_index(%args, mysql_index => $mysql_index);
5213 if ( !$index && !$one_nibble ) {
5214 die "There is no good index and the table is oversized.";
5215 }
5216
5217 return {
5218 row_est => $row_est, # nibble about this many rows
5219 index => $index, # using this index
5220 one_nibble => $one_nibble, # if the table fits in one nibble/chunk
5221 };
5222}
5223
5224sub _find_best_index {
5225 my (%args) = @_;
5226 my @required_args = qw(Cxn tbl TableParser);
5227 my ($cxn, $tbl, $tp) = @args{@required_args};
5228 my $tbl_struct = $tbl->{tbl_struct};
5229 my $indexes = $tbl_struct->{keys};
5230
5231 my $want_index = $args{chunk_index};
5232 if ( $want_index ) {
5233 PTDEBUG && _d('User wants to use index', $want_index);
5234 if ( !exists $indexes->{$want_index} ) {
5235 PTDEBUG && _d('Cannot use user index because it does not exist');
5236 $want_index = undef;
5237 }
5238 }
5239
5240 if ( !$want_index && $args{mysql_index} ) {
5241 PTDEBUG && _d('MySQL wants to use index', $args{mysql_index});
5242 $want_index = $args{mysql_index};
5243 }
5244
5245 my $best_index;
5246 my @possible_indexes;
5247 if ( $want_index ) {
5248 if ( $indexes->{$want_index}->{is_unique} ) {
5249 PTDEBUG && _d('Will use wanted index');
5250 $best_index = $want_index;
5251 }
5252 else {
5253 PTDEBUG && _d('Wanted index is a possible index');
5254 push @possible_indexes, $want_index;
5255 }
5256 }
5257 else {
5258 PTDEBUG && _d('Auto-selecting best index');
5259 foreach my $index ( $tp->sort_indexes($tbl_struct) ) {
5260 if ( $index eq 'PRIMARY' || $indexes->{$index}->{is_unique} ) {
5261 $best_index = $index;
5262 last;
5263 }
5264 else {
5265 push @possible_indexes, $index;
5266 }
5267 }
5268 }
5269
5270 if ( !$best_index && @possible_indexes ) {
5271 PTDEBUG && _d('No PRIMARY or unique indexes;',
5272 'will use index with highest cardinality');
5273 foreach my $index ( @possible_indexes ) {
5274 $indexes->{$index}->{cardinality} = _get_index_cardinality(
5275 %args,
5276 index => $index,
5277 );
5278 }
5279 @possible_indexes = sort {
5280 my $cmp
5281 = $indexes->{$b}->{cardinality} <=> $indexes->{$b}->{cardinality};
5282 if ( $cmp == 0 ) {
5283 $cmp = scalar @{$indexes->{$b}->{cols}}
5284 <=> scalar @{$indexes->{$a}->{cols}};
5285 }
5286 $cmp;
5287 } @possible_indexes;
5288 $best_index = $possible_indexes[0];
5289 }
5290
5291 PTDEBUG && _d('Best index:', $best_index);
5292 return $best_index;
5293}
5294
5295sub _get_index_cardinality {
5296 my (%args) = @_;
5297 my @required_args = qw(Cxn tbl index);
5298 my ($cxn, $tbl, $index) = @args{@required_args};
5299
5300 my $sql = "SHOW INDEXES FROM $tbl->{name} "
5301 . "WHERE Key_name = '$index'";
5302 PTDEBUG && _d($sql);
5303 my $cardinality = 1;
5304 my $rows = $cxn->dbh()->selectall_hashref($sql, 'key_name');
5305 foreach my $row ( values %$rows ) {
5306 $cardinality *= $row->{cardinality} if $row->{cardinality};
5307 }
5308 PTDEBUG && _d('Index', $index, 'cardinality:', $cardinality);
5309 return $cardinality;
5310}
5311
5312sub get_row_estimate {
5313 my (%args) = @_;
5314 my @required_args = qw(Cxn tbl);
5315 foreach my $arg ( @required_args ) {
5316 die "I need a $arg argument" unless $args{$arg};
5317 }
5318 my ($cxn, $tbl) = @args{@required_args};
5319
5320 if ( !$args{where} && exists $tbl->{tbl_status} ) {
5321 PTDEBUG && _d('Using table status for row estimate');
5322 return $tbl->{tbl_status}->{rows} || 0;
5323 }
5324 else {
5325 PTDEBUG && _d('Use EXPLAIN for row estimate');
5326 my $sql = "EXPLAIN SELECT * FROM $tbl->{name} "
5327 . "WHERE " . ($args{where} || '1=1');
5328 PTDEBUG && _d($sql);
5329 my $expl = $cxn->dbh()->selectrow_hashref($sql);
5330 PTDEBUG && _d(Dumper($expl));
5331 return ($expl->{rows} || 0), $expl->{key};
5332 }
5333}
5334
5335sub _prepare_sths {
5336 my ($self) = @_;
5337 PTDEBUG && _d('Preparing statement handles');
5338
5339 my $dbh = $self->{Cxn}->dbh();
5340
5341 $self->{nibble_sth} = $dbh->prepare($self->{nibble_sql});
5342 $self->{explain_nibble_sth} = $dbh->prepare($self->{explain_nibble_sql});
5343
5344 if ( !$self->{one_nibble} ) {
5345 $self->{ub_sth} = $dbh->prepare($self->{ub_sql});
5346 $self->{explain_ub_sth} = $dbh->prepare($self->{explain_ub_sql});
5347 }
5348
5349 return;
5350}
5351
5352sub _get_bounds {
5353 my ($self) = @_;
5354
5355 if ( $self->{one_nibble} ) {
5356 if ( $self->{resume} ) {
5357 $self->{no_more_boundaries} = 1;
5358 }
5359 return;
5360 }
5361
5362 my $dbh = $self->{Cxn}->dbh();
5363
5364 $self->{first_lower} = $dbh->selectrow_arrayref($self->{first_lb_sql});
5365 PTDEBUG && _d('First lower boundary:', Dumper($self->{first_lower}));
5366
5367 if ( my $nibble = $self->{resume} ) {
5368 if ( defined $nibble->{lower_boundary}
5369 && defined $nibble->{upper_boundary} ) {
5370 my $sth = $dbh->prepare($self->{resume_lb_sql});
5371 my @ub = split ',', $nibble->{upper_boundary};
5372 PTDEBUG && _d($sth->{Statement}, 'params:', @ub);
5373 $sth->execute(@ub);
5374 $self->{next_lower} = $sth->fetchrow_arrayref();
5375 $sth->finish();
5376 }
5377 }
5378 else {
5379 $self->{next_lower} = $self->{first_lower};
5380 }
5381 PTDEBUG && _d('Next lower boundary:', Dumper($self->{next_lower}));
5382
5383 if ( !$self->{next_lower} ) {
5384 PTDEBUG && _d('At end of table, or no more boundaries to resume');
5385 $self->{no_more_boundaries} = 1;
5386 }
5387
5388 return;
5389}
5390
5391sub _next_boundaries {
5392 my ($self) = @_;
5393
5394 if ( $self->{no_more_boundaries} ) {
5395 PTDEBUG && _d('No more boundaries');
5396 return; # stop nibbling
5397 }
5398
5399 if ( $self->{one_nibble} ) {
5400 $self->{lower} = $self->{upper} = [];
5401 $self->{no_more_boundaries} = 1; # for next call
5402 return 1; # continue nibbling
5403 }
5404
5405 if ( $self->identical_boundaries($self->{lower}, $self->{next_lower}) ) {
5406 PTDEBUG && _d('Infinite loop detected');
5407 my $tbl = $self->{tbl};
5408 my $index = $tbl->{tbl_struct}->{keys}->{$self->{index}};
5409 my $n_cols = scalar @{$index->{cols}};
5410 my $chunkno = $self->{nibbleno};
5411 die "Possible infinite loop detected! "
5412 . "The lower boundary for chunk $chunkno is "
5413 . "<" . join(', ', @{$self->{lower}}) . "> and the lower "
5414 . "boundary for chunk " . ($chunkno + 1) . " is also "
5415 . "<" . join(', ', @{$self->{next_lower}}) . ">. "
5416 . "This usually happens when using a non-unique single "
5417 . "column index. The current chunk index for table "
5418 . "$tbl->{db}.$tbl->{tbl} is $self->{index} which is"
5419 . ($index->{is_unique} ? '' : ' not') . " unique and covers "
5420 . ($n_cols > 1 ? "$n_cols columns" : "1 column") . ".\n";
5421 }
5422 $self->{lower} = $self->{next_lower};
5423
5424 if ( my $callback = $self->{callbacks}->{next_boundaries} ) {
5425 my $oktonibble = $callback->(
5426 Cxn => $self->{Cxn},
5427 tbl => $self->{tbl},
5428 NibbleIterator => $self,
5429 );
5430 PTDEBUG && _d('next_boundaries callback returned', $oktonibble);
5431 if ( !$oktonibble ) {
5432 $self->{no_more_boundaries} = 1;
5433 return; # stop nibbling
5434 }
5435 }
5436
5437 PTDEBUG && _d($self->{ub_sth}->{Statement}, 'params:',
5438 join(', ', @{$self->{lower}}), $self->{limit});
5439 $self->{ub_sth}->execute(@{$self->{lower}}, $self->{limit});
5440 my $boundary = $self->{ub_sth}->fetchall_arrayref();
5441 PTDEBUG && _d('Next boundary:', Dumper($boundary));
5442 if ( $boundary && @$boundary ) {
5443 $self->{upper} = $boundary->[0];
5444
5445 if ( $boundary->[1] ) {
5446 $self->{next_lower} = $boundary->[1];
5447 }
5448 else {
5449 PTDEBUG && _d('End of table boundary:', Dumper($boundary->[0]));
5450 $self->{no_more_boundaries} = 1; # for next call
5451
5452 $self->{last_upper} = $boundary->[0];
5453 }
5454 }
5455 else {
5456 my $dbh = $self->{Cxn}->dbh();
5457 $self->{upper} = $dbh->selectrow_arrayref($self->{last_ub_sql});
5458 PTDEBUG && _d('Last upper boundary:', Dumper($self->{upper}));
5459 $self->{no_more_boundaries} = 1; # for next call
5460
5461 $self->{last_upper} = $self->{upper};
5462 }
5463 $self->{ub_sth}->finish();
5464
5465 return 1; # continue nibbling
5466}
5467
5468sub identical_boundaries {
5469 my ($self, $b1, $b2) = @_;
5470
5471 return 0 if ($b1 && !$b2) || (!$b1 && $b2);
5472
5473 return 1 if !$b1 && !$b2;
5474
5475 die "Boundaries have different numbers of values"
5476 if scalar @$b1 != scalar @$b2; # shouldn't happen
5477 my $n_vals = scalar @$b1;
5478 for my $i ( 0..($n_vals-1) ) {
5479 return 0 if $b1->[$i] ne $b2->[$i]; # diff
5480 }
5481 return 1;
5482}
5483
5484sub DESTROY {
5485 my ( $self ) = @_;
5486 foreach my $key ( keys %$self ) {
5487 if ( $key =~ m/_sth$/ ) {
5488 PTDEBUG && _d('Finish', $key);
5489 $self->{$key}->finish();
5490 }
5491 }
5492 return;
5493}
5494
5495sub _d {
5496 my ($package, undef, $line) = caller 0;
5497 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
5498 map { defined $_ ? $_ : 'undef' }
5499 @_;
5500 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
5501}
5502
55031;
5504}
5505# ###########################################################################
5506# End NibbleIterator package
5507# ###########################################################################
5508
5509# ###########################################################################
5510# Transformers package
5511# This package is a copy without comments from the original. The original
5512# with comments and its test file can be found in the Bazaar repository at,
5513# lib/Transformers.pm
5514# t/lib/Transformers.t
5515# See https://launchpad.net/percona-toolkit for more information.
5516# ###########################################################################
5517{
5518package Transformers;
5519
5520use strict;
5521use warnings FATAL => 'all';
5522use English qw(-no_match_vars);
5523use constant PTDEBUG => $ENV{PTDEBUG} || 0;
5524
5525use Time::Local qw(timegm timelocal);
5526use Digest::MD5 qw(md5_hex);
5527
5528require Exporter;
5529our @ISA = qw(Exporter);
5530our %EXPORT_TAGS = ();
5531our @EXPORT = ();
5532our @EXPORT_OK = qw(
5533 micro_t
5534 percentage_of
5535 secs_to_time
5536 time_to_secs
5537 shorten
5538 ts
5539 parse_timestamp
5540 unix_timestamp
5541 any_unix_timestamp
5542 make_checksum
5543 crc32
5544);
5545
5546our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;
5547our $proper_ts = qr/(\d\d\d\d)-(\d\d)-(\d\d)[T ](\d\d):(\d\d):(\d\d)(\.\d+)?/;
5548our $n_ts = qr/(\d{1,5})([shmd]?)/; # Limit \d{1,5} because \d{6} looks
5549
5550sub micro_t {
5551 my ( $t, %args ) = @_;
5552 my $p_ms = defined $args{p_ms} ? $args{p_ms} : 0; # precision for ms vals
5553 my $p_s = defined $args{p_s} ? $args{p_s} : 0; # precision for s vals
5554 my $f;
5555
5556 $t = 0 if $t < 0;
5557
5558 $t = sprintf('%.17f', $t) if $t =~ /e/;
5559
5560 $t =~ s/\.(\d{1,6})\d*/\.$1/;
5561
5562 if ($t > 0 && $t <= 0.000999) {
5563 $f = ($t * 1000000) . 'us';
5564 }
5565 elsif ($t >= 0.001000 && $t <= 0.999999) {
5566 $f = sprintf("%.${p_ms}f", $t * 1000);
5567 $f = ($f * 1) . 'ms'; # * 1 to remove insignificant zeros
5568 }
5569 elsif ($t >= 1) {
5570 $f = sprintf("%.${p_s}f", $t);
5571 $f = ($f * 1) . 's'; # * 1 to remove insignificant zeros
5572 }
5573 else {
5574 $f = 0; # $t should = 0 at this point
5575 }
5576
5577 return $f;
5578}
5579
5580sub percentage_of {
5581 my ( $is, $of, %args ) = @_;
5582 my $p = $args{p} || 0; # float precision
5583 my $fmt = $p ? "%.${p}f" : "%d";
5584 return sprintf $fmt, ($is * 100) / ($of ||= 1);
5585}
5586
5587sub secs_to_time {
5588 my ( $secs, $fmt ) = @_;
5589 $secs ||= 0;
5590 return '00:00' unless $secs;
5591
5592 $fmt ||= $secs >= 86_400 ? 'd'
5593 : $secs >= 3_600 ? 'h'
5594 : 'm';
5595
5596 return
5597 $fmt eq 'd' ? sprintf(
5598 "%d+%02d:%02d:%02d",
5599 int($secs / 86_400),
5600 int(($secs % 86_400) / 3_600),
5601 int(($secs % 3_600) / 60),
5602 $secs % 60)
5603 : $fmt eq 'h' ? sprintf(
5604 "%02d:%02d:%02d",
5605 int(($secs % 86_400) / 3_600),
5606 int(($secs % 3_600) / 60),
5607 $secs % 60)
5608 : sprintf(
5609 "%02d:%02d",
5610 int(($secs % 3_600) / 60),
5611 $secs % 60);
5612}
5613
5614sub time_to_secs {
5615 my ( $val, $default_suffix ) = @_;
5616 die "I need a val argument" unless defined $val;
5617 my $t = 0;
5618 my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/;
5619 $suffix = $suffix || $default_suffix || 's';
5620 if ( $suffix =~ m/[smhd]/ ) {
5621 $t = $suffix eq 's' ? $num * 1 # Seconds
5622 : $suffix eq 'm' ? $num * 60 # Minutes
5623 : $suffix eq 'h' ? $num * 3600 # Hours
5624 : $num * 86400; # Days
5625
5626 $t *= -1 if $prefix && $prefix eq '-';
5627 }
5628 else {
5629 die "Invalid suffix for $val: $suffix";
5630 }
5631 return $t;
5632}
5633
5634sub shorten {
5635 my ( $num, %args ) = @_;
5636 my $p = defined $args{p} ? $args{p} : 2; # float precision
5637 my $d = defined $args{d} ? $args{d} : 1_024; # divisor
5638 my $n = 0;
5639 my @units = ('', qw(k M G T P E Z Y));
5640 while ( $num >= $d && $n < @units - 1 ) {
5641 $num /= $d;
5642 ++$n;
5643 }
5644 return sprintf(
5645 $num =~ m/\./ || $n
5646 ? "%.${p}f%s"
5647 : '%d',
5648 $num, $units[$n]);
5649}
5650
5651sub ts {
5652 my ( $time, $gmt ) = @_;
5653 my ( $sec, $min, $hour, $mday, $mon, $year )
5654 = $gmt ? gmtime($time) : localtime($time);
5655 $mon += 1;
5656 $year += 1900;
5657 my $val = sprintf("%d-%02d-%02dT%02d:%02d:%02d",
5658 $year, $mon, $mday, $hour, $min, $sec);
5659 if ( my ($us) = $time =~ m/(\.\d+)$/ ) {
5660 $us = sprintf("%.6f", $us);
5661 $us =~ s/^0\././;
5662 $val .= $us;
5663 }
5664 return $val;
5665}
5666
5667sub parse_timestamp {
5668 my ( $val ) = @_;
5669 if ( my($y, $m, $d, $h, $i, $s, $f)
5670 = $val =~ m/^$mysql_ts$/ )
5671 {
5672 return sprintf "%d-%02d-%02d %02d:%02d:"
5673 . (defined $f ? '%09.6f' : '%02d'),
5674 $y + 2000, $m, $d, $h, $i, (defined $f ? $s + $f : $s);
5675 }
5676 return $val;
5677}
5678
5679sub unix_timestamp {
5680 my ( $val, $gmt ) = @_;
5681 if ( my($y, $m, $d, $h, $i, $s, $us) = $val =~ m/^$proper_ts$/ ) {
5682 $val = $gmt
5683 ? timegm($s, $i, $h, $d, $m - 1, $y)
5684 : timelocal($s, $i, $h, $d, $m - 1, $y);
5685 if ( defined $us ) {
5686 $us = sprintf('%.6f', $us);
5687 $us =~ s/^0\././;
5688 $val .= $us;
5689 }
5690 }
5691 return $val;
5692}
5693
5694sub any_unix_timestamp {
5695 my ( $val, $callback ) = @_;
5696
5697 if ( my ($n, $suffix) = $val =~ m/^$n_ts$/ ) {
5698 $n = $suffix eq 's' ? $n # Seconds
5699 : $suffix eq 'm' ? $n * 60 # Minutes
5700 : $suffix eq 'h' ? $n * 3600 # Hours
5701 : $suffix eq 'd' ? $n * 86400 # Days
5702 : $n; # default: Seconds
5703 PTDEBUG && _d('ts is now - N[shmd]:', $n);
5704 return time - $n;
5705 }
5706 elsif ( $val =~ m/^\d{9,}/ ) {
5707 PTDEBUG && _d('ts is already a unix timestamp');
5708 return $val;
5709 }
5710 elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) {
5711 PTDEBUG && _d('ts is MySQL slow log timestamp');
5712 $val .= ' 00:00:00' unless $hms;
5713 return unix_timestamp(parse_timestamp($val));
5714 }
5715 elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) {
5716 PTDEBUG && _d('ts is properly formatted timestamp');
5717 $val .= ' 00:00:00' unless $hms;
5718 return unix_timestamp($val);
5719 }
5720 else {
5721 PTDEBUG && _d('ts is MySQL expression');
5722 return $callback->($val) if $callback && ref $callback eq 'CODE';
5723 }
5724
5725 PTDEBUG && _d('Unknown ts type:', $val);
5726 return;
5727}
5728
5729sub make_checksum {
5730 my ( $val ) = @_;
5731 my $checksum = uc substr(md5_hex($val), -16);
5732 PTDEBUG && _d($checksum, 'checksum for', $val);
5733 return $checksum;
5734}
5735
5736sub crc32 {
5737 my ( $string ) = @_;
5738 return unless $string;
5739 my $poly = 0xEDB88320;
5740 my $crc = 0xFFFFFFFF;
5741 foreach my $char ( split(//, $string) ) {
5742 my $comp = ($crc ^ ord($char)) & 0xFF;
5743 for ( 1 .. 8 ) {
5744 $comp = $comp & 1 ? $poly ^ ($comp >> 1) : $comp >> 1;
5745 }
5746 $crc = (($crc >> 8) & 0x00FFFFFF) ^ $comp;
5747 }
5748 return $crc ^ 0xFFFFFFFF;
5749}
5750
5751sub _d {
5752 my ($package, undef, $line) = caller 0;
5753 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
5754 map { defined $_ ? $_ : 'undef' }
5755 @_;
5756 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
5757}
5758
57591;
5760}
5761# ###########################################################################
5762# End Transformers package
5763# ###########################################################################
5764
5765# ###########################################################################
5766# CleanupTask package
5767# This package is a copy without comments from the original. The original
5768# with comments and its test file can be found in the Bazaar repository at,
5769# lib/CleanupTask.pm
5770# t/lib/CleanupTask.t
5771# See https://launchpad.net/percona-toolkit for more information.
5772# ###########################################################################
5773{
5774package CleanupTask;
5775
5776use strict;
5777use warnings FATAL => 'all';
5778use English qw(-no_match_vars);
5779use constant PTDEBUG => $ENV{PTDEBUG} || 0;
5780
5781sub new {
5782 my ( $class, $task ) = @_;
5783 die "I need a task parameter" unless $task;
5784 die "The task parameter must be a coderef" unless ref $task eq 'CODE';
5785 my $self = {
5786 task => $task,
5787 };
5788 PTDEBUG && _d('Created cleanup task', $task);
5789 return bless $self, $class;
5790}
5791
5792sub DESTROY {
5793 my ($self) = @_;
5794 my $task = $self->{task};
5795 PTDEBUG && _d('Calling cleanup task', $task);
5796 $task->();
5797 return;
5798}
5799
5800sub _d {
5801 my ($package, undef, $line) = caller 0;
5802 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
5803 map { defined $_ ? $_ : 'undef' }
5804 @_;
5805 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
5806}
5807
58081;
5809}
5810# ###########################################################################
5811# End CleanupTask package
5812# ###########################################################################
5813
5814# ###########################################################################
3863# This is a combination of modules and programs in one -- a runnable module.5815# This is a combination of modules and programs in one -- a runnable module.
3864# http://www.perl.com/pub/a/2006/07/13/lightning-articles.html?page=last5816# http://www.perl.com/pub/a/2006/07/13/lightning-articles.html?page=last
3865# Or, look it up in the Camel book on pages 642 and 643 in the 3rd edition.5817# Or, look it up in the Camel book on pages 642 and 643 in the 3rd edition.
@@ -3869,29 +5821,37 @@
3869# ###########################################################################5821# ###########################################################################
3870package pt_online_schema_change;5822package pt_online_schema_change;
38715823
5824use strict;
5825use warnings FATAL => 'all';
3872use English qw(-no_match_vars);5826use English qw(-no_match_vars);
3873use Time::HiRes qw(sleep);5827use constant PTDEBUG => $ENV{PTDEBUG} || 0;
5828
5829use Time::HiRes qw(time);
3874use Data::Dumper;5830use Data::Dumper;
3875$Data::Dumper::Indent = 1;5831$Data::Dumper::Indent = 1;
3876$Data::Dumper::Sortkeys = 1;5832$Data::Dumper::Sortkeys = 1;
3877$Data::Dumper::Quotekeys = 0;5833$Data::Dumper::Quotekeys = 0;
38785834
3879Transformers->import(qw(ts));5835use sigtrap 'handler', \&sig_int, 'normal-signals';
38805836
3881use constant PTDEBUG => $ENV{PTDEBUG} || 0;5837my $exit_status = 0;
38825838my $oktorun = 1;
3883my $quiet = 0; # for msg()5839my @drop_trigger_sqls;
5840
5841$OUTPUT_AUTOFLUSH = 1;
38845842
3885sub main {5843sub main {
3886 @ARGV = @_; # set global ARGV for this package5844 # Reset global vars else tests will fail.
3887 my $vp = new VersionParser();5845 @ARGV = @_;
3888 my $q = new Quoter();5846 $oktorun = 1;
3889 my $tp = new TableParser(Quoter => $q);5847 @drop_trigger_sqls = ();
3890 my $chunker = new TableChunker(Quoter => $q, TableParser => $tp);5848
5849 $exit_status = 0;
38915850
3892 # ########################################################################5851 # ########################################################################
3893 # Get configuration information.5852 # Get configuration information.
3894 # ########################################################################5853 # ########################################################################
5854 my $q = new Quoter();
3895 my $o = new OptionParser();5855 my $o = new OptionParser();
3896 $o->get_specs();5856 $o->get_specs();
3897 $o->get_opts();5857 $o->get_opts();
@@ -3899,41 +5859,36 @@
3899 my $dp = $o->DSNParser();5859 my $dp = $o->DSNParser();
3900 $dp->prop('set-vars', $o->get('set-vars'));5860 $dp->prop('set-vars', $o->get('set-vars'));
39015861
3902 $quiet = $o->get('quiet'); # for msg()5862 # The original table, i.e. the one being altered, must be specified
39035863 # on the command line via the DSN.
3904 my ($dsn, $db, $tbl);5864 my ($db, $tbl);
3905 $dsn = shift @ARGV;5865 my $dsn = shift @ARGV;
3906 if ( !$dsn ) {5866 if ( !$dsn ) {
3907 $o->save_error('A DSN with a t part must be specified');5867 $o->save_error('A DSN must be specified');
3908 }5868 }
3909 else {5869 else {
5870 # Parse DSN string and convert it to a DSN data struct.
3910 $dsn = $dp->parse($dsn, $dp->parse_options($o));5871 $dsn = $dp->parse($dsn, $dp->parse_options($o));
3911 if ( !$dsn->{t} ) {5872 $db = $dsn->{D};
3912 $o->save_error('The DSN must specify a t (table) part');5873 $tbl = $dsn->{t};
3913 }5874 }
3914 else {5875
3915 ($db, $tbl) = $q->split_unquote($dsn->{t} || "", $dsn->{D} || "");5876 my $alter_fk_method = $o->get('alter-foreign-keys-method') || '';
3916 }5877 if ( $alter_fk_method eq 'drop_swap' ) {
3917 }5878 $o->set('swap-tables', 0);
39185879 $o->set('drop-old-table', 0);
3919 my $rename_fk_method = lc($o->get('update-foreign-keys-method') || '');5880 }
3920 if ( ($rename_fk_method || '') eq 'drop_old_table' ) {5881
3921 $o->set('rename-tables', 0);5882 # Explicit --chunk-size disable auto chunk sizing.
3922 $o->set('drop-old-table', 0),5883 $o->set('chunk-time', 0) if $o->got('chunk-size');
3923 }
39245884
3925 if ( !$o->get('help') ) {5885 if ( !$o->get('help') ) {
3926 if ( @ARGV ) {5886 if ( @ARGV ) {
3927 $o->save_error('Specify only one DSN on the command line');5887 $o->save_error('Specify only one DSN on the command line');
3928 }5888 }
39295889
3930 if ( !$db ) {5890 if ( !$db || !$tbl ) {
3931 $o->save_error("No database was specified in the DSN or by "5891 $o->save_error("The DSN must specify a database (D) and a table (t)");
3932 . "--database (-D)");
3933 }
3934
3935 if ( $tbl && $tbl eq ($o->get('tmp-table') || "") ) {
3936 $o->save_error("--tmp-table cannot be the same as the table");
3937 }5892 }
39385893
3939 if ( $o->get('progress') ) {5894 if ( $o->get('progress') ) {
@@ -3944,523 +5899,1755 @@
3944 }5899 }
3945 }5900 }
39465901
3947 if ( $o->get('child-tables') && !$o->get('update-foreign-keys-method') ) {5902 # See the "pod-based-option-value-validation" spec for how this may
3948 $o->save_error("--child-tables requires --update-foreign-keys-method");5903 # be automagically validated.
3949 }5904 if ( $alter_fk_method
39505905 && $alter_fk_method ne 'auto'
3951 if ( $rename_fk_method5906 && $alter_fk_method ne 'rebuild_constraints'
3952 && $rename_fk_method ne 'rebuild_constraints'5907 && $alter_fk_method ne 'drop_swap'
3953 && $rename_fk_method ne 'drop_old_table' ) {5908 && $alter_fk_method ne 'none' )
3954 $o->save_error("Invalid --update-foreign-keys-method value");5909 {
3955 }5910 $o->save_error("Invalid --alter-foreign-keys-method value: $alter_fk_method");
3956 }5911 }
39575912 }
3958 $o->usage_or_errors();5913
39595914 $o->usage_or_errors();
3960 msg("$PROGRAM_NAME started");5915
3961 my $exit_status = 0;5916 if ( $o->get('quiet') ) {
5917 # BARON: this will fail on Windows, where there is no /dev/null. I feel
5918 # it's a hack, like ignoring a problem instead of fixing it somehow. We
5919 # should take a look at the things that get printed in a "normal"
5920 # non-quiet run, and "if !quiet" them, and then do some kind of Logger.pm
5921 # or Messager.pm module for a future release.
5922 close STDOUT;
5923 open STDOUT, '>', '/dev/null'
5924 or warn "Cannot reopen STDOUT to /dev/null: $OS_ERROR";
5925 }
39625926
3963 # ########################################################################5927 # ########################################################################
3964 # Connect to MySQL.5928 # Connect to MySQL.
3965 # ########################################################################5929 # ########################################################################
3966 my $dbh = get_cxn(5930 my $set_on_connect = sub {
3967 dsn => $dsn,5931 my ($dbh) = @_;
3968 DSNParser => $dp,5932
5933 # See the same code in pt-table-checksum.
5934 my $lock_wait_timeout = $o->get('lock-wait-timeout');
5935 my $set_lwt = "SET SESSION innodb_lock_wait_timeout=$lock_wait_timeout";
5936 PTDEBUG && _d($set_lwt);
5937 eval {
5938 $dbh->do($set_lwt);
5939 };
5940 if ( $EVAL_ERROR ) {
5941 PTDEBUG && _d($EVAL_ERROR);
5942 # Get the server's current value.
5943 my $sql = "SHOW SESSION VARIABLES LIKE 'innodb_lock_wait_timeout'";
5944 PTDEBUG && _d($dbh, $sql);
5945 my (undef, $curr_lwt) = $dbh->selectrow_array($sql);
5946 PTDEBUG && _d('innodb_lock_wait_timeout on server:', $curr_lwt);
5947 if ( $curr_lwt > $lock_wait_timeout ) {
5948 warn "Failed to $set_lwt: $EVAL_ERROR\n"
5949 . "The current innodb_lock_wait_timeout value "
5950 . "$curr_lwt is greater than the --lock-wait-timeout "
5951 . "value $lock_wait_timeout and the variable cannot be "
5952 . "changed. innodb_lock_wait_timeout is only dynamic when "
5953 . "using the InnoDB plugin. To prevent this warning, either "
5954 . "specify --lock-wait-time=$curr_lwt, or manually set "
5955 . "innodb_lock_wait_timeout to a value less than or equal "
5956 . "to $lock_wait_timeout and restart MySQL.\n";
5957 }
5958 }
5959 };
5960
5961 # Do not call "new Cxn(" directly; use this sub so that set_on_connect
5962 # is applied to every cxn.
5963 # BARON: why not make this a subroutine instead of a subroutine variable? I
5964 # think that can be less confusing. Also, the $set_on_connect variable can be
5965 # inlined into this subroutine. Many of our tools have a get_dbh() subroutine
5966 # and it might be good to just make a convention of it.
5967 my $make_cxn = sub {
5968 my (%args) = @_;
5969 my $cxn = new Cxn(
5970 %args,
5971 DSNParser => $dp,
5972 OptionParser => $o,
5973 set => $set_on_connect,
5974 );
5975 eval { $cxn->connect() }; # connect or die trying
5976 if ( $EVAL_ERROR ) {
5977 die "Cannot connect to MySQL: $EVAL_ERROR\n";
5978 }
5979 return $cxn;
5980 };
5981
5982 my $cxn = $make_cxn->(dsn => $dsn);
5983
5984 # ########################################################################
5985 # Check if MySQL is new enough to have the triggers we need.
5986 # Although triggers were introduced in 5.0.2, "Prior to MySQL 5.0.10,
5987 # triggers cannot contain direct references to tables by name."
5988 # ########################################################################
5989 my $vp = new VersionParser();
5990 if ( !$vp->version_ge($cxn->dbh(), '5.0.10') ) {
5991 die "This tool requires MySQL 5.0.10 or newer.\n";
5992 }
5993
5994 # ########################################################################
5995 # Setup lag and load monitors.
5996 # ########################################################################
5997 my $slaves; # all slaves that are found or specified
5998 my $slave_lag_cxns; # slaves whose lag we'll check
5999 my $replica_lag; # ReplicaLagWaiter object
6000 my $replica_lag_pr; # Progress for ReplicaLagWaiter
6001 my $sys_load; # MySQLStatusWaiter object
6002 my $sys_load_pr; # Progress for MySQLStatusWaiter object
6003
6004 if ( $o->get('execute') ) {
6005 # #####################################################################
6006 # Find and connect to slaves.
6007 # #####################################################################
6008 my $ms = new MasterSlave();
6009 $slaves = $ms->get_slaves(
6010 dbh => $cxn->dbh(),
6011 dsn => $cxn->dsn(),
6012 OptionParser => $o,
6013 DSNParser => $dp,
6014 Quoter => $q,
6015 make_cxn => sub {
6016 return $make_cxn->(@_, prev_dsn => $cxn->dsn());
6017 },
6018 );
6019 PTDEBUG && _d(scalar @$slaves, 'slaves found');
6020
6021 if ( $o->get('check-slave-lag') ) {
6022 PTDEBUG && _d('Will use --check-slave-lag to check for slave lag');
6023 my $cxn = $make_cxn->(
6024 dsn_string => $o->get('check-slave-lag'),
6025 prev_dsn => $cxn->dsn(),
6026 );
6027 $slave_lag_cxns = [ $cxn ];
6028 }
6029 else {
6030 PTDEBUG && _d('Will check slave lag on all slaves');
6031 $slave_lag_cxns = $slaves;
6032 }
6033
6034 # #####################################################################
6035 # Check for replication filters.
6036 # #####################################################################
6037 if ( $o->get('check-replication-filters') ) {
6038 PTDEBUG && _d("Checking slave replication filters");
6039 my @all_repl_filters;
6040 foreach my $slave ( @$slaves ) {
6041 my $repl_filters = $ms->get_replication_filters(
6042 dbh => $slave->dbh(),
6043 );
6044 if ( keys %$repl_filters ) {
6045 push @all_repl_filters,
6046 { name => $slave->name(),
6047 filters => $repl_filters,
6048 };
6049 }
6050 }
6051 if ( @all_repl_filters ) {
6052 my $msg = "Replication filters are set on these hosts:\n";
6053 foreach my $host ( @all_repl_filters ) {
6054 my $filters = $host->{filters};
6055 $msg .= " $host->{name}\n"
6056 . join("\n", map { " $_ = $host->{filters}->{$_}" }
6057 keys %{$host->{filters}})
6058 . "\n";
6059 }
6060 $msg .= "Please read the --check-replication-filters documentation "
6061 . "to learn how to solve this problem.";
6062 die $msg;
6063 }
6064 }
6065
6066 # #####################################################################
6067 # Make a ReplicaLagWaiter to help wait for slaves after each chunk.
6068 # #####################################################################
6069 my $sleep = sub {
6070 # Don't let the master dbh die while waiting for slaves because we
6071 # may wait a very long time for slaves.
6072 my $dbh = $cxn->dbh();
6073 if ( !$dbh || !$dbh->ping() ) {
6074 eval { $dbh = $cxn->connect() }; # connect or die trying
6075 if ( $EVAL_ERROR ) {
6076 $oktorun = 0; # flag for cleanup tasks
6077 chomp $EVAL_ERROR;
6078 die "Lost connection to " . $cxn->name() . " while waiting for "
6079 . "replica lag ($EVAL_ERROR)\n";
6080 }
6081 }
6082 $dbh->do("SELECT 'pt-online-schema-change keepalive'");
6083 sleep $o->get('check-interval');
6084 return;
6085 };
6086
6087 my $get_lag = sub {
6088 my ($cxn) = @_;
6089 my $dbh = $cxn->dbh();
6090 if ( !$dbh || !$dbh->ping() ) {
6091 eval { $dbh = $cxn->connect() }; # connect or die trying
6092 if ( $EVAL_ERROR ) {
6093 $oktorun = 0; # flag for cleanup tasks
6094 chomp $EVAL_ERROR;
6095 die "Lost connection to replica " . $cxn->name()
6096 . " while attempting to get its lag ($EVAL_ERROR)\n";
6097 }
6098 }
6099 return $ms->get_slave_lag($dbh);
6100 };
6101
6102 $replica_lag = new ReplicaLagWaiter(
6103 slaves => $slave_lag_cxns,
6104 max_lag => $o->get('max-lag'),
6105 oktorun => sub { return $oktorun },
6106 get_lag => $get_lag,
6107 sleep => $sleep,
6108 );
6109
6110 my $get_status;
6111 {
6112 my $sql = "SHOW GLOBAL STATUS LIKE ?";
6113 my $sth = $cxn->dbh()->prepare($sql);
6114
6115 $get_status = sub {
6116 my ($var) = @_;
6117 PTDEBUG && _d($sth->{Statement}, $var);
6118 $sth->execute($var);
6119 my (undef, $val) = $sth->fetchrow_array();
6120 return $val;
6121 };
6122 }
6123
6124 $sys_load = new MySQLStatusWaiter(
6125 max_spec => $o->get('max-load'),
6126 critical_spec => $o->get('critical-load'),
6127 get_status => $get_status,
6128 oktorun => sub { return $oktorun },
6129 sleep => $sleep,
6130 );
6131
6132 if ( $o->get('progress') ) {
6133 $replica_lag_pr = new Progress(
6134 jobsize => scalar @$slaves,
6135 spec => $o->get('progress'),
6136 name => "Waiting for replicas to catch up", # not used
6137 );
6138
6139 $sys_load_pr = new Progress(
6140 jobsize => scalar @{$o->get('max-load')},
6141 spec => $o->get('progress'),
6142 name => "Waiting for --max-load", # not used
6143 );
6144 }
6145 }
6146
6147 # ########################################################################
6148 # Setup and check the original table.
6149 # ########################################################################
6150 my $tp = new TableParser(Quoter => $q);
6151
6152 # Common table data struct (that modules like NibbleIterator expect).
6153 my $orig_tbl = {
6154 db => $db,
6155 tbl => $tbl,
6156 name => $q->quote($db, $tbl),
6157 };
6158
6159 check_orig_table(
6160 orig_tbl => $orig_tbl,
6161 Cxn => $cxn,
3969 OptionParser => $o,6162 OptionParser => $o,
3970 AutoCommit => 1,6163 TableParser => $tp,
3971 );6164 Quoter => $q,
3972 msg("USE `$db`");6165 );
3973 $dbh->do("USE `$db`");6166
39746167 # ########################################################################
3975 # ########################################################################6168 # Get child tables of the original table, if necessary.
3976 # Daemonize only after (potentially) asking for passwords for --ask-pass.6169 # ########################################################################
6170 my $child_tables = find_child_tables(
6171 tbl => $orig_tbl,
6172 Cxn => $cxn,
6173 Quoter => $q,
6174 );
6175 if ( !$child_tables ) {
6176 if ( $alter_fk_method ) {
6177 warn "No foreign keys reference $orig_tbl->{name}; ignoring "
6178 . "--alter-foreign-keys-method.\n";
6179
6180 if ( $alter_fk_method eq 'drop_swap' ) {
6181 # These opts are disabled at the start if the user specifies
6182 # the drop_swap method, but now that we know there are no
6183 # child tables, we must re-enable these to make the alter work.
6184 $o->set('swap-tables', 1);
6185 $o->set('drop-old-table', 1);
6186 }
6187
6188 $alter_fk_method = '';
6189 }
6190 # No child tables and --alter-fk-method wasn't specified,
6191 # so nothing to do.
6192 }
6193 else {
6194 print "Child tables:\n";
6195 foreach my $child_table ( @$child_tables ) {
6196 printf " %s (approx. %s rows)\n",
6197 $child_table->{name},
6198 $child_table->{row_est} || '?';
6199 }
6200
6201 if ( $alter_fk_method ) {
6202 # Let the user know how we're going to update the child table fk refs.
6203 my $choice
6204 = $alter_fk_method eq 'none' ? "not"
6205 : $alter_fk_method eq 'auto' ? "automatically choose the method to"
6206 : "use the $alter_fk_method method to";
6207 print "Will $choice update foreign keys.\n";
6208 }
6209 else {
6210 print "You did not specify --alter-foreign-keys-method, but there "
6211 . "are foreign keys that reference the table. "
6212 . "Please read the tool's documentation carefully.\n";
6213 return 1;
6214 }
6215 }
6216
6217 # ########################################################################
6218 # XXX
6219 # Ready to begin the alter! Nothing has been changed on the server at
6220 # this point; we've just checked and looked for things. Past this point,
6221 # the code is live if --execute, else it's doing a --dry-run. Or, if
6222 # the user didn't read the docs, we may bail out here.
6223 # XXX
6224 # ########################################################################
6225 if ( $o->get('dry-run') ) {
6226 print "Starting a dry run. $orig_tbl->{name} will not be altered. "
6227 . "Specify --execute instead of --dry-run to alter the table.\n";
6228 }
6229 elsif ( $o->get('execute') ) {
6230 print "Altering $orig_tbl->{name}...\n";
6231 }
6232 else {
6233 print "Exiting without altering $orig_tbl->{name} because neither "
6234 . "--dry-run nor --execute was specified. Please read the tool's "
6235 . "documentation carefully before using this tool.\n";
6236 return 1;
6237 }
6238
6239 # ########################################################################
6240 # Create a cleanup task object to undo changes (i.e. clean up) if the
6241 # code dies, or we may call this explicitly at the end if all goes well.
6242 # ########################################################################
6243 my @cleanup_tasks;
6244 my $cleanup = new CleanupTask(
6245 sub {
6246 # XXX We shouldn't copy $EVAL_ERROR here, but I found that
6247 # errors are not re-thrown in tests. If you comment out this
6248 # line and the die below, an error fails:
6249 # not ok 5 - Doesn't try forever to find a new table name
6250 # Failed test 'Doesn't try forever to find a new table name'
6251 # at /Users/daniel/p/pt-osc-2.1.1/lib/PerconaTest.pm line 559.
6252 # ''
6253 # doesn't match '(?-xism:Failed to find a unique new table name)'
6254 my $original_error = $EVAL_ERROR;
6255 foreach my $task ( reverse @cleanup_tasks ) {
6256 eval {
6257 $task->();
6258 };
6259 if ( $EVAL_ERROR ) {
6260 warn "Error cleaning up: $EVAL_ERROR\n";
6261 }
6262 }
6263 die $original_error if $original_error; # rethrow original error
6264 return;
6265 }
6266 );
6267
6268 # The last cleanup task is to report whether or not the orig table
6269 # was altered.
6270 push @cleanup_tasks, sub {
6271 PTDEBUG && _d('Clean up done, report if orig table was altered');
6272 if ( $o->get('dry-run') ) {
6273 print "Dry run complete. $orig_tbl->{name} was not altered.\n";
6274 }
6275 else {
6276 if ( $orig_tbl->{swapped} ) {
6277 if ( $orig_tbl->{success} ) {
6278 print "Successfully altered $orig_tbl->{name}.\n";
6279 }
6280 else {
6281 print "Altered $orig_tbl->{name} but there were errors "
6282 . "or warnings.\n";
6283 }
6284 }
6285 else {
6286 print "$orig_tbl->{name} was not altered.\n";
6287 }
6288 }
6289 return;
6290 };
6291
6292 # ########################################################################
6293 # Check and create PID file if user specified --pid.
3977 # ########################################################################6294 # ########################################################################
3978 my $daemon;6295 my $daemon;
3979 if ( $o->get('pid') ) {6296 if ( $o->get('execute') && $o->get('pid') ) {
3980 # We're not daemoninzing, it just handles PID stuff.6297 # We're not daemoninzing, it just handles PID stuff.
3981 $daemon = new Daemon(o=>$o);6298 $daemon = new Daemon(o=>$o);
3982 $daemon->make_PID_file();6299 $daemon->make_PID_file();
3983 }6300 }
39846301
3985 # ########################################################################6302 # #####################################################################
3986 # Setup/init some vars.6303 # Step 1: Create the new table.
3987 # ########################################################################6304 # #####################################################################
3988 my $tmp_tbl = $o->get('tmp-table') || "__tmp_$tbl";6305 my $new_tbl;
3989 my $old_tbl = "__old_$tbl"; # what tbl becomes after swapped with tmp tbl6306 eval {
3990 my %tables = (6307 $new_tbl = create_new_table(
3991 db => $db,6308 orig_tbl => $orig_tbl,
3992 tbl => $tbl,6309 suffix => '_new',
3993 tmp_tbl => $tmp_tbl,6310 Cxn => $cxn,
3994 old_tbl => $old_tbl,6311 Quoter => $q,
3995 );6312 OptionParser => $o,
3996 msg("Alter table $tbl using temporary table $tmp_tbl");6313 TableParser => $tp,
39976314 );
3998 my %common_modules = (6315 };
3999 OptionParser => $o,6316 if ( $EVAL_ERROR ) {
4000 DSNParser => $dp,6317 die "Error creating new table: $EVAL_ERROR\n";
4001 Quoter => $q,6318 }
4002 TableParser => $tp,6319
4003 TableChunker => $chunker,6320 # If the new table still exists, drop it unless the tool was interrupted.
4004 VersionParser => $vp,6321 push @cleanup_tasks, sub {
4005 );6322 PTDEBUG && _('Clean up new table');
40066323 my $new_tbl_exists = $tp->check_table(
4007 # ########################################################################6324 dbh => $cxn->dbh(),
4008 # Create the capture-sync and copy-rows plugins. Currently, we just have6325 db => $new_tbl->{db},
4009 # one method for each.6326 tbl => $new_tbl->{tbl},
4010 # ########################################################################6327 );
4011 my $capture_sync = new OSCCaptureSync(Quoter => $q);6328 PTDEBUG && _d('New table exists:', $new_tbl_exists ? 'yes' : 'no');
4012 my $copy_rows = new CopyRowsInsertSelect(6329 return unless $new_tbl_exists;
4013 Retry => new Retry(),6330
4014 Quoter => $q,6331 my $sql = "DROP TABLE IF EXISTS $new_tbl->{name};";
4015 );6332 if ( !$oktorun ) {
40166333 # The tool was interrupted, so do not drop the new table
4017 # More values are added later. These are the minimum need to do --cleanup.6334 # in case the user wants to resume (once resume capability
4018 my %plugin_args = (6335 # is implemented).
4019 dbh => $dbh,6336 print "Not dropping the new table $new_tbl->{name} because "
4020 msg => \&msg, # so plugin can talk back to user6337 . "the tool was interrupted. To drop the new table, "
4021 print => $o->get('print'),6338 . "execute:\n$sql\n";
4022 %tables,6339 }
4023 %common_modules,6340 elsif ( $orig_tbl->{copied} && !$orig_tbl->{swapped} ) {
4024 );6341 print "Not dropping the new table $new_tbl->{name} because "
40256342 . "--swap-tables failed. To drop the new table, "
4026 if ( my $sleep_time = $o->get('sleep') ) {6343 . "execute:\n$sql\n";
4027 PTDEBUG && _d("Sleep time:", $sleep_time);6344 }
4028 $plugin_args{sleep} = sub {6345 else {
4029 my ( $chunkno ) = @_;6346 print "Dropping new table...\n";
4030 PTDEBUG && _d("Sleeping after chunk", $chunkno);6347 print $sql, "\n" if $o->get('print');
4031 sleep($sleep_time);6348 PTDEBUG && _d($sql);
6349 eval {
6350 $cxn->dbh()->do($sql);
6351 };
6352 if ( $EVAL_ERROR ) {
6353 warn "Error dropping new table $new_tbl->{name}: $EVAL_ERROR\n"
6354 . "To try dropping the new table again, execute:\n$sql\n";
6355 }
6356 print "Dropped new table OK.\n";
6357 }
6358 };
6359
6360 # #####################################################################
6361 # Step 2: Alter the new, empty table. This should be very quick,
6362 # or die if the user specified a bad alter statement.
6363 # #####################################################################
6364 if ( my $alter = $o->get('alter') ) {
6365 print "Altering new table...\n";
6366 my $sql = "ALTER TABLE $new_tbl->{name} $alter";
6367 print $sql, "\n" if $o->get('print');
6368 PTDEBUG && _d($sql);
6369 eval {
6370 $cxn->dbh()->do($sql);
4032 };6371 };
4033 }6372 if ( $EVAL_ERROR ) {
40346373 die "Error altering new table $new_tbl->{name}: $EVAL_ERROR\n"
4035 # ########################################################################6374 }
4036 # Just cleanup and exit.6375 print "Altered $new_tbl->{name} OK.\n"
4037 # ########################################################################6376 }
4038 if ( $o->get('cleanup-and-exit') ) {6377
4039 msg("Calling " . (ref $copy_rows). "::cleanup()");6378 # Get the new table struct. This shouldn't die because
4040 $copy_rows->cleanup(%plugin_args);6379 # we just created the table successfully so we know it's
40416380 # there. But the ghost of Ryan is everywhere.
4042 msg("Calling " . (ref $capture_sync) . "::cleanup()");6381 my $ddl = $tp->get_create_table(
4043 $capture_sync->cleanup(%plugin_args);6382 $cxn->dbh(),
40446383 $new_tbl->{db},
4045 msg("$PROGRAM_NAME ending for --cleanup-and-exit");6384 $new_tbl->{tbl},
4046 return 0;6385 );
4047 }6386 $new_tbl->{tbl_struct} = $tp->parse($ddl);
40486387
4049 # ########################################################################6388 # Determine what columns the original and new table share.
4050 # Check that table can be altered.6389 # If the user drops a col, that's easy: just don't copy it. If they
4051 # ########################################################################6390 # add a column, it must have a default value. Other alterations
4052 my %tbl_info;6391 # may or may not affect the copy process--we'll know when we try!
6392 # Note: we don't want to examine the --alter statement to see if the
6393 # cols have changed because that's messy and prone to parsing errors.
6394 # Col posn (position) is just for looks because user's like
6395 # to see columns listed in their original order, not Perl's
6396 # random hash key sorting.
6397 my $col_posn = $orig_tbl->{tbl_struct}->{col_posn};
6398 my $orig_cols = $orig_tbl->{tbl_struct}->{is_col};
6399 my $new_cols = $new_tbl->{tbl_struct}->{is_col};
6400 my @common_cols = sort { $col_posn->{$a} <=> $col_posn->{$b} }
6401 grep { $new_cols->{$_} }
6402 keys %$orig_cols;
6403 PTDEBUG && _d('Common columns', @common_cols);
6404
6405 # ########################################################################
6406 # Step 3: Create the triggers to capture changes on the original table and
6407 # apply them to the new table.
6408 # ########################################################################
6409
6410 # Drop the triggers. We can save this cleanup task before
6411 # adding the triggers because if adding them fails, this will be
6412 # called which will drop whichever triggers were created.
6413 push @cleanup_tasks, sub {
6414 PTDEBUG && _d('Clean up triggers');
6415 if ( $oktorun ) {
6416 drop_triggers(
6417 tbl => $orig_tbl,
6418 Cxn => $cxn,
6419 Quoter => $q,
6420 OptionParser => $o,
6421 );
6422 }
6423 else {
6424 print "Not dropping triggers because the tool was interrupted. "
6425 . "To drop the triggers, execute:\n"
6426 . join("\n", @drop_trigger_sqls) . "\n";
6427 }
6428 };
6429
4053 eval {6430 eval {
4054 %tbl_info = check_tables(%plugin_args);6431 create_triggers(
6432 orig_tbl => $orig_tbl,
6433 new_tbl => $new_tbl,
6434 columns => \@common_cols,
6435 Cxn => $cxn,
6436 Quoter => $q,
6437 OptionParser => $o,
6438 );
4055 };6439 };
4056 if ( $EVAL_ERROR ) {6440 if ( $EVAL_ERROR ) {
4057 chomp $EVAL_ERROR;6441 die "Error creating triggers: $EVAL_ERROR\n";
4058 msg("Table $tbl cannot be altered: $EVAL_ERROR");6442 };
4059 return 1;6443
4060 }6444 # #####################################################################
40616445 # Step 4: Copy rows.
4062 @plugin_args{keys %tbl_info} = values %tbl_info;6446 # #####################################################################
4063 msg("Table $tbl can be altered");6447
4064 msg("Chunk column $plugin_args{chunk_column}, index $plugin_args{chunk_index}");6448 # The hashref of callbacks below is what NibbleIterator calls internally
40656449 # to do all the copy work. The callbacks do not need to eval their work
4066 if ( $o->get('check-tables-and-exit') ) {6450 # because the higher call to $nibble_iter->next() is eval'ed which will
4067 msg("$PROGRAM_NAME ending for --check-tables-and-exit");6451 # catch any errors in the callbacks.
4068 return 0;6452 my $total_rows = 0;
4069 }6453 my $total_time = 0;
40706454 my $avg_rate = 0; # rows/second
4071 # #####################################################################6455 my $retry = new Retry(); # for retrying to exec the copy statement
4072 # Chunk the table. If the checks pass, then this shouldn't fail.6456 my $limit = $o->get('chunk-size-limit'); # brevity
4073 # #####################################################################6457 my $chunk_time = $o->get('chunk-time'); # brevity
4074 my %range_stats = $chunker->get_range_statistics(6458
4075 dbh => $dbh,6459 my $callbacks = {
4076 db => $db,6460 init => sub {
4077 tbl => $tbl,6461 my (%args) = @_;
4078 chunk_col => $plugin_args{chunk_column},6462 my $tbl = $args{tbl};
4079 tbl_struct => $plugin_args{tbl_struct},6463 my $nibble_iter = $args{NibbleIterator};
4080 );6464
4081 my @chunks = $chunker->calculate_chunks(6465 if ( $o->get('dry-run') ) {
4082 dbh => $dbh,6466 print "Not copying rows because this is a dry run.\n";
4083 db => $db,
4084 tbl => $tbl,
4085 chunk_col => $plugin_args{chunk_column},
4086 tbl_struct => $plugin_args{tbl_struct},
4087 chunk_size => $o->get('chunk-size'),
4088 %range_stats,
4089 );
4090 $plugin_args{chunks} = \@chunks;
4091 $plugin_args{Progress} = new Progress(
4092 jobsize => scalar @chunks,
4093 spec => $o->get('progress'),
4094 name => "Copying rows",
4095 );
4096 msg("Chunked table $tbl into " . scalar @chunks . " chunks");
4097
4098 # #####################################################################
4099 # Get child tables if necessary.
4100 # #####################################################################
4101 my @child_tables;
4102 if ( my $child_tables = $o->get('child-tables') ) {
4103 if ( lc $child_tables eq 'auto_detect' ) {
4104 msg("Auto-detecting child tables of $tbl");
4105 @child_tables = get_child_tables(%plugin_args);
4106 msg("Child tables of $tables{old_tbl}: "
4107 . (@child_tables ? join(', ', @child_tables) : "(none)"));
4108 }
4109 else {
4110 @child_tables = split(',', $child_tables);
4111 msg("User-specified child tables: " . join(', ', @child_tables));
4112 }
4113 }
4114
4115 # #####################################################################
4116 # Do the online alter.
4117 # #####################################################################
4118 if ( !$o->get('execute') ) {
4119 msg("Exiting without altering $db.$tbl because you did not "
4120 . "specify --execute. Please read the tool's documentation "
4121 . "carefully before using this tool.");
4122 return $exit_status;
4123 }
4124
4125 msg("Starting online schema change");
4126 eval {
4127 my $sql = "";
4128
4129 # #####################################################################
4130 # Create and alter the new table.
4131 # #####################################################################
4132 if ( $o->get('create-tmp-table') ) {
4133 $sql = "CREATE TABLE `$db`.`$tmp_tbl` LIKE `$db`.`$tbl`";
4134 msg($sql);
4135 $dbh->do($sql) unless $o->get('print');
4136 }
4137
4138 if ( my $alter = $o->get('alter') ) {
4139 my @stmts;
4140 if ( -f $alter && -r $alter ) {
4141 msg("Reading ALTER TABLE statements from file $alter");
4142 open my $fh, '<', $alter or die "Cannot open $alter: $OS_ERROR";
4143 @stmts = <$fh>;
4144 close $fh;
4145 }6467 }
4146 else {6468 else {
4147 @stmts = split(';', $alter);6469 print "Copying approximately ", $nibble_iter->row_estimate(),
4148 }6470 " rows...\n";
41496471 }
4150 foreach my $stmt ( @stmts ) {6472
4151 $sql = "ALTER TABLE `$db`.`$tmp_tbl` $stmt";6473 if ( $o->get('print') ) {
4152 msg($sql);6474 # Print the checksum and next boundary statements.
4153 $dbh->do($sql) unless $o->get('print');6475 my $statements = $nibble_iter->statements();
6476 foreach my $sth ( sort keys %$statements ) {
6477 next if $sth =~ m/^explain/;
6478 if ( $statements->{$sth} ) {
6479 print $statements->{$sth}->{Statement}, "\n";
6480 }
6481 }
6482 }
6483
6484 return unless $o->get('execute');
6485
6486 # If table is a single chunk on the master, make sure it's also
6487 # a single chunk on all slaves. E.g. if a slave is out of sync
6488 # and has a lot more rows than the master, single chunking on the
6489 # master could cause the slave to choke.
6490 if ( $nibble_iter->one_nibble() ) {
6491 PTDEBUG && _d('Getting table row estimate on replicas');
6492 my @too_large;
6493 foreach my $slave ( @$slaves ) {
6494 my ($n_rows) = NibbleIterator::get_row_estimate(
6495 Cxn => $slave,
6496 tbl => $tbl,
6497 );
6498 PTDEBUG && _d('Table on',$slave->name(),'has', $n_rows, 'rows');
6499 if ( $n_rows && $n_rows > ($tbl->{chunk_size} * $limit) ) {
6500 PTDEBUG && _d('Table too large on', $slave->name());
6501 push @too_large, [$slave->name(), $n_rows || 0];
6502 }
6503 }
6504 if ( @too_large ) {
6505 my $msg
6506 = "Cannot copy table $tbl->{name} because"
6507 . " on the master it would be checksummed in one chunk"
6508 . " but on these replicas it has too many rows:\n";
6509 foreach my $info ( @too_large ) {
6510 $msg .= " $info->[1] rows on $info->[0]\n";
6511 }
6512 $msg .= "The current chunk size limit is "
6513 . ($tbl->{chunk_size} * $limit)
6514 . " rows (chunk size=$tbl->{chunk_size}"
6515 . " * chunk size limit=$limit).\n";
6516 die $msg;
6517 }
6518 }
6519
6520 return 1; # continue nibbling table
6521 },
6522 next_boundaries => sub {
6523 my (%args) = @_;
6524 my $tbl = $args{tbl};
6525 my $nibble_iter = $args{NibbleIterator};
6526 my $sth = $nibble_iter->statements();
6527 my $boundary = $nibble_iter->boundaries();
6528
6529 return 0 if $o->get('dry-run');
6530 return 1 if $nibble_iter->one_nibble();
6531
6532 # Check that MySQL will use the nibble index for the next upper
6533 # boundary sql. This check applies to the next nibble. So if
6534 # the current nibble number is 5, then nibble 5 is already done
6535 # and we're checking nibble number 6.
6536 my $expl = explain_statement(
6537 tbl => $tbl,
6538 sth => $sth->{explain_upper_boundary},
6539 vals => [ @{$boundary->{lower}}, $nibble_iter->chunk_size() ],
6540 );
6541 if (lc($expl->{key} || '') ne lc($nibble_iter->nibble_index() || '')) {
6542 my $msg
6543 = "Aborting copying table $tbl->{name} at chunk "
6544 . ($nibble_iter->nibble_number() + 1)
6545 . " because it is not safe to ascend. Chunking should "
6546 . "use the "
6547 . ($nibble_iter->nibble_index() || '?')
6548 . " index, but MySQL EXPLAIN reports that "
6549 . ($expl->{key} ? "the $expl->{key}" : "no")
6550 . " index will be used for "
6551 . $sth->{upper_boundary}->{Statement}
6552 . " with values "
6553 . join(", ", map { defined $_ ? $_ : "NULL" }
6554 (@{$boundary->{lower}}, $nibble_iter->chunk_size()))
6555 . "\n";
6556 die $msg;
4154 } 6557 }
4155 }6558
41566559 # Once nibbling begins for a table, control does not return to this
4157 # #####################################################################6560 # tool until nibbling is done because, as noted above, all work is
4158 # Determine what columns the two tables have in common.6561 # done in these callbacks. This callback is the only place where we
4159 # #####################################################################6562 # can prematurely stop nibbling by returning false. This allows
4160 my @columns;6563 # Ctrl-C to stop the tool between nibbles instead of between tables.
4161 # If --print is in effect, then chances are the new table wasn't6564 return $oktorun; # continue nibbling table?
4162 # created above, so we can't get it's struct.6565 },
4163 # TODO: check if the new table exists because user might have created6566 exec_nibble => sub {
4164 # it manually.6567 my (%args) = @_;
4165 if ( !$o->get('print') ) {6568 my $tbl = $args{tbl};
4166 my $tmp_tbl_struct = $tp->parse(6569 my $nibble_iter = $args{NibbleIterator};
4167 $tp->get_create_table($dbh, $db, $tmp_tbl));6570 my $sth = $nibble_iter->statements();
41686571 my $boundary = $nibble_iter->boundaries();
4169 @columns = intersection([6572
4170 $plugin_args{tbl_struct}->{is_col},6573 return if $o->get('dry-run');
4171 $tmp_tbl_struct->{is_col},6574
4172 ]);6575 # Count every chunk, even if it's ultimately skipped, etc.
41736576 $tbl->{results}->{n_chunks}++;
4174 # Order columns according to new table because people like/expect6577
4175 # to see things in a certain order (this has been an issue before).6578 # If the table is being chunk (i.e., it's not small enough to be
4176 # This just matters to us; does't make a difference to MySQL.6579 # consumed by one nibble), then check index usage and chunk size.
4177 my $col_posn = $plugin_args{tbl_struct}->{col_posn};6580 if ( !$nibble_iter->one_nibble() ) {
4178 @columns = sort { $col_posn->{$a} <=> $col_posn->{$b} } @columns;6581 my $expl = explain_statement(
4179 msg("Shared columns: " . join(', ', @columns));6582 tbl => $tbl,
4180 }6583 sth => $sth->{explain_nibble},
4181 $plugin_args{columns} = \@columns;6584 vals => [ @{$boundary->{lower}}, @{$boundary->{upper}} ],
41826585 );
4183 # #####################################################################6586
4184 # Start capturing changes to the new table.6587 # Ensure that MySQL is using the chunk index.
4185 # #####################################################################6588 if ( lc($expl->{key} || '')
4186 msg("Calling " . (ref $capture_sync) . "::capture()");6589 ne lc($nibble_iter->nibble_index() || '') ) {
4187 $capture_sync->capture(%plugin_args);6590 my $msg
41886591 = "Aborting copying table $tbl->{name} at chunk "
4189 # #####################################################################6592 . $nibble_iter->nibble_number()
4190 # Copy rows from new table to old table.6593 . " because it is not safe to chunk. Chunking should "
4191 # #####################################################################6594 . "use the "
4192 msg("Calling " . (ref $copy_rows) . "::copy()");6595 . ($nibble_iter->nibble_index() || '?')
4193 $copy_rows->copy(6596 . " index, but MySQL EXPLAIN reports that "
4194 from_table => $q->quote($db, $tbl),6597 . ($expl->{key} ? "the $expl->{key}" : "no")
4195 to_table => $q->quote($db, $tmp_tbl),6598 . " index will be used for "
4196 %plugin_args6599 . $sth->{explain_nibble}->{Statement}
4197 );6600 . " with values "
41986601 . join(", ", map { defined $_ ? $_ : "NULL" }
4199 # #####################################################################6602 (@{$boundary->{lower}}, @{$boundary->{upper}}))
4200 # Sync tables.6603 . "\n";
4201 # #####################################################################6604 die $msg;
4202 msg("Calling " . (ref $capture_sync) . "::sync()");6605 }
4203 $capture_sync->sync(%plugin_args);6606
42046607 # Check chunk size limit if the upper boundary and next lower
4205 # #####################################################################6608 # boundary are identical.
4206 # Rename tables.6609 if ( $limit ) {
4207 # #####################################################################6610 my $boundary = $nibble_iter->boundaries();
4208 if ( $o->get('rename-tables') ) {6611 my $oversize_chunk
4209 msg("Renaming tables");6612 = $limit ? ($expl->{rows} || 0) >= $tbl->{chunk_size} * $limit
4210 $sql = "RENAME TABLE `$db`.`$tbl` TO `$db`.`$old_tbl`,"6613 : 0;
4211 . " `$db`.`$tmp_tbl` TO `$db`.`$tbl`";6614 if ( $oversize_chunk
4212 msg($sql);6615 && $nibble_iter->identical_boundaries(
4213 $dbh->do($sql) unless $o->get('print');6616 $boundary->{upper}, $boundary->{next_lower}) )
4214 msg("Original table $tbl renamed to $old_tbl");6617 {
4215 }6618 my $msg
42166619 = "Aborting copying table $tbl->{name} at chunk "
4217 # #####################################################################6620 . $nibble_iter->nibble_number()
4218 # Update foreign key constraints if there are child tables.6621 . " because the chunk is too large: MySQL estimates "
4219 # #####################################################################6622 . ($expl->{rows} || 0) . "rows. The current chunk "
4220 if ( @child_tables ) {6623 . "size limit is " . ($tbl->{chunk_size} * $limit)
4221 msg("Renaming foreign key constraints in child table");6624 . " rows (chunk size=$tbl->{chunk_size}"
4222 if ( $rename_fk_method eq 'rebuild_constraints' ) { 6625 . " * chunk size limit=$limit).\n";
4223 update_foreign_key_constraints(6626 die $msg;
4224 child_tables => \@child_tables,6627 }
4225 %plugin_args,6628 }
4226 );6629 }
4227 }6630
4228 elsif ( $rename_fk_method eq 'drop_old_table' ) {6631 # Exec and time the chunk checksum query.
4229 $sql = "SET foreign_key_checks=0";6632 $tbl->{nibble_time} = exec_nibble(
4230 msg($sql);6633 %args,
4231 $dbh->do($sql) unless $o->get('print');6634 Retry => $retry,
4232 6635 Quoter => $q,
4233 $sql = "DROP TABLE IF EXISTS `$db`.`$tbl`";6636 OptionParser => $o,
4234 msg($sql);6637 );
4235 $dbh->do($sql) unless $o->get('print');6638 PTDEBUG && _d('Nibble time:', $tbl->{nibble_time});
42366639
4237 $sql = "RENAME TABLE `$db`.`$tmp_tbl` TO `$db`.`$tbl`";6640 # We're executing REPLACE queries which don't return rows.
4238 msg($sql);6641 # Returning 0 from this callback causes the nibble iter to
4239 $dbh->do($sql) unless $o->get('print');6642 # get the next boundaries/nibble.
6643 return 0;
6644 },
6645 after_nibble => sub {
6646 my (%args) = @_;
6647 my $tbl = $args{tbl};
6648 my $nibble_iter = $args{NibbleIterator};
6649
6650 return unless $o->get('execute');
6651
6652 # Update rate, chunk size, and progress if the nibble actually
6653 # selected some rows.
6654 my $cnt = $tbl->{row_cnt};
6655 if ( ($cnt || 0) > 0 ) {
6656 # Update the rate of rows per second for the entire server.
6657 # This is used for the initial chunk size of the next table.
6658 $total_rows += $cnt;
6659 $total_time += $tbl->{nibble_time};
6660 $avg_rate = int($total_rows / $total_time);
6661 PTDEBUG && _d('Average copy rate (rows/s):', $avg_rate);
6662
6663 # Adjust chunk size. This affects the next chunk.
6664 if ( $chunk_time ) {
6665 # Calcuate a new chunk-size based on the rate of rows/s.
6666 $tbl->{chunk_size} = $tbl->{rate}->update(
6667 $cnt, # processed this many rows
6668 $tbl->{nibble_time}, # is this amount of time
6669 );
6670
6671 if ( $tbl->{chunk_size} < 1 ) {
6672 # This shouldn't happen. WeightedAvgRate::update() may
6673 # return a value < 1, but minimum chunk size is 1.
6674 $tbl->{chunk_size} = 1;
6675
6676 # This warning is printed once per table.
6677 if ( !$tbl->{warned_slow} ) {
6678 warn "Rows are copying very slowly. "
6679 . "--chunk-size has been automatically reduced to 1. "
6680 . "Check that the server is not being overloaded, "
6681 . "or increase --chunk-time. The last chunk "
6682 . "selected $cnt rows and took "
6683 . sprintf('%.3f', $tbl->{nibble_time})
6684 . " seconds to execute.\n";
6685 $tbl->{warned_slow} = 1;
6686 }
6687 }
6688
6689 # Update chunk-size based on the rate of rows/s.
6690 $nibble_iter->set_chunk_size($tbl->{chunk_size});
6691 }
6692
6693 # Every table should have a Progress obj; update it.
6694 if ( my $tbl_pr = $tbl->{progress} ) {
6695 $tbl_pr->update( sub { return $total_rows } );
6696 }
6697 }
6698
6699 # Wait forever for slaves to catch up.
6700 $replica_lag_pr->start() if $replica_lag_pr;
6701 $replica_lag->wait(Progress => $replica_lag_pr);
6702
6703 # Wait forever for system load to abate. wait() will die if
6704 # --critical load is reached.
6705 $sys_load_pr->start() if $sys_load_pr;
6706 $sys_load->wait(Progress => $sys_load_pr);
6707
6708 return;
6709 },
6710 done => sub {
6711 if ( $o->get('execute') ) {
6712 print "Copied rows OK.\n";
6713 }
6714 },
6715 };
6716
6717 # NibbleIterator combines these two statements and adds
6718 # "FROM $orig_table->{name} WHERE <nibble stuff>".
6719 my $dml = "INSERT LOW_PRIORITY IGNORE INTO $new_tbl->{name} "
6720 . "(" . join(', ', map { $q->quote($_) } @common_cols) . ") "
6721 . "SELECT";
6722 my $select = join(', ', map { $q->quote($_) } @common_cols);
6723
6724 # The chunk size is auto-adjusted, so use --chunk-size as
6725 # the initial value, but then save and update the adjusted
6726 # chunk size in the table data struct.
6727 $orig_tbl->{chunk_size} = $o->get('chunk-size');
6728
6729 # This won't (shouldn't) fail because we already verified in
6730 # check_orig_table() table we can NibbleIterator::can_nibble().
6731 my $nibble_iter = new NibbleIterator(
6732 Cxn => $cxn,
6733 tbl => $orig_tbl,
6734 chunk_size => $orig_tbl->{chunk_size},
6735 chunk_index => $o->get('chunk-index'),
6736 dml => $dml,
6737 select => $select,
6738 callbacks => $callbacks,
6739 OptionParser => $o,
6740 Quoter => $q,
6741 TableParser => $tp,
6742 TableNibbler => new TableNibbler(TableParser => $tp, Quoter => $q),
6743 comments => {
6744 bite => "pt-online-schema-change $PID copy table",
6745 nibble => "pt-online-schema-change $PID copy nibble",
6746 },
6747 );
6748
6749 # Init a new weighted avg rate calculator for the table.
6750 $orig_tbl->{rate} = new WeightedAvgRate(target_t => $chunk_time);
6751
6752 # Make a Progress obj for this table. It may not be used;
6753 # depends on how many rows, chunk size, how fast the server
6754 # is, etc. But just in case, all tables have a Progress obj.
6755 if ( $o->get('progress')
6756 && !$nibble_iter->one_nibble()
6757 && $nibble_iter->row_estimate() )
6758 {
6759 $orig_tbl->{progress} = new Progress(
6760 jobsize => $nibble_iter->row_estimate(),
6761 spec => $o->get('progress'),
6762 name => "Copying $orig_tbl->{name}",
6763 );
6764 }
6765
6766 # Start copying rows. This may take awhile, but --progress is on
6767 # by default so there will be progress updates to stderr.
6768 eval {
6769 1 while $nibble_iter->next();
6770 };
6771 if ( $EVAL_ERROR ) {
6772 die "Error copying rows from $orig_tbl->{name} to "
6773 . "$new_tbl->{name}: $EVAL_ERROR\n";
6774 }
6775 $orig_tbl->{copied} = 1; # flag for cleanup tasks
6776
6777
6778 # XXX Auto-choose the alter fk method BEFORE swapping/renaming tables
6779 # else everything will break because if drop_swap is chosen, then we
6780 # most NOT rename tables or drop the old table.
6781 if ( $alter_fk_method eq 'auto' ) {
6782 # If chunk time is set, then use the average rate of rows/s
6783 # from copying the orig table to determine the max size of
6784 # a child table that can be altered within one chunk time.
6785 # The limit is a fudge factor. Chunk time won't be set if
6786 # the user specified --chunk-size=N on the cmd line, in which
6787 # case the max child table size is their specified chunk size
6788 # times the fudge factor.
6789 my $max_rows
6790 = $o->get('dry-run') ? $o->get('chunk-size') * $limit
6791 : $chunk_time ? $avg_rate * $chunk_time * $limit
6792 : $o->get('chunk-size') * $limit;
6793 PTDEBUG && _d('Max allowed child table size:', $max_rows);
6794
6795 $alter_fk_method = determine_alter_fk_method(
6796 child_tables => $child_tables,
6797 max_rows => $max_rows,
6798 Cxn => $cxn,
6799 OptionParser => $o,
6800 );
6801
6802 if ( $alter_fk_method eq 'drop_swap' ) {
6803 $o->set('swap-tables', 0);
6804 $o->set('drop-old-table', 0);
6805 }
6806 }
6807
6808 # #####################################################################
6809 # XXX
6810 # Step 5: Rename tables: orig -> old, new -> orig
6811 # Past this step, the original table has been altered. This shouldn't
6812 # fail, but if it does, the failure could be serious depending on what
6813 # state the tables are left in.
6814 # XXX
6815 # #####################################################################
6816 my $old_tbl;
6817 if ( $o->get('swap-tables') ) {
6818 eval {
6819 $old_tbl = swap_tables(
6820 orig_tbl => $orig_tbl,
6821 new_tbl => $new_tbl,
6822 suffix => '_old',
6823 Cxn => $cxn,
6824 Quoter => $q,
6825 OptionParser => $o,
6826 );
6827 };
6828 if ( $EVAL_ERROR ) {
6829 die "Error swapping the tables: $EVAL_ERROR\n"
6830 . "Verify that the original table $orig_tbl->{name} has not "
6831 . "been modified or renamed to the old table $old_tbl->{name}. "
6832 . "Then drop the new table $new_tbl->{name} if it exists.\n";
6833 }
6834 }
6835 $orig_tbl->{swapped} = 1; # flag for cleanup tasks
6836 PTDEBUG && _d('Old table:', Dumper($old_tbl));
6837
6838 # #####################################################################
6839 # Step 6: Update foreign key constraints if there are child tables.
6840 # #####################################################################
6841 if ( $child_tables ) {
6842 eval {
6843 if ( $alter_fk_method eq 'none' ) {
6844 print "Not updating foreign keys because "
6845 . "--alter-foreign-keys-method=none. Foreign keys "
6846 . "that reference the table will no longer work.\n";
6847 }
6848 elsif ( $alter_fk_method eq 'rebuild_constraints' ) {
6849 rebuild_constraints(
6850 orig_tbl => $orig_tbl,
6851 old_tbl => $old_tbl,
6852 child_tables => $child_tables,
6853 OptionParser => $o,
6854 Quoter => $q,
6855 Cxn => $cxn,
6856 TableParser => $tp,
6857 );
6858 }
6859 elsif ( $alter_fk_method eq 'drop_swap' ) {
6860 drop_swap(
6861 orig_tbl => $orig_tbl,
6862 new_tbl => $new_tbl,
6863 Cxn => $cxn,
6864 OptionParser => $o,
6865 );
4240 }6866 }
4241 else {6867 else {
4242 die "Invalid --update-foreign-keys-method value: $rename_fk_method";6868 # This should "never" happen because we check this var earlier.
4243 }6869 die "Invalid --alter-foreign-keys-method: $alter_fk_method\n";
4244 }6870 }
42456871 };
4246 # #####################################################################6872 if ( $EVAL_ERROR ) {
4247 # Cleanup.6873 # TODO: improve error message and handling.
4248 # #####################################################################6874 die "Error updating foreign key constraints: $EVAL_ERROR\n";
4249 msg("Calling " . (ref $copy_rows). "::cleanup()");6875 }
4250 $copy_rows->cleanup(%plugin_args);6876 }
42516877
4252 msg("Calling " . (ref $capture_sync) . "::cleanup()");6878 # ########################################################################
4253 $capture_sync->cleanup(%plugin_args);6879 # Step 7: Drop the old table.
42546880 # ########################################################################
4255 if ( $o->get('rename-tables') && $o->get('drop-old-table') ) {6881 if ( $o->get('drop-old-table') ) {
4256 $sql = "DROP TABLE IF EXISTS `$db`.`$old_tbl`";6882 if ( $o->get('dry-run') ) {
4257 msg($sql);6883 print "Not dropping old table because this is a dry run.\n";
4258 $dbh->do($sql) unless $o->get('print');6884 }
4259 }6885 else {
4260 };6886 print "Dropping old table...\n";
4261 if ( $EVAL_ERROR ) {6887
4262 warn "An error occurred:\n\n$EVAL_ERROR\n"6888 if ( $alter_fk_method eq 'none' ) {
4263 . "Some triggers, temp tables, etc. may not have been removed. "6889 # Child tables still reference the old table, but the user
4264 . "Run with --cleanup-and-exit to remove these items.\n";6890 # has chosen to break fks, so we need to disable fk checks
4265 $exit_status = 1;6891 # in order to drop the old table.
4266 }6892 my $sql = "SET foreign_key_checks=0";
42676893 PTDEBUG && _d($sql);
4268 msg("$PROGRAM_NAME ended, exit status $exit_status");6894 print $sql, "\n" if $o->get('print');
6895 $cxn->dbh()->do($sql);
6896 }
6897
6898 my $sql = "DROP TABLE IF EXISTS $old_tbl->{name}";
6899 print $sql, "\n" if $o->get('print');
6900 PTDEBUG && _d($sql);
6901 eval {
6902 $cxn->dbh()->do($sql);
6903 };
6904 if ( $EVAL_ERROR ) {
6905 die "Error dropping the old table: $EVAL_ERROR\n";
6906 }
6907 print "Dropped old table $old_tbl->{name} OK.\n";
6908 }
6909 }
6910
6911 # ########################################################################
6912 # Done.
6913 # ########################################################################
6914 $orig_tbl->{success} = 1; # flag for cleanup tasks
6915 $cleanup = undef; # exec cleanup tasks
6916
4269 return $exit_status;6917 return $exit_status;
4270}6918}
42716919
4272# ############################################################################6920# ############################################################################
4273# Subroutines.6921# Subroutines.
4274# ############################################################################6922# ############################################################################
4275sub check_tables {6923sub create_new_table{
6924 my (%args) = @_;
6925 my @required_args = qw(orig_tbl Cxn Quoter OptionParser TableParser);
6926 foreach my $arg ( @required_args ) {
6927 die "I need a $arg argument" unless $args{$arg};
6928 }
6929 my ($orig_tbl, $cxn, $q, $o, $tp) = @args{@required_args};
6930
6931 # Get the original table struct.
6932 my $ddl = $tp->get_create_table(
6933 $cxn->dbh(),
6934 $orig_tbl->{db},
6935 $orig_tbl->{tbl},
6936 );
6937
6938 my $tries = $args{tries} || 10; # don't try forever
6939 my $prefix = $args{prefix} || '_';
6940 my $suffix = $args{suffix} || '_new';
6941 my $table_name = $orig_tbl->{tbl} . $suffix;
6942
6943 print "Creating new table...\n";
6944 my $tryno = 1;
6945 my @old_tables;
6946 while ( $tryno++ < $tries ) {
6947 $table_name = $prefix . $table_name;
6948 my $quoted = $q->quote($orig_tbl->{db}, $table_name);
6949
6950 # Generate SQL to create the new table. We do not use CREATE TABLE LIKE
6951 # because it doesn't preserve foreign key constraints. Here we need to
6952 # rename the FK constraints, too. This is because FK constraints are
6953 # internally stored as <database>.<constraint> and there cannot be
6954 # duplicates. If we don't rename the constraints, then InnoDB will throw
6955 # error 121 (duplicate key violation) when we try to execute the CREATE
6956 # TABLE. TODO: this code isn't perfect. If we rename a constraint from
6957 # foo to _foo and there is already a constraint with that name in this
6958 # or another table, we can still have a collision. But if there are
6959 # multiple FKs on this table, it's hard to know which one is causing the
6960 # trouble. Should we generate random/UUID FK names or something instead?
6961 my $sql = $ddl;
6962 $sql =~ s/\ACREATE TABLE .*?\($/CREATE TABLE $quoted (/m;
6963 $sql =~ s/^ CONSTRAINT `/ CONSTRAINT `_/gm;
6964 PTDEBUG && _d($sql);
6965 eval {
6966 $cxn->dbh()->do($sql);
6967 };
6968 if ( $EVAL_ERROR ) {
6969 # Ignore this error because if multiple instances of the tool
6970 # are running, or previous runs failed and weren't cleaned up,
6971 # then there will be other similarly named tables with fewer
6972 # leading prefix chars. Or, in rarer cases, the db just happens
6973 # to have a similarly named table created by the user for other
6974 # purposes.
6975 if ( $EVAL_ERROR =~ m/table.+?already exists/i ) {
6976 push @old_tables, $q->quote($orig_tbl->{db}, $table_name);
6977 next;
6978 }
6979
6980 # Some other error happened. Let the caller catch it.
6981 die $EVAL_ERROR;
6982 }
6983 print $sql, "\n" if $o->get('print'); # the sql that work
6984 print "Created new table $orig_tbl->{db}.$table_name OK.\n";
6985 return { # success
6986 db => $orig_tbl->{db},
6987 tbl => $table_name,
6988 name => $q->quote($orig_tbl->{db}, $table_name),
6989 };
6990 }
6991
6992 die "Failed to find a unique new table name after $tries attemps. "
6993 . "The following tables exist which may be left over from previous "
6994 . "failed runs of the tool:\n"
6995 . join("\n", map { " $_" } @old_tables)
6996 . "\nExamine these tables and drop some or all of them if they are "
6997 . "no longer need, then re-run the tool.\n";
6998}
6999
7000sub swap_tables {
7001 my (%args) = @_;
7002 my @required_args = qw(orig_tbl new_tbl Cxn Quoter OptionParser);
7003 foreach my $arg ( @required_args ) {
7004 die "I need a $arg argument" unless $args{$arg};
7005 }
7006 my ($orig_tbl, $new_tbl, $cxn, $q, $o) = @args{@required_args};
7007
7008 my $prefix = '_';
7009 my $table_name = $orig_tbl->{tbl} . ($args{suffix} || '');
7010 my $tries = 10; # don't try forever
7011
7012 # This sub only works for --execute. Since the options are
7013 # mutually exclusive and we return in the if case, the elsif
7014 # is just a paranoid check because swapping the tables is one
7015 # of the most sensitive/dangerous operations.
7016 if ( $o->get('dry-run') ) {
7017 print "Not swapping tables because this is a dry run.\n";
7018
7019 # A return value really isn't needed, but this trick allows
7020 # rebuild_constraints() to parse and show the sql statements
7021 # it would used. Otherwise, this has no effect.
7022 return $orig_tbl;
7023 }
7024 elsif ( $o->get('execute') ) {
7025 print "Swapping tables...\n";
7026
7027 while ( $tries-- ) {
7028 $table_name = $prefix . $table_name;
7029 my $sql = "RENAME TABLE $orig_tbl->{name} "
7030 . "TO " . $q->quote($orig_tbl->{db}, $table_name)
7031 . ", $new_tbl->{name} TO $orig_tbl->{name}";
7032 PTDEBUG && _d($sql);
7033 eval {
7034 $cxn->dbh()->do($sql);
7035 };
7036 if ( $EVAL_ERROR ) {
7037 # Ignore this error because if multiple instances of the tool
7038 # are running, or previous runs failed and weren't cleaned up,
7039 # then there will be other similarly named tables with fewer
7040 # leading prefix chars. Or, in rarer cases, the db just happens
7041 # to have a similarly named table created by the user for other
7042 # purposes.
7043 next if $EVAL_ERROR =~ m/table.+?already exists/i;
7044
7045 # Some other error happened. Let caller catch it.
7046 die $EVAL_ERROR;
7047 }
7048 print $sql, "\n" if $o->get('print');
7049 print "Swapped original and new tables OK.\n";
7050 return { # success
7051 db => $orig_tbl->{db},
7052 tbl => $table_name,
7053 name => $q->quote($orig_tbl->{db}, $table_name),
7054 };
7055 }
7056
7057 # This shouldn't happen.
7058 # Here and in the attempt to find a new table name we probably ought to
7059 # use --retries (and maybe a Retry object?)
7060 die "Failed to find a unique old table name after serveral attempts.\n";
7061 }
7062}
7063
7064sub check_orig_table {
4276 my ( %args ) = @_;7065 my ( %args ) = @_;
4277 my @required_args = qw(dbh db tbl tmp_tbl old_tbl VersionParser Quoter TableParser OptionParser TableChunker);7066 my @required_args = qw(orig_tbl Cxn TableParser OptionParser Quoter);
4278 foreach my $arg ( @required_args ) {7067 foreach my $arg ( @required_args ) {
4279 die "I need a $arg argument" unless $args{$arg};7068 die "I need a $arg argument" unless $args{$arg};
4280 }7069 }
4281 my ($dbh, $db, $tbl, $tmp_tbl, $old_tbl, $o, $tp)7070 my ($orig_tbl, $cxn, $tp, $o, $q) = @args{@required_args};
4282 = @args{qw(dbh db tbl tmp_tbl old_tbl OptionParser TableParser)};7071
42837072 my $dbh = $cxn->dbh();
4284 msg("Checking if table $tbl can be altered");7073
4285 my %tbl_info;7074 # The original table must exist, of course.
4286 my $sql = "";7075 if (!$tp->check_table(dbh=>$dbh,db=>$orig_tbl->{db},tbl=>$orig_tbl->{tbl})) {
42877076 die "The original table $orig_tbl->{name} does not exist.\n";
4288 # ########################################################################7077 }
4289 # Check MySQL.7078
4290 # ######################################################################## 7079 # There cannot be any triggers on the original table.
4291 # Although triggers were introduced in 5.0.2, "Prior to MySQL 5.0.10,7080 my $sql = 'SHOW TRIGGERS FROM ' . $q->quote($orig_tbl->{db})
4292 # triggers cannot contain direct references to tables by name."7081 . ' LIKE ' . $q->literal_like($orig_tbl->{tbl});
4293 if ( !$args{VersionParser}->version_ge($dbh, '5.0.10') ) {7082 PTDEBUG && _d($sql);
4294 die "This tool requires MySQL 5.0.10 or newer\n";
4295 }
4296
4297 # ########################################################################
4298 # Check the (original) table.
4299 # ########################################################################
4300 # The table must exist of course.
4301 if ( !$tp->check_table(dbh=>$dbh, db=>$db, tbl=>$tbl) ) {
4302 die "Table $db.$tbl does not exist\n";
4303 }
4304
4305 # There cannot be any triggers on the table.
4306 $sql = "SHOW TRIGGERS FROM `$db` LIKE '$tbl'";
4307 msg($sql);
4308 my $triggers = $dbh->selectall_arrayref($sql);7083 my $triggers = $dbh->selectall_arrayref($sql);
4309 if ( $triggers && @$triggers ) {7084 if ( $triggers && @$triggers ) {
4310 die "Table $db.$tbl has triggers. This tool needs to create "7085 die "The table $orig_tbl->{name} has triggers. This tool "
4311 . "its own triggers, so the table cannot already have triggers.\n";7086 . "needs to create its own triggers, so the table cannot "
7087 . "already have triggers.\n";
4312 }7088 }
43137089
4314 # For now, we require that the old table has an exact-chunkable7090 # Get the table struct. NibbleIterator needs this, and so do we.
4315 # column (i.e. unique single-column).7091 my $ddl = $tp->get_create_table(
4316 $tbl_info{tbl_struct} = $tp->parse($tp->get_create_table($dbh, $db, $tbl));7092 $cxn->dbh(),
4317 my ($exact, @chunkable_cols) = $args{TableChunker}->find_chunk_columns(7093 $orig_tbl->{db},
4318 tbl_struct => $tbl_info{tbl_struct},7094 $orig_tbl->{tbl},
4319 exact => 1,
4320 );7095 );
4321 if ( !$exact || !@chunkable_cols ) {7096 $orig_tbl->{tbl_struct} = $tp->parse($ddl);
4322 die "Table $db.$tbl cannot be chunked because it does not have "7097
4323 . "a unique, single-column index\n";7098 # Must be able to nibble the original table (to copy rows to the new table).
4324 }7099 eval {
4325 $tbl_info{chunk_column} = $chunkable_cols[0]->{column};7100 NibbleIterator::can_nibble(
4326 $tbl_info{chunk_index} = $chunkable_cols[0]->{index};7101 Cxn => $cxn,
43277102 tbl => $orig_tbl,
4328 # ########################################################################7103 chunk_size => $o->get('chunk-size'),
4329 # Check the tmp table.7104 chunk_indx => $o->get('chunk-index'),
4330 # ######################################################################## 7105 OptionParser => $o,
4331 # The tmp table should not exist if we're supposed to create it.7106 TableParser => $tp,
4332 # Else, if user specifies --no-create-tmp-table, they should ensure7107 );
4333 # that it exists.7108 };
4334 if ( $o->get('create-tmp-table')7109 if ( $EVAL_ERROR ) {
4335 && $tp->check_table(dbh=>$dbh, db=>$db, tbl=>$tmp_tbl) ) {7110 die "Cannot chunk the original table $orig_tbl->{name}: $EVAL_ERROR\n";
4336 die "Temporary table $db.$tmp_tbl exists which will prevent "7111 }
4337 . "--create-tmp-table from creating the temporary table.\n";7112
4338 }7113 # Find a pk or unique index to use for the delete trigger. can_nibble()
43397114 # above returns an index, but NibbleIterator will use non-unique indexes,
4340 # ########################################################################7115 # so we have to do this again here.
4341 # Check the old table.7116 my $indexes = $orig_tbl->{tbl_struct}->{indexes}; # brevity
4342 # ######################################################################## 7117 foreach my $index ( $tp->sort_indexes($orig_tbl->{tbl_struct}) ) {
4343 # If we're going to rename the tables, which we do by default, then7118 if ( $index eq 'PRIMARY' || $indexes->{$index}->{is_unique} ) {
4344 # the old table cannot already exist.7119 PTDEBUG && _d('Delete trigger index:', Dumper($index));
4345 if ( $o->get('rename-tables')7120 $orig_tbl->{del_index} = $index;
4346 && $tp->check_table(dbh=>$dbh, db=>$db, tbl=>$old_tbl) ) {7121 last;
4347 die "Table $db.$old_tbl exists which will prevent $db.$tbl "7122 }
4348 . "from being renamed to it. Table $db.$old_tbl could be from "7123 }
4349 . "a previous run that failed. See --drop-old-table for more "7124 if ( !$orig_tbl->{del_index} ) {
4350 . "information.\n";7125 die "The original table $orig_tbl->{name} does not have a PRIMARY KEY "
4351 }7126 . "or a unique index which is required for the DELETE trigger.\n";
43527127 }
4353 return %tbl_info;7128
7129 return; # success
4354}7130}
43557131
4356sub get_child_tables {7132sub find_child_tables {
4357 my ( %args ) = @_;7133 my ( %args ) = @_;
4358 my @required_args = qw(dbh db tbl Quoter);7134 my @required_args = qw(tbl Cxn Quoter);
4359 foreach my $arg ( @required_args ) {7135 foreach my $arg ( @required_args ) {
4360 die "I need a $arg argument" unless $args{$arg};7136 die "I need a $arg argument" unless $args{$arg};
4361 }7137 }
4362 my ($dbh, $db, $tbl, $q) = @args{@required_args};7138 my ($tbl, $cxn, $q) = @args{@required_args};
43637139
4364 my $sql = "SELECT table_name "7140 PTDEBUG && _d('Finding child tables');
7141
7142 my $sql = "SELECT table_schema, table_name "
4365 . "FROM information_schema.key_column_usage "7143 . "FROM information_schema.key_column_usage "
4366 . "WHERE constraint_schema='$db' AND referenced_table_name='$tbl'";7144 . "WHERE constraint_schema='$tbl->{db}' "
4367 PTDEBUG && _d($dbh, $sql);7145 . "AND referenced_table_name='$tbl->{tbl}'";
4368 my $child_tables;7146 PTDEBUG && _d($sql);
4369 eval {7147 my $rows = $cxn->dbh()->selectall_arrayref($sql);
4370 $child_tables = $dbh->selectall_arrayref($sql);7148 if ( !$rows || !@$rows ) {
4371 };7149 PTDEBUG && _d('No child tables found');
4372 if ( $EVAL_ERROR ) {7150 return;
4373 die "Error executing query to check $tbl for child tables.\n\n"7151 }
4374 . "Query: $sql\n\n"7152
4375 . "Error: $EVAL_ERROR"7153 my @child_tables;
4376 }7154 foreach my $row ( @$rows ) {
43777155 my $tbl = {
4378 PTDEBUG && _d("Child tables:", join(', ', map { $_->[0] } @$child_tables));7156 db => $row->[0],
4379 return map { $_->[0] } @$child_tables;7157 tbl => $row->[1],
4380}7158 name => $q->quote(@$row),
43817159 };
4382sub update_foreign_key_constraints {7160
4383 my ( %args ) = @_;7161 # Get row estimates for each child table so we can give the user
4384 my @required_args = qw(msg dbh db tbl old_tbl child_tables Quoter);7162 # some input on choosing an --alter-foreign-keys-method if they
4385 foreach my $arg ( @required_args ) {7163 # don't use "auto".
4386 die "I need a $arg argument" unless $args{$arg};7164 my ($n_rows) = NibbleIterator::get_row_estimate(
4387 }7165 Cxn => $cxn,
4388 my ($msg, $dbh, $db, $tbl, $old_tbl, $child_tables, $q)7166 tbl => $tbl,
7167 );
7168 $tbl->{row_est} = $n_rows;
7169
7170 push @child_tables, $tbl;
7171 }
7172
7173 PTDEBUG && _d('Child tables:', Dumper(\@child_tables));
7174 return \@child_tables;
7175}
7176
7177sub determine_alter_fk_method {
7178 my ( %args ) = @_;
7179 my @required_args = qw(child_tables max_rows Cxn OptionParser);
7180 foreach my $arg ( @required_args ) {
7181 die "I need a $arg argument" unless $args{$arg};
7182 }
7183 my ($child_tables, $max_rows, $cxn, $o) = @args{@required_args};
7184
7185 if ( $o->get('dry-run') ) {
7186 print "Not determining the method to update foreign keys "
7187 . "because this is a dry run.\n";
7188 return ''; # $alter_fk_method can't be undef
7189 }
7190
7191 # The rebuild_constraints method is the default becuase it's safer
7192 # and doesn't cause the orig table to go missing for a moment.
7193 my $method = 'rebuild_constraints';
7194
7195 print "Max rows for the rebuild_constraints method: $max_rows\n",
7196 "Determining the method to update foreign keys...\n";
7197 foreach my $child_tbl ( @$child_tables ) {
7198 print " $child_tbl->{name}: ";
7199 my ($n_rows) = NibbleIterator::get_row_estimate(
7200 Cxn => $cxn,
7201 tbl => $child_tbl,
7202 );
7203 if ( $n_rows > $max_rows ) {
7204 print "too many rows: $n_rows; must use drop_swap\n";
7205 $method = 'drop_swap';
7206 last;
7207 }
7208 else {
7209 print "$n_rows rows; can use rebuild_constraints\n";
7210 }
7211 }
7212
7213 return $method || ''; # $alter_fk_method can't be undef
7214}
7215
7216sub rebuild_constraints {
7217 my ( %args ) = @_;
7218 my @required_args = qw(orig_tbl old_tbl child_tables
7219 Cxn Quoter OptionParser TableParser);
7220 foreach my $arg ( @required_args ) {
7221 die "I need a $arg argument" unless $args{$arg};
7222 }
7223 my ($orig_tbl, $old_tbl, $child_tables, $cxn, $q, $o, $tp)
4389 = @args{@required_args};7224 = @args{@required_args};
43907225
4391 my $constraint = qr/^\s+(CONSTRAINT.+?REFERENCES `$old_tbl`.+)$/mo;7226 # MySQL has a "feature" where if the parent tbl is in the same db,
7227 # then the child tbl ref is simply `parent_tbl`, but if the parent tbl
7228 # is in another db, then the child tbl ref is `other_db`.`parent_tbl`.
7229 # When we recreate the ref below, we use the db-qualified form, and
7230 # MySQL will automatically trim the db if the tables are in the same db.
7231 my $quoted_old_table = $q->quote($old_tbl->{tbl});
7232 my $constraint = qr/
7233 ^\s+
7234 (
7235 CONSTRAINT.+?
7236 REFERENCES\s(?:$quoted_old_table|$old_tbl->{name})
7237 .+
7238 )$
7239 /xm;
7240 PTDEBUG && _d('Rebuilding fk constraint matching', $constraint);
7241
7242 if ( $o->get('dry-run') ) {
7243 print "Not rebuilding foreign key constraints because this is a dry run.\n";
7244 }
7245 else {
7246 print "Rebuilding foreign key constraints...\n";
7247 }
43927248
4393 CHILD_TABLE:7249 CHILD_TABLE:
4394 foreach my $child_table ( @$child_tables ) {7250 foreach my $child_tbl ( @$child_tables ) {
4395 my $sql = "SHOW CREATE TABLE `$db`.`$child_table`";7251 my $table_def = $tp->get_create_table(
4396 PTDEBUG && _d($dbh, $sql);7252 $cxn->dbh(),
4397 $msg->($sql);7253 $child_tbl->{db},
4398 my $table_def;7254 $child_tbl->{tbl},
4399 eval {7255 );
4400 $table_def = $dbh->selectrow_arrayref($sql)->[1];
4401 };
4402 if ( $EVAL_ERROR ) {
4403 warn "Skipping child table $child_table: $EVAL_ERROR";
4404 next CHILD_TABLE;
4405 }
4406
4407 my @constraints = $table_def =~ m/$constraint/g;7256 my @constraints = $table_def =~ m/$constraint/g;
4408 if ( !@constraints ) {7257 if ( !@constraints ) {
4409 warn "Child table `$child_table` does not have any foreign key "7258 warn "$child_tbl->{name} has no foreign key "
4410 . "constraints referencing $old_tbl";7259 . "constraints referencing $old_tbl->{name}.\n";
4411 next CHILD_TABLE;7260 next CHILD_TABLE;
4412 }7261 }
44137262
7263 my @rebuilt_constraints;
4414 foreach my $constraint ( @constraints ) {7264 foreach my $constraint ( @constraints ) {
4415 my ($fk_symbol) = $constraint =~ m/CONSTRAINT\s+(\S+)/;7265 PTDEBUG && _d('Rebuilding fk constraint:', $constraint);
4416 $sql = "ALTER TABLE `$db`.`$child_table` DROP FOREIGN KEY $fk_symbol";7266
4417 $msg->($sql);7267 # Remove trailing commas in case there are multiple constraints on the
4418 $dbh->do($sql) unless $args{print};7268 # table.
44197269 $constraint =~ s/,$//;
4420 $constraint =~ s/REFERENCES `$old_tbl`/REFERENCES `$tbl`/o;7270
4421 $sql = "ALTER TABLE `$db`.`$child_table` ADD $constraint"; 7271 # Find the constraint name. It will be quoted already.
4422 $msg->($sql);7272 my ($fk) = $constraint =~ m/CONSTRAINT\s+`([^`]+)`/;
4423 $dbh->do($sql) unless $args{print};7273
4424 }7274 # Drop the reference to the old table/renamed orig table, and add a new
4425 }7275 # reference to the new table. InnoDB will throw an error if the new
44267276 # constraint has the same name as the old one, so we must rename it.
4427 return;7277 # Example: after renaming sakila.actor to sakila.actor_old (for
4428}7278 # example), the foreign key on film_actor looks like this:
44297279 # CONSTRAINT `fk_film_actor_actor` FOREIGN KEY (`actor_id`) REFERENCES
4430sub intersection {7280 # `actor_old` (`actor_id`) ON UPDATE CASCADE
4431 my ( $hashes ) = @_;7281 # We need it to look like this instead:
4432 my %keys = map { $_ => 1 } keys %{$hashes->[0]};7282 # CONSTRAINT `_fk_film_actor_actor` FOREIGN KEY (`actor_id`) REFERENCES
4433 my $n_hashes = (scalar @$hashes) - 1;7283 # `actor` (`actor_id`) ON UPDATE CASCADE
4434 my @isect = grep { $keys{$_} } map { keys %{$hashes->[$_]} } 1..$n_hashes;7284 # Reference the correct table name...
4435 return @isect;7285 $constraint =~ s/REFERENCES[^\(]+/REFERENCES $orig_tbl->{name} /;
4436}7286 # And rename the constraint to avoid conflict
44377287 $constraint =~ s/CONSTRAINT `$fk`/CONSTRAINT `_$fk`/;
4438sub get_cxn {7288
4439 my ( %args ) = @_;7289 my $sql = "DROP FOREIGN KEY `$fk`, "
4440 my ($dsn, $ac, $dp, $o) = @args{qw(dsn AutoCommit DSNParser OptionParser)};7290 . "ADD $constraint";
44417291 push @rebuilt_constraints, $sql;
4442 if ( $o->get('ask-pass') ) {7292 }
4443 $dsn->{p} = OptionParser::prompt_noecho("Enter password: "); 7293
4444 }7294 my $sql = "ALTER TABLE $child_tbl->{name} "
4445 my $dbh = $dp->get_dbh($dp->get_cxn_params($dsn), {AutoCommit => $ac});7295 . join(', ', @rebuilt_constraints);
44467296 print $sql, "\n" if $o->get('print');
4447 $dbh->do('SET SQL_LOG_BIN=0') unless $o->get('bin-log');7297 if ( $o->get('execute') ) {
4448 $dbh->do('SET FOREIGN_KEY_CHECKS=0') unless $o->get('foreign-key-checks');7298 PTDEBUG && _d($sql);
44497299 $cxn->dbh()->do($sql);
4450 return $dbh;7300 }
4451}7301 }
44527302
4453sub msg {7303 if ( $o->get('execute') ) {
4454 my ( $msg ) = @_;7304 print "Rebuilt foreign key constraints OK.\n";
4455 chomp $msg;7305 }
4456 print '# ', ts(time), " $msg\n" unless $quiet;7306
4457 PTDEBUG && _d($msg);7307 return;
4458 return;7308}
4459}7309
44607310sub drop_swap {
4461# Only for tests which may not call main().7311 my ( %args ) = @_;
4462sub __set_quiet {7312 my @required_args = qw(orig_tbl new_tbl Cxn OptionParser);
4463 $quiet = $_[0];7313 foreach my $arg ( @required_args ) {
7314 die "I need a $arg argument" unless $args{$arg};
7315 }
7316 my ($orig_tbl, $new_tbl, $cxn, $o) = @args{@required_args};
7317
7318 if ( $o->get('dry-run') ) {
7319 print "Not drop-swapping tables because this is a dry run.\n";
The diff has been truncated for viewing.

Subscribers

People subscribed via source and target branches