← Back to branch summary

~percona-toolkit-dev/percona-toolkit/fix-887638-ptqa-negative-at-byte

« back to all changes in this revision

Viewing changes to bin/pt-deadlock-logger

Merged OptionParser-remove-optional_value & updated modules

Show diffs side-by-side

added added

removed removed

Lines of Context:
bin/pt-deadlock-logger
83
83
      'default'    => 1,
84
84
      'cumulative' => 1,
85
85
      'negatable'  => 1,
86
 
      'value_is_optional' => 1,
87
86
   );
88
87
 
89
88
   my $self = {
325
324
            $opt->{short} = undef;
326
325
         }
327
326
 
328
 
         $opt->{is_negatable}   = $opt->{spec} =~ m/!/        ? 1 : 0;
329
 
         $opt->{is_cumulative}  = $opt->{spec} =~ m/\+/       ? 1 : 0;
330
 
         $opt->{optional_value} = $opt->{spec} =~ m/:/        ? 1 : 0;
331
 
         $opt->{is_required}    = $opt->{desc} =~ m/required/ ? 1 : 0;
 
327
         $opt->{is_negatable}  = $opt->{spec} =~ m/!/        ? 1 : 0;
 
328
         $opt->{is_cumulative} = $opt->{spec} =~ m/\+/       ? 1 : 0;
 
329
         $opt->{is_required}   = $opt->{desc} =~ m/required/ ? 1 : 0;
332
330
 
333
331
         $opt->{group} ||= 'default';
334
332
         $self->{groups}->{ $opt->{group} }->{$long} = 1;
464
462
   if ( $opt->{is_cumulative} ) {
465
463
      $opt->{value}++;
466
464
   }
