Fix sandbox/load-sakila-db so it exits on error.

bin/pt-online-schema-change

@@ -7533,6 +7533,81 @@ sub _d {
 # End Pingback package
 # ###########################################################################
 
+# ###########################################################################
+# Percona::XtraDB::Cluster package
+# ###########################################################################
+{
+# Package: Percona::XtraDB::Cluster
+# Helper methods for dealing with Percona XtraDB Cluster nodes.
+package Percona::XtraDB::Cluster;
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use constant PTDEBUG => $ENV{PTDEBUG} || 0;
+
+use Mo;
+use Data::Dumper;
+
+sub get_cluster_name {
+   my ($self, $cxn) = @_;
+   my $sql = "SHOW VARIABLES LIKE 'wsrep\_cluster\_name'";
+   PTDEBUG && _d($cxn->name, $sql);
+   my (undef, $cluster_name) = $cxn->dbh->selectrow_array($sql);
+   return $cluster_name;
+}
+
+sub is_cluster_node {
+   my ($self, $cxn) = @_;
+
+   my $sql = "SHOW VARIABLES LIKE 'wsrep\_on'";
+   PTDEBUG && _d($cxn->name, $sql);
+   my $row = $cxn->dbh->selectrow_arrayref($sql);
+   PTDEBUG && _d(Dumper($row));
+   return unless $row && $row->[1] && ($row->[1] eq 'ON' || $row->[1] eq '1');
+
+   my $cluster_name = $self->get_cluster_name($cxn);
+   return $cluster_name;
+}
+
+sub same_node {
+   my ($self, $cxn1, $cxn2) = @_;
+
+   my $sql = "SHOW VARIABLES LIKE 'wsrep\_sst\_receive\_address'";
+   PTDEBUG && _d($cxn1->name, $sql);
+   my (undef, $val1) = $cxn1->dbh->selectrow_array($sql);
+   PTDEBUG && _d($cxn2->name, $sql);
+   my (undef, $val2) = $cxn2->dbh->selectrow_array($sql);
+
+   return ($val1 || '') eq ($val2 || '');
+}
+
+sub same_cluster {
+   my ($self, $cxn1, $cxn2) = @_;
+
+   # They can't be the same cluster if one of them isn't in a cluster.
+   return 0 if !$self->is_cluster_node($cxn1) || !$self->is_cluster_node($cxn2);
+
+   my $cluster1 = $self->get_cluster_name($cxn1);
+   my $cluster2 = $self->get_cluster_name($cxn2);
+
+   return ($cluster1 || '') eq ($cluster2 || '');
+}
+
+sub _d {
+   my ($package, undef, $line) = caller 0;
+   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
+        map { defined $_ ? $_ : 'undef' }
+        @_;
+   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
+}
+
+1;
+}
+# ###########################################################################
+# End Percona::XtraDB::Cluster package
+# ###########################################################################
+
 # ###########################################################################
 # This is a combination of modules and programs in one -- a runnable module.
 # http://www.perl.com/pub/a/2006/07/13/lightning-articles.html?page=last
@@ -7938,7 +8013,7 @@ sub main {
    # ########################################################################
    # Setup and check the original table.
    # ########################################################################
-   my $tp = new TableParser(Quoter => $q);
+   my $tp = TableParser->new(Quoter => $q);
 
    # Common table data struct (that modules like NibbleIterator expect).
    my $orig_tbl = {
@@ -8096,6 +8171,32 @@ sub main {
       return;
    };
 
+   # ########################################################################
+   # Check the --alter statement.  This is done again after the 
+   # ########################################################################
+   my $renamed_cols = find_renamed_cols(
+      alter       => $o->get('alter'),
+      TableParser => $tp,
+   );
+
+   if ( $o->get('check-alter') ) {
+      check_alter(
+         tbl          => $orig_tbl,
+         alter        => $o->get('alter'),
+         dry_run      => $o->get('dry-run'),
+         renamed_cols => $renamed_cols,
+         Cxn          => $cxn,
+         TableParser  => $tp,
+      );
+   }
+
+   if ( %$renamed_cols && !$o->get('dry-run') ) {
+      print "Renaming columns:\n"
+         . join("\n", map { "  $_ to $renamed_cols->{$_}" }
+            sort keys %$renamed_cols)
+         . "\n";
+   }
+
    # ########################################################################
    # Check and create PID file if user specified --pid.
    # ########################################################################
@@ -8183,8 +8284,6 @@ sub main {
    # Step 2: Alter the new, empty table.  This should be very quick,
    # or die if the user specified a bad alter statement.
    # #####################################################################
-   my %renamed_cols;
-
    if ( my $alter = $o->get('alter') ) {
       print "Altering new table...\n";
       my $sql = "ALTER TABLE $new_tbl->{name} $alter";
@@ -8197,27 +8296,6 @@ sub main {
          die "Error altering new table $new_tbl->{name}: $EVAL_ERROR\n"
       }
       print "Altered $new_tbl->{name} OK.\n";
-
-      # Check for renamed columns.
-      # https://bugs.launchpad.net/percona-toolkit/+bug/1068562
-      %renamed_cols = find_renamed_cols($alter, $tp);
-      PTDEBUG && _d("Renamed columns (old => new): ", Dumper(\%renamed_cols));
-      if ( %renamed_cols && $o->get('check-alter') ) {
-         # sort is just for making output consistent for testing
-         my $msg = "--alter appears to rename these columns: "
-                 . join(", ", map { "$_ to $renamed_cols{$_}" }
-                              sort keys %renamed_cols);
-         if ( $o->get('dry-run') ) {
-            print $msg . "\n"
-         }
-         else {
-            die $msg
-               . ".  The tool should handle this correctly, but you should "
-               . "test it first because if it fails the renamed columns' "
-               . "data will be lost!  Specify --no-check-alter to disable "
-               . "this check and perform the --alter.\n";
-         }
-      }
    }
 
    # Get the new table struct.  This shouldn't die because
@@ -8240,9 +8318,9 @@ sub main {
    my $col_posn    = $orig_tbl->{tbl_struct}->{col_posn};
    my $orig_cols   = $orig_tbl->{tbl_struct}->{is_col};
    my $new_cols    = $new_tbl->{tbl_struct}->{is_col};
-   my @common_cols = map  { +{ old => $_, new => $renamed_cols{$_} || $_ } }
+   my @common_cols = map  { +{ old => $_, new => $renamed_cols->{$_} || $_ } }
                      sort { $col_posn->{$a} <=> $col_posn->{$b} }
-                     grep { $new_cols->{$_} || $renamed_cols{$_} }
+                     grep { $new_cols->{$_} || $renamed_cols->{$_} }
                      keys %$orig_cols;
    PTDEBUG && _d('Common columns', Dumper(\@common_cols));
 
@@ -8799,8 +8877,75 @@ sub main {
 # Subroutines.
 # ############################################################################
 
+sub check_alter {
+   my (%args) = @_;
+   my @required_args = qw(alter tbl dry_run Cxn TableParser);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless exists $args{$arg};
+   }
+   my ($alter, $tbl, $dry_run, $cxn, $tp) = @args{@required_args};
+
+   my $ok = 1;
+
+   # ########################################################################
+   # Check for renamed columns.
+   # https://bugs.launchpad.net/percona-toolkit/+bug/1068562
+   # ########################################################################
+   my $renamed_cols = $args{renamed_cols};
+   if ( %$renamed_cols ) {
+      # sort is just for making output consistent for testing
+      my $msg = "--alter appears to rename these columns:\n"
+              . join("\n", map { "  $_ to $renamed_cols->{$_}" }
+                           sort keys %$renamed_cols)
+              . "\n";
+      if ( $dry_run ) {
+         print $msg;
+      }
+      else {
+         $ok = 0;
+         warn $msg
+            . "The tool should handle this correctly, but you should "
+            . "test it first because if it fails the renamed columns' "
+            . "data will be lost!  Specify --no-check-alter to disable "
+            . "this check and perform the --alter.\n";
+      }
+   }
+
+   # ########################################################################
+   # If it's a cluster node, check for MyISAM which does not work.
+   # ########################################################################
+   my $cluster = Percona::XtraDB::Cluster->new;
+   if ( $cluster->is_cluster_node($cxn) ) {
+      if ( ($tbl->{tbl_struct}->{engine} || '') =~ m/MyISAM/i ) {
+         $ok = 0;
+         warn $cxn->name . " is a cluster node and the table is MyISAM, "
+            . "but MyISAM tables "
+            . "do not work with clusters and this tool.  To alter the "
+            . "table, you must manually convert it to InnoDB first.\n";
+      }
+      elsif ( $alter =~ m/ENGINE=MyISAM/i ) {
+         $ok = 0;
+         warn $cxn->name . " is a cluster node and the table is being "
+            . "converted to MyISAM (ENGINE=MyISAM), but MyISAM tables "
+            . "do not work with clusters and this tool.  To alter the "
+            . "table, you must manually convert it to InnoDB first.\n";
+      }
+   }
+
+   if ( !$ok ) {
+      die "--check-alter failed.\n";
+   }
+
+   return;
+}
+
 sub find_renamed_cols {
-   my ($alter, $tp) = @_;
+   my (%args) = @_;
+   my @required_args = qw(alter TableParser);
+   foreach my $arg ( @required_args ) {
+      die "I need a $arg argument" unless $args{$arg};
+   }
+   my ($alter, $tp) = @args{@required_args};
 
    my $unquoted_ident = qr/
       (?!\p{Digit}+[.\s])            # Not all digits
@@ -8815,12 +8960,12 @@ sub find_renamed_cols {
          # The following alternation is there because something like (?<=.)
          # would match if this regex was used like /.$re/,
          # or even more tellingly, would match on "``" =~ /`$re`/
-            $quoted_ident_character+               # One or more characters
+         $quoted_ident_character+        # One or more characters
-               (?: `` $quoted_ident_character*  )* # possibly followed by `` and
+         (?:``$quoted_ident_character*)* # possibly followed by `` and
-                                                   # more characters, zero or more times
+                                         # more characters, zero or more times
-         |  $quoted_ident_character*               # OR, zero or more characters
+         |$quoted_ident_character*         # OR, zero or more characters
-               (?: `` $quoted_ident_character*  )+ # Followed by `` and maybe more
+          (?:``$quoted_ident_character* )+ # Followed by `` and maybe more
-                                                   # characters, one or more times.
+                                           # characters, one or more times.
       }x
    };
 
@@ -8843,7 +8988,8 @@ sub find_renamed_cols {
       next if lc($orig_tbl) eq lc($new_tbl);
       $renames{$orig_tbl} = $new_tbl;
    }
-   return %renames;
+   PTDEBUG && _d("Renamed columns (old => new): ", Dumper(\%renames));
+   return \%renames;
 }
 
 sub nibble_is_safe {
@@ -9819,8 +9965,24 @@ transactions. See L<"--lock-wait-timeout"> for details.
 The tool refuses to alter the table if foreign key constraints reference it,
 unless you specify L<"--alter-foreign-keys-method">.
 
+=item *
+
+The tool cannot alter MyISAM tables on L<"Percona XtraDB Cluster"> nodes.
+
 =back
 
+=head1 Percona XtraDB Cluster
+
+pt-online-schema-change works with Percona XtraDB Cluster (PXC) 5.5.27-23.6
+and newer, but there is one limitation: only InnoDB tables can be altered.
+The tool exits with an error if the host is a cluster node and the table
+is MyISAM or is being converted to MyISAM (C<ENGINE=MyISAM>).  There is no
+way to disable this check.
+
+pt-online-schema-change is not the same as and does not require that
+C<wsrep_OSU_method> be set to C<RSU> (rolling schema upgrade).  The tool
+can be used in either mode, C<RSU> or C<TOI> (total order isolation).
+
 =head1 OUTPUT
 
 The tool prints information about its activities to STDOUT so that you can see

sandbox/load-sakila-db

@@ -5,7 +5,7 @@ die() {
    for msg; do
       echo $msg
    done
-   exit_status=1
+   exit 1
 }
 
 # ###########################################################################

t/pt-online-schema-change/alter_active_table.t

@@ -155,7 +155,7 @@ sub check_ids {
 # #############################################################################
 # Attempt to alter a table while another process is changing it.
 # #############################################################################
-sleep 2;
+
 my $db_flavor = VersionParser->new($master_dbh)->flavor();
 if ( $db_flavor =~ m/XtraDB Cluster/ ) {
    $sb->load_file('master', "$sample/basic_no_fks_innodb.sql");

t/pt-online-schema-change/find_renamed_cols.t

@@ -25,8 +25,11 @@ sub test_func {
    die "No renamed_cols arg" unless $renamed_cols;
    (my $show_alter = $alter) =~ s/\n/\\n/g;
    
-   my %got_renamed_cols = eval {
+   my $got_renamed_cols = eval {
-      pt_online_schema_change::find_renamed_cols($alter, $tp);
+      pt_online_schema_change::find_renamed_cols(
+         alter       => $alter,
+         TableParser => $tp,
+      );
    };
    if ( $EVAL_ERROR ) {
       is_deeply(
@@ -37,10 +40,10 @@ sub test_func {
    }
    else {
       is_deeply(
-         \%got_renamed_cols,
+         $got_renamed_cols,
          $renamed_cols,
          $show_alter,
-      ) or diag(Dumper(\%got_renamed_cols));
+      ) or diag(Dumper($got_renamed_cols));
    }
 }
 
@@ -209,15 +212,13 @@ test_func(
    },
 );
 
-TODO: {
+# TODO
-   local $::TODO = "We don't parse the entire alter statement, what looks like a CHANGE COLUMNS";
+## Not really an alter, pathological
-   # Not really an alter, pathological
+#test_func(
-   test_func(
+#   "MODIFY `CHANGE a z VARCHAR(255) NOT NULL` FLOAT",
-      "MODIFY `CHANGE a z VARCHAR(255) NOT NULL` FLOAT",
+#   {
-      {
+#   },
-      },
+#);
-   );
-}
 
 # #############################################################################
 # Done.

t/pt-online-schema-change/pxc.t

@@ -0,0 +1,112 @@
+#!/usr/bin/env perl
+
+BEGIN {
+   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
+      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
+   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
+};
+
+use strict;
+use warnings FATAL => 'all';
+use English qw(-no_match_vars);
+use Test::More;
+use Data::Dumper;
+
+# Hostnames make testing less accurate.  Tests need to see
+# that such-and-such happened on specific slave hosts, but
+# the sandbox servers are all on one host so all slaves have
+# the same hostname.
+$ENV{PERCONA_TOOLKIT_TEST_USE_DSN_NAMES} = 1;
+
+use PerconaTest;
+use Sandbox;
+
+require "$trunk/bin/pt-online-schema-change";
+# Do this after requiring ptc, since it uses Mo
+require VersionParser;
+
+my $dp = new DSNParser(opts=>$dsn_opts);
+my $sb = new Sandbox(basedir => '/tmp', DSNParser => $dp);
+my $node1 = $sb->get_dbh_for('node1');
+my $node2 = $sb->get_dbh_for('node2');
+my $node3 = $sb->get_dbh_for('node3');
+
+my $db_flavor = VersionParser->new($node1)->flavor();
+
+if ( $db_flavor !~ /XtraDB Cluster/ ) {
+   plan skip_all => "PXC tests";
+}
+elsif ( !$node1 ) {
+   plan skip_all => 'Cannot connect to cluster node1';
+}
+elsif ( !$node2 ) {
+   plan skip_all => 'Cannot connect to cluster node2';
+}
+elsif ( !$node3 ) {
+   plan skip_all => 'Cannot connect to cluster node3';
+}
+
+# The sandbox servers run with lock_wait_timeout=3 and it's not dynamic
+# so we need to specify --lock-wait-timeout=3 else the tool will die.
+my $node1_dsn = $sb->dsn_for('node1');
+my @args      = ($node1_dsn, qw(--lock-wait-timeout 3));
+my $output;
+my $exit;
+my $sample  = "t/pt-online-schema-change/samples/";
+
+# #############################################################################
+# Can't alter a MyISAM table.
+# #############################################################################
+
+$sb->load_file('node1', "$sample/basic_no_fks.sql");
+
+($output, $exit) = full_output(
+   sub { pt_online_schema_change::main(
+      "$node1_dsn,D=pt_osc,t=t",
+      qw(--lock-wait-timeout 5),
+      qw(--print --execute --alter ENGINE=InnoDB)) },
+   stderr => 1,
+);
+
+ok(
+   $exit,
+   "Table is MyISAM: non-zero exit"
+) or diag($output);
+
+like(
+   $output,
+   qr/is a cluster node and the table is MyISAM/,
+   "Table is MyISAM: error message"
+);
+
+# #############################################################################
+# Can't alter a table converted to MyISAM.
+# #############################################################################
+
+$sb->load_file('node1', "$sample/basic_no_fks_innodb.sql");
+
+($output, $exit) = full_output(
+   sub { pt_online_schema_change::main(
+      "$node1_dsn,D=pt_osc,t=t",
+      qw(--lock-wait-timeout 5),
+      qw(--print --execute --alter ENGINE=MyISAM)) },
+   stderr => 1,
+);
+
+ok(
+   $exit,
+   "Convert table to MyISAM: non-zero exit"
+) or diag($output);
+
+like(
+   $output,
+   qr/is a cluster node and the table is being converted to MyISAM/,
+   "Convert table to MyISAM: error message"
+);
+
+# #############################################################################
+# Done.
+# #############################################################################
+$sb->wipe_clean($node1);
+ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
+done_testing;

t/pt-online-schema-change/rename_columns.t

@@ -51,11 +51,10 @@ $sb->load_file('master', "$sample/data-loss-bug-1068562.sql");
       qw(--execute)) },
 );
 
-is(
+ok(
    $exit_status,
-   255,
    "Die if --execute without --no-check-alter"
-);
+) or diag($output);
 
 like(
    $output,
@@ -95,7 +94,7 @@ is(
    $exit_status,
    0,
    "sakila.city: Exit status 0",
-);
+) or diag($output);
 
 my $mod = $master_dbh->selectall_arrayref(q{SELECT some_cities FROM sakila.city});
 
@@ -177,7 +176,7 @@ is(
 
 like(
    $output,
-   qr/first_name to first_name_mod, last_name to last_name_mod/ms,
+   qr/first_name to first_name_mod.+?last_name to last_name_mod/ms,
    "--dry-run warns about renaming columns"
 );