← Back to branch summary

~percona-toolkit-dev/percona-toolkit/fix-password-comma-bug-886077

« back to all changes in this revision

Viewing changes to bin/pt-slave-restart

  • Committer: Daniel Nichter
  • Date: 2012-02-07 20:10:11 UTC
  • mfrom: (174 2.0)
  • mto: This revision was merged to the branch mainline in revision 189.
  • Revision ID: daniel@percona.com-20120207201011-sok2c1f2ay9qr3gm
Merge trunk r174.

Show diffs side-by-side

added added

removed removed

Lines of Context:
bin/pt-slave-restart
6
6
 
7
7
use strict;
8
8
use warnings FATAL => 'all';
9
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
9
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
10
10
 
11
11
# ###########################################################################
12
12
# Quoter package
22
22
use strict;
23
23
use warnings FATAL => 'all';
24
24
use English qw(-no_match_vars);
25
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
25
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
26
26
 
27
27
sub new {
28
28
   my ( $class, %args ) = @_;
99
99
use strict;
100
100
use warnings FATAL => 'all';
101
101
use English qw(-no_match_vars);
102
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
102
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
103
103
 
104
104
use List::Util qw(max);
105
105
use Getopt::Long;
183
183
   my $contents = do { local $/ = undef; <$fh> };
184
184
   close $fh;
185
185
   if ( $contents =~ m/^=head1 DSN OPTIONS/m ) {
186
 
      MKDEBUG && _d('Parsing DSN OPTIONS');
 
186
      PTDEBUG && _d('Parsing DSN OPTIONS');
187
187
      my $dsn_attribs = {
188
188
         dsn  => 1,
189
189
         copy => 1,
225
225
      $self->{DSNParser} = DSNParser->new(opts => \@dsn_opts);
226
226
   }
227
227
 
228
 
   if ( $contents =~ m/^(Percona Toolkit v.+)$/m ) {
 
228
   if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) {
229
229
      $self->{version} = $1;
230
 
      MKDEBUG && _d($self->{version});
 
230
      PTDEBUG && _d($self->{version});
231
231
   }
232
232
 
233
233
   return;
264
264
      chomp $para;
265
265
      $para =~ s/\s+/ /g;
266
266
      $para =~ s/$POD_link_re/$1/go;
267
 
      MKDEBUG && _d('Option rule:', $para);
 
267
      PTDEBUG && _d('Option rule:', $para);
268
268
      push @rules, $para;
269
269
   }
270
270
 
273
273
   do {
274
274
      if ( my ($option) = $para =~ m/^=item $self->{item}/ ) {
275
275
         chomp $para;
276
 
         MKDEBUG && _d($para);
 
276
         PTDEBUG && _d($para);
277
277
         my %attribs;
278
278
 
279
279
         $para = <$fh>; # read next paragraph, possibly attributes
292
292
            $para = <$fh>; # read next paragraph, probably short help desc
293
293
         }
294
294
         else {
295
 
            MKDEBUG && _d('Option has no attributes');
 
295
            PTDEBUG && _d('Option has no attributes');
296
296
         }
297
297
 
298
298
         $para =~ s/\s+\Z//g;
300
300
         $para =~ s/$POD_link_re/$1/go;
301
301
 
302
302
         $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s;
303
 
         MKDEBUG && _d('Short help:', $para);
 
303
         PTDEBUG && _d('Short help:', $para);
304
304
 
305
305
         die "No description after option spec $option" if $para =~ m/^=item/;
306
306
 
338
338
 
339
339
   foreach my $opt ( @specs ) {
340
340
      if ( ref $opt ) { # It's an option spec, not a rule.
341
 
         MKDEBUG && _d('Parsing opt spec:',
 
341
         PTDEBUG && _d('Parsing opt spec:',
342
342
            map { ($_, '=>', $opt->{$_}) } keys %$opt);
343
343
 
344
344
         my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/;
351
351
         $self->{opts}->{$long} = $opt;
352
352
 
353
353
         if ( length $long == 1 ) {
354
 
            MKDEBUG && _d('Long opt', $long, 'looks like short opt');
 
354
            PTDEBUG && _d('Long opt', $long, 'looks like short opt');
355
355
            $self->{short_opts}->{$long} = $long;
356
356
         }
357
357
 
377
377
 
378
378
         my ( $type ) = $opt->{spec} =~ m/=(.)/;
379
379
         $opt->{type} = $type;
380
 
         MKDEBUG && _d($long, 'type:', $type);
 
380
         PTDEBUG && _d($long, 'type:', $type);
381
381
 
382
382
 
383
383
         $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ );
384
384
 
385
385
         if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) {
386
386
            $self->{defaults}->{$long} = defined $def ? $def : 1;
387
 
            MKDEBUG && _d($long, 'default:', $def);
 
387
            PTDEBUG && _d($long, 'default:', $def);
388
388
         }
389
389
 
390
390
         if ( $long eq 'config' ) {
393
393
 
394
394
         if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) {
395
395
            $disables{$long} = $dis;
396
 
            MKDEBUG && _d('Deferring check of disables rule for', $opt, $dis);
 
396
            PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis);
397
397
         }
398
398
 
399
399
         $self->{opts}->{$long} = $opt;
400
400
      }
401
401
      else { # It's an option rule, not a spec.
402
 
         MKDEBUG && _d('Parsing rule:', $opt); 
 
402
         PTDEBUG && _d('Parsing rule:', $opt); 
403
403
         push @{$self->{rules}}, $opt;
404
404
         my @participants = $self->_get_participants($opt);
405
405
         my $rule_ok = 0;
407
407
         if ( $opt =~ m/mutually exclusive|one and only one/ ) {
408
408
            $rule_ok = 1;
409
409
            push @{$self->{mutex}}, \@participants;
410
 
            MKDEBUG && _d(@participants, 'are mutually exclusive');
 
410
            PTDEBUG && _d(@participants, 'are mutually exclusive');
411
411
         }
412
412
         if ( $opt =~ m/at least one|one and only one/ ) {
413
413
            $rule_ok = 1;
414
414
            push @{$self->{atleast1}}, \@participants;
415
 
            MKDEBUG && _d(@participants, 'require at least one');
 
415
            PTDEBUG && _d(@participants, 'require at least one');
416
416
         }
417
417
         if ( $opt =~ m/default to/ ) {
418
418
            $rule_ok = 1;
419
419
            $self->{defaults_to}->{$participants[0]} = $participants[1];
420
 
            MKDEBUG && _d($participants[0], 'defaults to', $participants[1]);
 
420
            PTDEBUG && _d($participants[0], 'defaults to', $participants[1]);
421
421
         }
422
422
         if ( $opt =~ m/restricted to option groups/ ) {
423
423
            $rule_ok = 1;
431
431
         if( $opt =~ m/accepts additional command-line arguments/ ) {
432
432
            $rule_ok = 1;
433
433
            $self->{strict} = 0;
434
 
            MKDEBUG && _d("Strict mode disabled by rule");
 
434
            PTDEBUG && _d("Strict mode disabled by rule");
435
435
         }
436
436
 
437
437
         die "Unrecognized option rule: $opt" unless $rule_ok;
441
441
   foreach my $long ( keys %disables ) {
442
442
      my @participants = $self->_get_participants($disables{$long});
443
443
      $self->{disables}->{$long} = \@participants;
444
 
      MKDEBUG && _d('Option', $long, 'disables', @participants);
 
444
      PTDEBUG && _d('Option', $long, 'disables', @participants);
445
445
   }
446
446
 
447
447
   return; 
455
455
         unless exists $self->{opts}->{$long};
456
456
      push @participants, $long;
457
457
   }
458
 
   MKDEBUG && _d('Participants for', $str, ':', @participants);
 
458
   PTDEBUG && _d('Participants for', $str, ':', @participants);
459
459
   return @participants;
460
460
}
461
461
 
478
478
      die "Cannot set default for nonexistent option $long"
479
479
         unless exists $self->{opts}->{$long};
480
480
      $self->{defaults}->{$long} = $defaults{$long};
481
 
      MKDEBUG && _d('Default val for', $long, ':', $defaults{$long});
 
481
      PTDEBUG && _d('Default val for', $long, ':', $defaults{$long});
482
482
   }