467
 
   elsif ( !($opt->{optional_value} && !$val) ) {
 
465
   else {
468
466
      $opt->{value} = $val;
469
467
   }
470
468
   $opt->{got} = 1;
1005
1003
sub _parse_attribs {
1006
1004
   my ( $self, $option, $attribs ) = @_;
1007
1005
   my $types = $self->{types};
1008
 
   my $eq    = $attribs->{'value_is_optional'} ? ':' : '=';
1009
1006
   return $option
1010
1007
      . ($attribs->{'short form'} ? '|' . $attribs->{'short form'}   : '' )
1011
1008
      . ($attribs->{'negatable'}  ? '!'                              : '' )
1012
1009
      . ($attribs->{'cumulative'} ? '+'                              : '' )
1013
 
      . ($attribs->{'type'}       ? $eq . $types->{$attribs->{type}} : '' );
 
1010
      . ($attribs->{'type'}       ? '=' . $types->{$attribs->{type}} : '' );
1014
1011
}
1015
1012
 
1016
1013
sub _parse_synopsis {
3402
3399
};
3403
3400
 
3404
3401
sub version_check {
3405
 
   my $args        = pop @_;
3406
 
   my (@instances) = @_;
 
3402
   my %args      = @_;
 
3403
   my @instances = $args{instances} ? @{ $args{instances} } : ();
3407
3404
 
3408
3405
   if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
3409
 
      print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
 
3406
      warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
3410
3407
                   "environment variable.\n\n";
3411
3408
      return;
3412
3409
   }
 
3410
 
 
3411
   $args{protocol} ||= 'https';
 
3412
   my @protocols = $args{protocol} eq 'auto'
 
3413
                 ? qw(https http)
 
3414
                 : $args{protocol};
3413
3415
   
3414
3416
   my $instances_to_check = [];
3415
3417
   my $time               = int(time());
3424
3426
      ($time_to_check, $instances_to_check)
3425
3427
         = time_to_check($check_time_file, \@instances, $time);
3426
3428
      if ( !$time_to_check ) {
3427
 
         print STDERR 'It is not time to --version-check again; ',
 
3429
         warn 'It is not time to --version-check again; ',
3428
3430
                      "only 1 check per day.\n\n";
3429
3431
         return;
3430
3432
      }
3431
3433
 
3432
 
      my $protocol = $args->{protocol} || 'https';
3433
 
      my $advice = pingback(
3434
 
         url       => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
3435
 
         instances => $instances_to_check,
3436
 
         protocol  => $args->{protocol},
3437
 
      );
 
3434
      my $advice;
 
3435
      my $e;
 
3436
      for my $protocol ( @protocols ) {
 
3437
         $advice = eval { pingback(
 
3438
            url       => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
 
3439
            instances => $instances_to_check,
 
3440
            protocol  => $protocol,
 
3441
         ) };
 
3442
         last if !$advice && !$EVAL_ERROR;
 
3443
         $e ||= $EVAL_ERROR;
 
3444
      }
3438
3445
      if ( $advice ) {
3439
3446
         print "# Percona suggests these upgrades:\n";
3440
3447
         print join("\n", map { "#   * $_" } @$advice), "\n\n";
3441
3448
      }
3442
3449
      else {
 
3450
         die $e if $e;
3443
3451
         print "# No suggestions at this time.\n\n";
3444
3452
         ($ENV{PTVCDEBUG} || PTDEBUG )
3445
3453
            && _d('--version-check worked, but there were no suggestions');
3465
3473
 
3466
3474
   my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
3467
3475
 
3468
 
   $ua ||= HTTPMicro->new( timeout => 2 );
 
3476
   $ua ||= HTTPMicro->new( timeout => 5 );
3469
3477
   $vc ||= VersionCheck->new();
3470
3478
 
3471
3479
   my $response = $ua->request('GET', $url);
3681
3689
   return $client_response;
3682
3690
}
3683
3691
 
 
3692
sub validate_options {
 
3693
   my ($o) = @_;
 
3694
 
 
3695
   return if !$o->got('version-check');
 
3696
 
 
3697
   my $value  = $o->get('version-check');
 
3698
   my @values = split /, /,
 
3699
                $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
 
3700
   chomp(@values);
 
3701
                
 
3702
   return if grep { $value eq $_ } @values;
 
3703
   $o->save_error("--version-check invalid value $value.  Accepted values are "
 
3704
                . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
 
3705
}
 
3706
 
3684
3707
sub _d {
3685
3708
   my ($package, undef, $line) = caller 0;
3686
3709
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
3803
3826
         $o->save_error("--dest requires a 't' (table) part");
3804
3827
      }
3805
3828
 
 
3829
      Pingback::validate_options($o);
 
3830
      
3806
3831
      # Avoid running forever with zero second interval.
3807
3832
      if ( $o->get('run-time') && !$o->get('interval') ) {
3808
3833
         $o->set('interval', 1);
3872
3897
   # ########################################################################
3873
3898
   # Do the version-check
3874
3899
   # ########################################################################
3875
 
   if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
 
3900
   if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
3876
3901
      Pingback::version_check(
3877
 
         { dbh => $dbh, dsn => $source_dsn },
3878
 
         ($dest_dsn ? { dbh => $dest_dsn, dsn => $dest_dsn } : ()),
3879
 
         { protocol => $o->get('version-check') },
 
3902
         instances => [
 
3903
            { dbh => $dbh, dsn => $source_dsn },
 
3904
            ($dest_dsn ? { dbh => $dest_dsn, dsn => $dest_dsn } : ()),
 
3905
         ],
 
3906
         protocol  => $o->get('version-check'),
3880
3907
      );
3881
3908
   }
3882
3909
 
4564
4591
 
4565
4592
=item --version-check
4566
4593
 
4567
 
type: string; value_is_optional: yes; default: https
 
4594
type: string; default: off
4568
4595
 
4569
4596
Send program versions to Percona and print suggested upgrades and problems.
4570
 
 
4571
 
If specified without a value, it will use https by default; However, this
4572
 
might fail if C<IO::Socket::SSL> is not installed on your system, in which
4573
 
case you may choose to use C<--version-check http>, which will forgo
4574
 
encryption but should work out of the box.
 
4597
Possible values for --version-check:
 
4598
 
 
4599
=for comment ignore-pt-internal-value
 
4600
MAGIC_version_check
 
4601
 
 
4602
https, http, auto, off
 
4603
 
 
4604
C<auto> first tries using C<https>, and resorts to C<http> if that fails.
 
4605
Keep in mind that C<https> might not be available if
 
4606
C<IO::Socket::SSL> is not installed on your system, although
 
4607
C<--version-check http> should work everywhere.
4575
4608
 
4576
4609
The version check feature causes the tool to send and receive data from
4577
4610
Percona over the web.  The data contains program versions from the local