483
483
   return;
484
484
}
507
507
      $opt->{value} = $val;
508
508
   }
509
509
   $opt->{got} = 1;
510
 
   MKDEBUG && _d('Got option', $long, '=', $val);
 
510
   PTDEBUG && _d('Got option', $long, '=', $val);
511
511
}
512
512
 
513
513
sub get_opts {
538
538
            if ( $self->got('config') ) {
539
539
               die $EVAL_ERROR;
540
540
            }
541
 
            elsif ( MKDEBUG ) {
 
541
            elsif ( PTDEBUG ) {
542
542
               _d($EVAL_ERROR);
543
543
            }
544
544
         }
605
605
            if ( exists $self->{disables}->{$long} ) {
606
606
               my @disable_opts = @{$self->{disables}->{$long}};
607
607
               map { $self->{opts}->{$_}->{value} = undef; } @disable_opts;
608
 
               MKDEBUG && _d('Unset options', @disable_opts,
 
608
               PTDEBUG && _d('Unset options', @disable_opts,
609
609
                  'because', $long,'disables them');
610
610
            }
611
611
 
654
654
            delete $long[$i];
655
655
         }
656
656
         else {
657
 
            MKDEBUG && _d('Temporarily failed to parse', $long);
 
657
            PTDEBUG && _d('Temporarily failed to parse', $long);
658
658
         }
659
659
      }
660
660
 
678
678
   my $val = $opt->{value};
679
679
 
680
680
   if ( $val && $opt->{type} eq 'm' ) {  # type time
681
 
      MKDEBUG && _d('Parsing option', $opt->{long}, 'as a time value');
 
681
      PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value');
682
682
      my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/;
683
683
      if ( !$suffix ) {
684
684
         my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/;
685
685
         $suffix = $s || 's';
686
 
         MKDEBUG && _d('No suffix given; using', $suffix, 'for',
 
686
         PTDEBUG && _d('No suffix given; using', $suffix, 'for',
687
687
            $opt->{long}, '(value:', $val, ')');
688
688
      }
689
689
      if ( $suffix =~ m/[smhd]/ ) {
692
692
              : $suffix eq 'h' ? $num * 3600     # Hours
693
693
              :                  $num * 86400;   # Days
694
694
         $opt->{value} = ($prefix || '') . $val;
695
 
         MKDEBUG && _d('Setting option', $opt->{long}, 'to', $val);
 
695
         PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val);
696
696
      }
697
697
      else {
698
698
         $self->save_error("Invalid time suffix for --$opt->{long}");
699
699
      }
700
700
   }
701
701
   elsif ( $val && $opt->{type} eq 'd' ) {  # type DSN
702
 
      MKDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN');
 
702
      PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN');
703
703
      my $prev = {};
704
704
      my $from_key = $self->{defaults_to}->{ $opt->{long} };
705
705
      if ( $from_key ) {
706
 
         MKDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN');
 
706
         PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN');
707
707
         if ( $self->{opts}->{$from_key}->{parsed} ) {
708
708
            $prev = $self->{opts}->{$from_key}->{value};
709
709
         }
710
710
         else {
711
 
            MKDEBUG && _d('Cannot parse', $opt->{long}, 'until',
 
711
            PTDEBUG && _d('Cannot parse', $opt->{long}, 'until',
712
712
               $from_key, 'parsed');
713
713
            return;
714
714
         }
717
717
      $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults);
718
718
   }
719
719
   elsif ( $val && $opt->{type} eq 'z' ) {  # type size
720
 
      MKDEBUG && _d('Parsing option', $opt->{long}, 'as a size value');
 
720
      PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value');
721
721
      $self->_parse_size($opt, $val);
722
722
   }
723
723
   elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) {
727
727
      $opt->{value} = [ split(/(?<!\\),\s*/, ($val || '')) ];
728
728
   }
729
729
   else {
730
 
      MKDEBUG && _d('Nothing to validate for option',
 
730
      PTDEBUG && _d('Nothing to validate for option',
731
731
         $opt->{long}, 'type', $opt->{type}, 'value', $val);
732
732
   }
733
733
 
801
801
   $file ||= $self->{file} || __FILE__;
802
802
 
803
803
   if ( !$self->{description} || !$self->{usage} ) {
804
 
      MKDEBUG && _d("Getting description and usage from SYNOPSIS in", $file);
 
804
      PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file);
805
805
      my %synop = $self->_parse_synopsis($file);
806
806
      $self->{description} ||= $synop{description};
807
807
      $self->{usage}       ||= $synop{usage};
808
 
      MKDEBUG && _d("Description:", $self->{description},
 
808
      PTDEBUG && _d("Description:", $self->{description},
809
809
         "\nUsage:", $self->{usage});
810
810
   }
811
811
 
1020
1020
   my ( $self, $opt, $val ) = @_;
1021
1021
 
1022
1022
   if ( lc($val || '') eq 'null' ) {
1023
 
      MKDEBUG && _d('NULL size for', $opt->{long});
 
1023
      PTDEBUG && _d('NULL size for', $opt->{long});
1024
1024
      $opt->{value} = 'null';
1025
1025
      return;
1026
1026
   }
1030
1030
   if ( defined $num ) {
1031
1031
      if ( $factor ) {
1032
1032
         $num *= $factor_for{$factor};
1033
 
         MKDEBUG && _d('Setting option', $opt->{y},
 
1033
         PTDEBUG && _d('Setting option', $opt->{y},
1034
1034
            'to num', $num, '* factor', $factor);
1035
1035
      }
1036
1036
      $opt->{value} = ($pre || '') . $num;
1054
1054
sub _parse_synopsis {
1055
1055
   my ( $self, $file ) = @_;
1056
1056
   $file ||= $self->{file} || __FILE__;
1057
 
   MKDEBUG && _d("Parsing SYNOPSIS in", $file);
 
1057
   PTDEBUG && _d("Parsing SYNOPSIS in", $file);
1058
1058
 
1059
1059
   local $INPUT_RECORD_SEPARATOR = '';  # read paragraphs
1060
1060
   open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
1067
1067
      push @synop, $para;
1068
1068
   }
1069
1069
   close $fh;
1070
 
   MKDEBUG && _d("Raw SYNOPSIS text:", @synop);
 
1070
   PTDEBUG && _d("Raw SYNOPSIS text:", @synop);
1071
1071
   my ($usage, $desc) = @synop;
1072
1072
   die "The SYNOPSIS section in $file is not formatted properly"
1073
1073
      unless $usage && $desc;
1094
1094
   print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
1095
1095
}
1096
1096
 
1097
 
if ( MKDEBUG ) {
 
1097
if ( PTDEBUG ) {
1098
1098
   print '# ', $^X, ' ', $], "\n";
1099
1099
   if ( my $uname = `uname -a` ) {
1100
1100
      $uname =~ s/\s+/ /g;
1124
1124
use strict;
1125
1125
use warnings FATAL => 'all';
1126
1126
use English qw(-no_match_vars);
1127
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
1127
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
1128
1128
 
1129
1129
sub new {
1130
1130
   my ( $class ) = @_;
1134
1134
sub parse {
1135
1135
   my ( $self, $str ) = @_;
1136
1136
   my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g);
1137
 
   MKDEBUG && _d($str, 'parses to', $result);
 
1137
   PTDEBUG && _d($str, 'parses to', $result);
1138
1138
   return $result;
1139
1139
}
1140
1140
 
1145
1145
         $dbh->selectrow_array('SELECT VERSION()'));
1146
1146
   }
1147
1147
   my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0;
1148
 
   MKDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result);
 
1148
   PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result);
1149
1149
   return $result;
1150
1150
}
1151
1151
 
1163
1163
      }
1164
1164
      @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) };
1165
1165
   if ( $innodb ) {
1166
 
      MKDEBUG && _d("InnoDB support:", $innodb->{support});
 
1166
      PTDEBUG && _d("InnoDB support:", $innodb->{support});
1167
1167
      if ( $innodb->{support} =~ m/YES|DEFAULT/i ) {
1168
1168
         my $vars = $dbh->selectrow_hashref(
1169
1169
            "SHOW VARIABLES LIKE 'innodb_version'");
1175
1175
      }
1176
1176
   }
1177
1177
 
1178
 
   MKDEBUG && _d("InnoDB version:", $innodb_version);
 
1178
   PTDEBUG && _d("InnoDB version:", $innodb_version);
1179
1179
   return $innodb_version;
1180
1180
}
1181
1181
 
1207
1207
use strict;
1208
1208
use warnings FATAL => 'all';
1209
1209
use English qw(-no_match_vars);
1210
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
1210
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
1211
1211
 
1212
1212
use Data::Dumper;
1213
1213
$Data::Dumper::Indent    = 0;
1230
1230
      if ( !$opt->{key} || !$opt->{desc} ) {
1231
1231
         die "Invalid DSN option: ", Dumper($opt);
1232
1232
      }
1233
 
      MKDEBUG && _d('DSN option:',
 
1233
      PTDEBUG && _d('DSN option:',
1234
1234
         join(', ',
1235
1235
            map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') }
1236
1236
               keys %$opt
1248
1248
sub prop {
1249
1249
   my ( $self, $prop, $value ) = @_;
1250
1250
   if ( @_ > 2 ) {
1251
 
      MKDEBUG && _d('Setting', $prop, 'property');
 
1251
      PTDEBUG && _d('Setting', $prop, 'property');
1252
1252
      $self->{$prop} = $value;
1253
1253
   }
1254
1254
   return $self->{$prop};
1257
1257
sub parse {
1258
1258
   my ( $self, $dsn, $prev, $defaults ) = @_;
1259
1259
   if ( !$dsn ) {
1260
 
      MKDEBUG && _d('No DSN to parse');
 
1260
      PTDEBUG && _d('No DSN to parse');
1261
1261
      return;
1262
1262
   }
1263
 
   MKDEBUG && _d('Parsing', $dsn);
 
1263
   PTDEBUG && _d('Parsing', $dsn);
1264
1264
   $prev     ||= {};
1265
1265
   $defaults ||= {};
1266
1266
   my %given_props;
1272
1272
         $given_props{$prop_key} = $prop_val;
1273
1273
      }
1274
1274
      else {
1275
 
         MKDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part);
 
1275
         PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part);
1276
1276
         $given_props{h} = $dsn_part;
1277
1277
      }
1278
1278
   }
1279
1279
 
1280
1280
   foreach my $key ( keys %$opts ) {
1281
 
      MKDEBUG && _d('Finding value for', $key);
 
1281
      PTDEBUG && _d('Finding value for', $key);
1282
1282
      $final_props{$key} = $given_props{$key};
1283
1283
      if (   !defined $final_props{$key}
1284
1284
           && defined $prev->{$key} && $opts->{$key}->{copy} )
1285
1285
      {
1286
1286
         $final_props{$key} = $prev->{$key};
1287
 
         MKDEBUG && _d('Copying value for', $key, 'from previous DSN');
 
1287
         PTDEBUG && _d('Copying value for', $key, 'from previous DSN');
1288
1288
      }
1289
1289
      if ( !defined $final_props{$key} ) {
1290
1290
         $final_props{$key} = $defaults->{$key};
1291
 
         MKDEBUG && _d('Copying value for', $key, 'from defaults');
 
1291
         PTDEBUG && _d('Copying value for', $key, 'from defaults');
1292
1292
      }
1293
1293
   }
1294
1294
 
1319
1319
          grep { $o->has($_) && $o->get($_) }
1320
1320
          keys %{$self->{opts}}
1321
1321
        );
1322
 
   MKDEBUG && _d('DSN string made from options:', $dsn_string);
 
1322
   PTDEBUG && _d('DSN string made from options:', $dsn_string);
1323
1323
   return $self->parse($dsn_string);
1324
1324
}
1325
1325
 
1369
1369
                     qw(F h P S A))
1370
1370
         . ';mysql_read_default_group=client';
1371
1371
   }
1372
 
   MKDEBUG && _d($dsn);
 
1372
   PTDEBUG && _d($dsn);
1373
1373
   return ($dsn, $info->{u}, $info->{p});
1374
1374
}
1375
1375
 
1414
1414
   my $dbh;
1415
1415
   my $tries = 2;
1416
1416
   while ( !$dbh && $tries-- ) {
1417
 
      MKDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, 
 
1417
      PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, 
1418
1418
         join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
1419
1419
 
1420
1420
      eval {
1424
1424
            my $sql;
1425
1425
 
1426
1426
            $sql = 'SELECT @@SQL_MODE';
1427
 
            MKDEBUG && _d($dbh, $sql);
 
1427
            PTDEBUG && _d($dbh, $sql);
1428
1428
            my ($sql_mode) = $dbh->selectrow_array($sql);
1429
1429
 
1430
1430
            $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
1431
1431
                 . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
1432
1432
                 . ($sql_mode ? ",$sql_mode" : '')
1433
1433
                 . '\'*/';
1434
 
            MKDEBUG && _d($dbh, $sql);
 
1434
            PTDEBUG && _d($dbh, $sql);
1435
1435
            $dbh->do($sql);
1436
1436
 
1437
1437
            if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
1438
1438
               $sql = "/*!40101 SET NAMES $charset*/";
1439
 
               MKDEBUG && _d($dbh, ':', $sql);
 
1439
               PTDEBUG && _d($dbh, ':', $sql);
1440
1440
               $dbh->do($sql);
1441
 
               MKDEBUG && _d('Enabling charset for STDOUT');
 
1441
               PTDEBUG && _d('Enabling charset for STDOUT');
1442
1442
               if ( $charset eq 'utf8' ) {
1443
1443
                  binmode(STDOUT, ':utf8')
1444
1444
                     or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
1450
1450
 
1451
1451
            if ( $self->prop('set-vars') ) {
1452
1452
               $sql = "SET " . $self->prop('set-vars');
1453
 
               MKDEBUG && _d($dbh, ':', $sql);
 
1453
               PTDEBUG && _d($dbh, ':', $sql);
1454
1454
               $dbh->do($sql);
1455
1455
            }
1456
1456
         }
1457
1457
      };
1458
1458
      if ( !$dbh && $EVAL_ERROR ) {
1459
 
         MKDEBUG && _d($EVAL_ERROR);
 
1459
         PTDEBUG && _d($EVAL_ERROR);
1460
1460
         if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
1461
 
            MKDEBUG && _d('Going to try again without utf8 support');
 
1461
            PTDEBUG && _d('Going to try again without utf8 support');
1462
1462
            delete $defaults->{mysql_enable_utf8};
1463
1463
         }
1464
1464
         elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
1476
1476
      }
1477
1477
   }
1478
1478
 
1479
 
   MKDEBUG && _d('DBH info: ',
 
1479
   PTDEBUG && _d('DBH info: ',
1480
1480
      $dbh,
1481
1481
      Dumper($dbh->selectrow_hashref(
1482
1482
         'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')),
1502
1502
 
1503
1503
sub disconnect {
1504
1504
   my ( $self, $dbh ) = @_;
1505
 
   MKDEBUG && $self->print_active_handles($dbh);
 
1505
   PTDEBUG && $self->print_active_handles($dbh);
1506
1506
   $dbh->disconnect;
1507
1507
}
1508
1508
 
1563
1563
use strict;
1564
1564
use warnings FATAL => 'all';
1565
1565
use English qw(-no_match_vars);
1566
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
1566
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
1567
1567
 
1568
1568
sub new {
1569
1569
   my ( $class, %args ) = @_;
1574
1574
   return bless $self, $class;
1575
1575
}
1576
1576
 
 
1577
sub get_slaves {
 
1578
   my ($self, %args) = @_;
 
1579
   my @required_args = qw(make_cxn OptionParser DSNParser Quoter);
 
1580
   foreach my $arg ( @required_args ) {
 
1581
      die "I need a $arg argument" unless $args{$arg};
 
1582
   }
 
1583
   my ($make_cxn, $o, $dp) = @args{@required_args};
 
1584
 
 
1585
   my $slaves = [];
 
1586
   my $method = $o->get('recursion-method');
 
1587
   PTDEBUG && _d('Slave recursion method:', $method);
 
1588
   if ( !$method || $method =~ m/processlist|hosts/i ) {
 
1589
      my @required_args = qw(dbh dsn);
 
1590
      foreach my $arg ( @required_args ) {
 
1591
         die "I need a $arg argument" unless $args{$arg};
 
1592
      }
 
1593
      my ($dbh, $dsn) = @args{@required_args};
 
1594
      $self->recurse_to_slaves(
 
1595
         {  dbh        => $dbh,
 
1596
            dsn        => $dsn,
 
1597
            dsn_parser => $dp,
 
1598
            recurse    => $o->get('recurse'),
 
1599
            method     => $o->get('recursion-method'),
 
1600
            callback   => sub {
 
1601
               my ( $dsn, $dbh, $level, $parent ) = @_;
 
1602
               return unless $level;
 
1603
               PTDEBUG && _d('Found slave:', $dp->as_string($dsn));
 
1604
               push @$slaves, $make_cxn->(dsn => $dsn, dbh => $dbh);
 
1605
               return;
 
1606
            },
 
1607
         }
 
1608
      );
 
1609
   }
 
1610
   elsif ( $method =~ m/^dsn=/i ) {
 
1611
      my ($dsn_table_dsn) = $method =~ m/^dsn=(.+)/i;
 
1612
      $slaves = $self->get_cxn_from_dsn_table(
 
1613
         %args,
 
1614
         dsn_table_dsn => $dsn_table_dsn,
 
1615
      );
 
1616
   }
 
1617
   else {
 
1618
      die "Invalid --recursion-method: $method.  Valid values are: "
 
1619
        . "dsn=DSN, hosts, or processlist.\n";
 
1620
   }
 
1621
 
 
1622
   return $slaves;
 
1623
}
 
1624
 
1577
1625
sub recurse_to_slaves {
1578
1626
   my ( $self, $args, $level ) = @_;
1579
1627
   $level ||= 0;
1584
1632
   eval {
1585
1633
      $dbh = $args->{dbh} || $dp->get_dbh(
1586
1634
         $dp->get_cxn_params($dsn), { AutoCommit => 1 });
1587
 
      MKDEBUG && _d('Connected to', $dp->as_string($dsn));
 
1635
      PTDEBUG && _d('Connected to', $dp->as_string($dsn));
1588
1636
   };
1589
1637
   if ( $EVAL_ERROR ) {
1590
1638
      print STDERR "Cannot connect to ", $dp->as_string($dsn), "\n"
1593
1641
   }
1594
1642
 
1595
1643
   my $sql  = 'SELECT @@SERVER_ID';
1596
 
   MKDEBUG && _d($sql);
 
1644
   PTDEBUG && _d($sql);
1597
1645
   my ($id) = $dbh->selectrow_array($sql);
1598
 
   MKDEBUG && _d('Working on server ID', $id);
 
1646
   PTDEBUG && _d('Working on server ID', $id);
1599
1647
   my $master_thinks_i_am = $dsn->{server_id};
1600
1648
   if ( !defined $id
1601
1649
       || ( defined $master_thinks_i_am && $master_thinks_i_am != $id )
1602
1650
       || $args->{server_ids_seen}->{$id}++
1603
1651
   ) {
1604
 
      MKDEBUG && _d('Server ID seen, or not what master said');
 
1652
      PTDEBUG && _d('Server ID seen, or not what master said');
1605
1653
      if ( $args->{skip_callback} ) {
1606
1654
         $args->{skip_callback}->($dsn, $dbh, $level, $args->{parent});
1607
1655
      }
1617
1665
         $self->find_slave_hosts($dp, $dbh, $dsn, $args->{method});
1618
1666
 
1619
1667
      foreach my $slave ( @slaves ) {
1620
 
         MKDEBUG && _d('Recursing from',
 
1668
         PTDEBUG && _d('Recursing from',
1621
1669
            $dp->as_string($dsn), 'to', $dp->as_string($slave));
1622
1670
         $self->recurse_to_slaves(
1623
1671
            { %$args, dsn => $slave, dbh => undef, parent => $dsn }, $level + 1 );
1635
1683
   }
1636
1684
   else {
1637
1685
      if ( ($dsn->{P} || 3306) != 3306 ) {
1638
 
         MKDEBUG && _d('Port number is non-standard; using only hosts method');
 
1686
         PTDEBUG && _d('Port number is non-standard; using only hosts method');
1639
1687
         @methods = qw(hosts);
1640
1688
      }
1641
1689
   }
1642
 
   MKDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn),
 
1690
   PTDEBUG && _d('Looking for slaves on', $dsn_parser->as_string($dsn),
1643
1691
      'using methods', @methods);
1644
1692
 
1645
1693
   my @slaves;
1646
1694
   METHOD:
1647
1695
   foreach my $method ( @methods ) {
1648
1696
      my $find_slaves = "_find_slaves_by_$method";
1649
 
      MKDEBUG && _d('Finding slaves with', $find_slaves);
 
1697
      PTDEBUG && _d('Finding slaves with', $find_slaves);
1650
1698
      @slaves = $self->$find_slaves($dsn_parser, $dbh, $dsn);
1651
1699
      last METHOD if @slaves;
1652
1700
   }
1653
1701
 
1654
 
   MKDEBUG && _d('Found', scalar(@slaves), 'slaves');
 
1702
   PTDEBUG && _d('Found', scalar(@slaves), 'slaves');
1655
1703
   return @slaves;
1656
1704
}
1657
1705
 
1680
1728
 
1681
1729
   my @slaves;
1682
1730
   my $sql = 'SHOW SLAVE HOSTS';
1683
 
   MKDEBUG && _d($dbh, $sql);
 
1731
   PTDEBUG && _d($dbh, $sql);
1684
1732
   @slaves = @{$dbh->selectall_arrayref($sql, { Slice => {} })};
1685
1733
 
1686
1734
   if ( @slaves ) {
1687
 
      MKDEBUG && _d('Found some SHOW SLAVE HOSTS info');
 
1735
      PTDEBUG && _d('Found some SHOW SLAVE HOSTS info');
1688
1736
      @slaves = map {
1689
1737
         my %hash;
1690
1738
         @hash{ map { lc $_ } keys %$_ } = values %$_;
1713
1761
      $user =~ s/([^@]+)@(.+)/'$1'\@'$2'/;
1714
1762
   }
1715
1763
   my $sql = $show . $user;
1716
 
   MKDEBUG && _d($dbh, $sql);
 
1764
   PTDEBUG && _d($dbh, $sql);
1717
1765
 
1718
1766
   my $proc;
1719
1767
   eval {
1724
1772
   if ( $EVAL_ERROR ) {
1725
1773
 
1726
1774
      if ( $EVAL_ERROR =~ m/no such grant defined for user/ ) {
1727
 
         MKDEBUG && _d('Retrying SHOW GRANTS without host; error:',
 
1775
         PTDEBUG && _d('Retrying SHOW GRANTS without host; error:',
1728
1776
            $EVAL_ERROR);
1729
1777
         ($user) = split('@', $user);
1730
1778
         $sql    = $show . $user;
1731
 
         MKDEBUG && _d($sql);
 
1779
         PTDEBUG && _d($sql);
1732
1780
         eval {
1733
1781
            $proc = grep {
1734
1782
               m/ALL PRIVILEGES.*?\*\.\*|PROCESS/
1743
1791
   }
1744
1792
 
1745
1793
   $sql = 'SHOW PROCESSLIST';
1746
 
   MKDEBUG && _d($dbh, $sql);
 
1794
   PTDEBUG && _d($dbh, $sql);
1747
1795
   grep { $_->{command} =~ m/Binlog Dump/i }
1748
1796
   map  { # Lowercase the column names
1749
1797
      my %hash;
1803
1851
   if ( !$self->{not_a_slave}->{$dbh} ) {
1804
1852
      my $sth = $self->{sths}->{$dbh}->{SLAVE_STATUS}
1805
1853
            ||= $dbh->prepare('SHOW SLAVE STATUS');
1806
 
      MKDEBUG && _d($dbh, 'SHOW SLAVE STATUS');
 
1854
      PTDEBUG && _d($dbh, 'SHOW SLAVE STATUS');
1807
1855
      $sth->execute();
1808
1856
      my ($ss) = @{$sth->fetchall_arrayref({})};
1809
1857
 
1812
1860
         return $ss;
1813
1861
      }
1814
1862
 
1815
 
      MKDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS');
 
1863
      PTDEBUG && _d('This server returns nothing for SHOW SLAVE STATUS');
1816
1864
      $self->{not_a_slave}->{$dbh}++;
1817
1865
   }
1818
1866
}
1821
1869
   my ( $self, $dbh ) = @_;
1822
1870
 
1823
1871
   if ( $self->{not_a_master}->{$dbh} ) {
1824
 
      MKDEBUG && _d('Server on dbh', $dbh, 'is not a master');
 
1872
      PTDEBUG && _d('Server on dbh', $dbh, 'is not a master');
1825
1873
      return;
1826
1874
   }
1827
1875
 
1828
1876
   my $sth = $self->{sths}->{$dbh}->{MASTER_STATUS}
1829
1877
         ||= $dbh->prepare('SHOW MASTER STATUS');
1830
 
   MKDEBUG && _d($dbh, 'SHOW MASTER STATUS');
 
1878
   PTDEBUG && _d($dbh, 'SHOW MASTER STATUS');
1831
1879
   $sth->execute();
1832
1880
   my ($ms) = @{$sth->fetchall_arrayref({})};
1833
 
   MKDEBUG && _d(
 
1881
   PTDEBUG && _d(
1834
1882
      $ms ? map { "$_=" . (defined $ms->{$_} ? $ms->{$_} : '') } keys %$ms
1835
1883
          : '');
1836
1884
 
1837
1885
   if ( !$ms || scalar keys %$ms < 2 ) {
1838
 
      MKDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master');
 
1886
      PTDEBUG && _d('Server on dbh', $dbh, 'does not seem to be a master');
1839
1887
      $self->{not_a_master}->{$dbh}++;
1840
1888
   }
1841
1889
 
1856
1904
   if ( $master_status ) {
1857
1905
      my $sql = "SELECT MASTER_POS_WAIT('$master_status->{file}', "
1858
1906
              . "$master_status->{position}, $timeout)";
1859
 
      MKDEBUG && _d($slave_dbh, $sql);
 
1907
      PTDEBUG && _d($slave_dbh, $sql);
1860
1908
      my $start = time;
1861
1909
      ($result) = $slave_dbh->selectrow_array($sql);
1862
1910
 
1863
1911
      $waited = time - $start;
1864
1912
 
1865
 
      MKDEBUG && _d('Result of waiting:', $result);
1866
 
      MKDEBUG && _d("Waited", $waited, "seconds");
 
1913
      PTDEBUG && _d('Result of waiting:', $result);
 
1914
      PTDEBUG && _d("Waited", $waited, "seconds");
1867
1915
   }
1868
1916
   else {
1869
 
      MKDEBUG && _d('Not waiting: this server is not a master');
 
1917
      PTDEBUG && _d('Not waiting: this server is not a master');
1870
1918
   }
1871
1919
 
1872
1920
   return {
1879
1927
   my ( $self, $dbh ) = @_;
1880
1928
   my $sth = $self->{sths}->{$dbh}->{STOP_SLAVE}
1881
1929
         ||= $dbh->prepare('STOP SLAVE');
1882
 
   MKDEBUG && _d($dbh, $sth->{Statement});
 
1930
   PTDEBUG && _d($dbh, $sth->{Statement});
1883
1931
   $sth->execute();
1884
1932
}
1885
1933
 
1888
1936
   if ( $pos ) {
1889
1937
      my $sql = "START SLAVE UNTIL MASTER_LOG_FILE='$pos->{file}', "
1890
1938
              . "MASTER_LOG_POS=$pos->{position}";
1891
 
      MKDEBUG && _d($dbh, $sql);
 
1939
      PTDEBUG && _d($dbh, $sql);
1892
1940
      $dbh->do($sql);
1893
1941
   }
1894
1942
   else {
1895
1943
      my $sth = $self->{sths}->{$dbh}->{START_SLAVE}
1896
1944
            ||= $dbh->prepare('START SLAVE');
1897
 
      MKDEBUG && _d($dbh, $sth->{Statement});
 
1945
      PTDEBUG && _d($dbh, $sth->{Statement});
1898
1946
      $sth->execute();
1899
1947
   }
1900
1948
}
1907
1955
   my $slave_pos     = $self->repl_posn($slave_status);
1908
1956
   my $master_status = $self->get_master_status($master);
1909
1957
   my $master_pos    = $self->repl_posn($master_status);
1910
 
   MKDEBUG && _d('Master position:', $self->pos_to_string($master_pos),
 
1958
   PTDEBUG && _d('Master position:', $self->pos_to_string($master_pos),
1911
1959
      'Slave position:', $self->pos_to_string($slave_pos));
1912
1960
 
1913
1961
   my $result;
1914
1962
   if ( $self->pos_cmp($slave_pos, $master_pos) < 0 ) {
1915
 
      MKDEBUG && _d('Waiting for slave to catch up to master');
 
1963
      PTDEBUG && _d('Waiting for slave to catch up to master');
1916
1964
      $self->start_slave($slave, $master_pos);
1917
1965
 
1918
1966
      $result = $self->wait_for_master(
1924
1972
      if ( !defined $result->{result} ) {
1925
1973
         $slave_status = $self->get_slave_status($slave);
1926
1974
         if ( !$self->slave_is_running($slave_status) ) {
1927
 
            MKDEBUG && _d('Master position:',
 
1975
            PTDEBUG && _d('Master position:',
1928
1976
               $self->pos_to_string($master_pos),
1929
1977
               'Slave position:', $self->pos_to_string($slave_pos));
1930
1978
            $slave_pos = $self->repl_posn($slave_status);
1932
1980
               die "MASTER_POS_WAIT() returned NULL but slave has not "
1933
1981
                  . "caught up to master";
1934
1982
            }
1935
 
            MKDEBUG && _d('Slave is caught up to master and stopped');
 
1983
            PTDEBUG && _d('Slave is caught up to master and stopped');
1936
1984
         }
1937
1985
         else {
1938
1986
            die "Slave has not caught up to master and it is still running";
1940
1988
      }
1941
1989
   }
1942
1990
   else {
1943
 
      MKDEBUG && _d("Slave is already caught up to master");
 
1991
      PTDEBUG && _d("Slave is already caught up to master");
1944
1992
   }
1945
1993
 
1946
1994
   return $result;
1983
2031
sub has_slave_updates {
1984
2032
   my ( $self, $dbh ) = @_;
1985
2033
   my $sql = q{SHOW VARIABLES LIKE 'log_slave_updates'};
1986
 
   MKDEBUG && _d($dbh, $sql);
 
2034
   PTDEBUG && _d($dbh, $sql);
1987
2035
   my ($name, $value) = $dbh->selectrow_array($sql);
1988
2036
   return $value && $value =~ m/^(1|ON)$/;
1989
2037
}
2045
2093
   }
2046
2094
   if ( !$match ) {
2047
2095
      if ( ($query->{User} || $query->{user} || '') eq "system user" ) {
2048
 
         MKDEBUG && _d("Slave replication thread");
 
2096
         PTDEBUG && _d("Slave replication thread");
2049
2097
         if ( $type ne 'all' ) { 
2050
2098
            my $state = $query->{State} || $query->{state} || '';
2051
2099
 
2052
2100
            if ( $state =~ m/^init|end$/ ) {
2053
 
               MKDEBUG && _d("Special state:", $state);
 
2101
               PTDEBUG && _d("Special state:", $state);
2054
2102
               $match = 1;
2055
2103
            }
2056
2104
            else {
2071
2119
         }
2072
2120
      }
2073
2121
      else {
2074
 
         MKDEBUG && _d('Not system user');
 
2122
         PTDEBUG && _d('Not system user');
2075
2123
      }
2076
2124
 
2077
2125
      if ( !defined $args{check_known_ids} || $args{check_known_ids} ) {
2081
2129
         }
2082
2130
         else {
2083
2131
            if ( $self->{replication_thread}->{$id} ) {
2084
 
               MKDEBUG && _d("Thread ID is a known replication thread ID");
 
2132
               PTDEBUG && _d("Thread ID is a known replication thread ID");
2085
2133
               $match = 1;
2086
2134
            }
2087
2135
         }
2088
2136
      }
2089
2137
   }
2090
2138
 
2091
 
   MKDEBUG && _d('Matches', $type, 'replication thread:',
 
2139
   PTDEBUG && _d('Matches', $type, 'replication thread:',
2092
2140
      ($match ? 'yes' : 'no'), '; match:', $match);
2093
2141
 
2094
2142
   return $match;
2129
2177
      );
2130
2178
 
2131
2179
      my $sql = "SHOW VARIABLES LIKE 'slave_skip_errors'";
2132
 
      MKDEBUG && _d($dbh, $sql);
 
2180
      PTDEBUG && _d($dbh, $sql);
2133
2181
      my $row = $dbh->selectrow_arrayref($sql);
2134
2182
      $filters{slave_skip_errors} = $row->[1] if $row->[1] && $row->[1] ne 'OFF';
2135
2183
   }
2150
2198
   return;
2151
2199
}
2152
2200
 
 
2201
sub get_cxn_from_dsn_table {
 
2202
   my ($self, %args) = @_;
 
2203
   my @required_args = qw(dsn_table_dsn make_cxn DSNParser Quoter);
 
2204
   foreach my $arg ( @required_args ) {
 
2205
      die "I need a $arg argument" unless $args{$arg};
 
2206
   }
 
2207
   my ($dsn_table_dsn, $make_cxn, $dp, $q) = @args{@required_args};
 
2208
   PTDEBUG && _d('DSN table DSN:', $dsn_table_dsn);
 
2209
 
 
2210
   my $dsn = $dp->parse($dsn_table_dsn);
 
2211
   my $dsn_table;
 
2212
   if ( $dsn->{D} && $dsn->{t} ) {
 
2213
      $dsn_table = $q->quote($dsn->{D}, $dsn->{t});
 
2214
   }
 
2215
   elsif ( $dsn->{t} && $dsn->{t} =~ m/\./ ) {
 
2216
      $dsn_table = $q->quote($q->split_unquote($dsn->{t}));
 
2217
   }
 
2218
   else {
 
2219
      die "DSN table DSN does not specify a database (D) "
 
2220
        . "or a database-qualified table (t)";
 
2221
   }
 
2222
 
 
2223
   my $dsn_tbl_cxn = $make_cxn->(dsn => $dsn);
 
2224
   my $dbh         = $dsn_tbl_cxn->connect();
 
2225
   my $sql         = "SELECT dsn FROM $dsn_table ORDER BY id";
 
2226
   PTDEBUG && _d($sql);
 
2227
   my $dsn_strings = $dbh->selectcol_arrayref($sql);
 
2228
   my @cxn;
 
2229
   if ( $dsn_strings ) {
 
2230
      foreach my $dsn_string ( @$dsn_strings ) {
 
2231
         PTDEBUG && _d('DSN from DSN table:', $dsn_string);
 
2232
         push @cxn, $make_cxn->(dsn_string => $dsn_string);
 
2233
      }
 
2234
   }
 
2235
   return \@cxn;
 
2236
}
 
2237
 
2153
2238
sub _d {
2154
2239
   my ($package, undef, $line) = caller 0;
2155
2240
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
2178
2263
use strict;
2179
2264
use warnings FATAL => 'all';
2180
2265
use English qw(-no_match_vars);
2181
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
2266
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
2182
2267
 
2183
2268
use POSIX qw(setsid);
2184
2269
 
2196
2281
 
2197
2282
   check_PID_file(undef, $self->{PID_file});
2198
2283
 
2199
 
   MKDEBUG && _d('Daemonized child will log to', $self->{log_file});
 
2284
   PTDEBUG && _d('Daemonized child will log to', $self->{log_file});
2200
2285
   return bless $self, $class;
2201
2286
}
2202
2287
 
2203
2288
sub daemonize {
2204
2289
   my ( $self ) = @_;
2205
2290
 
2206
 
   MKDEBUG && _d('About to fork and daemonize');
 
2291
   PTDEBUG && _d('About to fork and daemonize');
2207
2292
   defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR";
2208
2293
   if ( $pid ) {
2209
 
      MKDEBUG && _d('I am the parent and now I die');
 
2294
      PTDEBUG && _d('I am the parent and now I die');
2210
2295
      exit;
2211
2296
   }
2212
2297
 
2248
2333
      }
2249
2334
   }
2250
2335
 
2251
 
   MKDEBUG && _d('I am the child and now I live daemonized');
 
2336
   PTDEBUG && _d('I am the child and now I live daemonized');
2252
2337
   return;
2253
2338
}
2254
2339
 
2255
2340
sub check_PID_file {
2256
2341
   my ( $self, $file ) = @_;
2257
2342
   my $PID_file = $self ? $self->{PID_file} : $file;
2258
 
   MKDEBUG && _d('Checking PID file', $PID_file);
 
2343
   PTDEBUG && _d('Checking PID file', $PID_file);
2259
2344
   if ( $PID_file && -f $PID_file ) {
2260
2345
      my $pid;
2261
2346
      eval { chomp($pid = `cat $PID_file`); };
2262
2347
      die "Cannot cat $PID_file: $OS_ERROR" if $EVAL_ERROR;
2263
 
      MKDEBUG && _d('PID file exists; it contains PID', $pid);
 
2348
      PTDEBUG && _d('PID file exists; it contains PID', $pid);
2264
2349
      if ( $pid ) {
2265
2350
         my $pid_is_alive = kill 0, $pid;
2266
2351
         if ( $pid_is_alive ) {
2278
2363
      }
2279
2364
   }
2280
2365
   else {
2281
 
      MKDEBUG && _d('No PID file');
 
2366
      PTDEBUG && _d('No PID file');
2282
2367
   }
2283
2368
   return;
2284
2369
}
2298
2383
 
2299
2384
   my $PID_file = $self->{PID_file};
2300
2385
   if ( !$PID_file ) {
2301
 
      MKDEBUG && _d('No PID file to create');
 
2386
      PTDEBUG && _d('No PID file to create');
2302
2387
      return;
2303
2388
   }
2304
2389
 
2311
2396
   close $PID_FH
2312
2397
      or die "Cannot close PID file $PID_file: $OS_ERROR";
2313
2398
 
2314
 
   MKDEBUG && _d('Created PID file:', $self->{PID_file});
 
2399
   PTDEBUG && _d('Created PID file:', $self->{PID_file});
2315
2400
   return;
2316
2401
}
2317
2402
 
2320
2405
   if ( $self->{PID_file} && -f $self->{PID_file} ) {
2321
2406
      unlink $self->{PID_file}
2322
2407
         or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR";
2323
 
      MKDEBUG && _d('Removed PID file');
 
2408
      PTDEBUG && _d('Removed PID file');
2324
2409
   }
2325
2410
   else {
2326
 
      MKDEBUG && _d('No PID to remove');
 
2411
      PTDEBUG && _d('No PID to remove');
2327
2412
   }
2328
2413
   return;
2329
2414
}
2366
2451
use Time::HiRes qw(sleep);
2367
2452
use sigtrap qw(handler finish untrapped normal-signals);
2368
2453
 
2369
 
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
 
2454
use constant PTDEBUG => $ENV{PTDEBUG} || 0;
2370
2455
 
2371
2456
$OUTPUT_AUTOFLUSH = 1;
2372
2457
 
2411
2496
   # ########################################################################
2412
2497
   my $sentinel = $o->get('sentinel');
2413
2498
   if ( $o->get('stop') ) {
2414
 
      MKDEBUG && _d('Creating sentinel file', $sentinel);
 
2499
      PTDEBUG && _d('Creating sentinel file', $sentinel);
2415
2500
      my $file = IO::File->new($sentinel, ">>")
2416
2501
         or die "Cannot open $sentinel: $OS_ERROR\n";
2417
2502
      print $file "Remove this file to permit pt-slave-restart to run\n"
2422
2507
         unless $o->get('quiet');
2423
2508
      # Exit unlesss --monitor is given.
2424
2509
      if ( !$o->got('monitor') ) {
2425
 
         MKDEBUG && _d('Nothing more to do, quitting');
 
2510
         PTDEBUG && _d('Nothing more to do, quitting');
2426
2511
         return 0;
2427
2512
      }
2428
2513
      else {
2429
2514
         # Wait for all other running instances to quit, assuming they have the
2430
2515
         # same --interval as this invocation.  Then remove the file and
2431
2516
         # continue.
2432
 
         MKDEBUG && _d('Waiting for other instances to quit');
 
2517
         PTDEBUG && _d('Waiting for other instances to quit');
2433
2518
         sleep $o->get('max-sleep');
2434
 
         MKDEBUG && _d('Unlinking', $sentinel);
 
2519
         PTDEBUG && _d('Unlinking', $sentinel);
2435
2520
         unlink $sentinel
2436
2521
            or die "Cannot unlink $sentinel: $OS_ERROR";
2437
2522
      }
2456
2541
   if ( $o->get('daemonize') ) {
2457
2542
      $daemon = new Daemon(o=>$o);
2458
2543
      $daemon->daemonize();
2459
 
      MKDEBUG && _d('I am a daemon now');
 
2544
      PTDEBUG && _d('I am a daemon now');
2460
2545
   }
2461
2546
   elsif ( $o->get('pid') ) {
2462
2547
      # We're not daemoninzing, it just handles PID stuff.
2489
2574
            };
2490
2575
            if ( $EVAL_ERROR ) {
2491
2576
               chomp $EVAL_ERROR;
2492
 
               MKDEBUG && _d('Not watching', $dp->as_string($dsn),
 
2577
               PTDEBUG && _d('Not watching', $dp->as_string($dsn),
2493
2578
                  'because', $EVAL_ERROR);
2494
2579
            }
2495
2580
         },
2521
2606
      $children{$dp->as_string($host->{dsn})} = $pid if $must_fork;
2522
2607
   }
2523
2608
 
2524
 
   MKDEBUG && _d('Child PIDs:', values %children);
 
2609
   PTDEBUG && _d('Child PIDs:', values %children);
2525
2610
   # Wait for the children to exit.
2526
2611
   foreach my $host ( keys %children ) {
2527
 
      MKDEBUG && _d('Waiting to reap', $host);
 
2612
      PTDEBUG && _d('Waiting to reap', $host);
2528
2613
      my $pid = waitpid($children{$host}, 0);
2529
2614
      $exit_status ||= $CHILD_ERROR >> 8;
2530
2615
   }
2542
2627
sub watch_server {
2543
2628
   my ( $dsn, $dbh, $was_forked, $ms ) = @_;
2544
2629
 
2545
 
   MKDEBUG && _d('Watching server', $dp->as_string($dsn),
 
2630
   PTDEBUG && _d('Watching server', $dp->as_string($dsn),
2546
2631
      'forked:', $was_forked);
2547
2632
 
2548
2633
   my $start_sql = $vp->version_ge($dbh, '4.0.5')
2581
2666
   my %actions = (
2582
2667
      refetch_relay_log => sub {
2583
2668
         my ( $stat, $dbh ) = @_;
2584
 
         MKDEBUG && _d('Found relay log corruption');
 
2669
         PTDEBUG && _d('Found relay log corruption');
2585
2670
         # Can't do CHANGE MASTER TO with a running slave.
2586
2671
         $stop->execute();
2587
2672
         $chmt->execute(
2589
2674
      },
2590
2675
      skip => sub {
2591
2676
         my ( $stat, $dbh ) = @_;
2592
 
         MKDEBUG && _d('Found non-relay-log error');
 
2677
         PTDEBUG && _d('Found non-relay-log error');
2593
2678
         $set_skip->execute();
2594
2679
      },
2595
2680
      repair_table => sub {
2596
2681
         my ( $stat, $dbh ) = @_;
2597
 
         MKDEBUG && _d('Found corrupt table');
 
2682
         PTDEBUG && _d('Found corrupt table');
2598
2683
         # [ qr/Incorrect key file for table './foo/bar.MYI'
2599
2684
         my ( $db, $tbl ) = $stat->{last_error} =~ m!([^/]+)/(.*?)\.MYI!;
2600
2685
         if ( $db && $tbl ) {
2601
2686
            my $sql = "REPAIR TABLE " . $q->quote($db, $tbl);
2602
 
            MKDEBUG && _d($sql);
 
2687
            PTDEBUG && _d($sql);
2603
2688
            $dbh->do($sql);
2604
2689
         }
2605
2690
      },
2623
2708
         next STAT;
2624
2709
      }
2625
2710
 
2626
 
      MKDEBUG && _d('Last/current relay log file:',
 
2711
      PTDEBUG && _d('Last/current relay log file:',
2627
2712
         $last_log, $stat->{relay_log_file});
2628
 
      MKDEBUG && _d('Last/current relay log pos:',
 
2713
      PTDEBUG && _d('Last/current relay log pos:',
2629
2714
         $last_pos, $stat->{relay_log_pos});
2630
2715
      if ( !$last_log
2631
2716
           || $last_log ne $stat->{relay_log_file}   # Avoid infinite loops
2699
2784
               }
2700
2785
            }
2701
2786
            else {
2702
 
               MKDEBUG && _d('The slave is stopped, but without error');
 
2787
               PTDEBUG && _d('The slave is stopped, but without error');
2703
2788
               $increase_sleep = 1;
2704
2789
            }
2705
2790
         }
2740
2825
      sleep $sleep_time;
2741
2826
   }
2742
2827
 
2743
 
   MKDEBUG && _d('All done with server', $dp->as_string($dsn));
 
2828
   PTDEBUG && _d('All done with server', $dp->as_string($dsn));
2744
2829
   if ( $was_forked ) {
2745
2830
      $dp->disconnect($dbh);
2746
2831
      exit(0);
3342
3427
 
3343
3428
=head1 COPYRIGHT, LICENSE, AND WARRANTY
3344
3429
 
3345
 
This program is copyright 2007-2011 Baron Schwartz, 2011 Percona Inc.
 
3430
This program is copyright 2007-2011 Baron Schwartz, 2011-2012 Percona Inc.
3346
3431
Feedback and improvements are welcome.
3347
3432
 
3348
3433
THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
3361
3446
 
3362
3447
=head1 VERSION
3363
3448
 
3364
 
Percona Toolkit v0.9.5 released 2011-08-04
 
3449
pt-slave-restart 2.0.3
3365
3450
 
3366
3451
=cut