← 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-upgrade

Merged OptionParser-remove-optional_value & updated modules

Show diffs side-by-side

added added

removed removed

Lines of Context:
bin/pt-upgrade
1011
1011
      'default'    => 1,
1012
1012
      'cumulative' => 1,
1013
1013
      'negatable'  => 1,
1014
 
      'value_is_optional' => 1,
1015
1014
   );
1016
1015
 
1017
1016
   my $self = {
1253
1252
            $opt->{short} = undef;
1254
1253
         }
1255
1254
 
1256
 
         $opt->{is_negatable}   = $opt->{spec} =~ m/!/        ? 1 : 0;
1257
 
         $opt->{is_cumulative}  = $opt->{spec} =~ m/\+/       ? 1 : 0;
1258
 
         $opt->{optional_value} = $opt->{spec} =~ m/:/        ? 1 : 0;
1259
 
         $opt->{is_required}    = $opt->{desc} =~ m/required/ ? 1 : 0;
 
1255
         $opt->{is_negatable}  = $opt->{spec} =~ m/!/        ? 1 : 0;
 
1256
         $opt->{is_cumulative} = $opt->{spec} =~ m/\+/       ? 1 : 0;
 
1257
         $opt->{is_required}   = $opt->{desc} =~ m/required/ ? 1 : 0;
1260
1258
 
1261
1259
         $opt->{group} ||= 'default';
1262
1260
         $self->{groups}->{ $opt->{group} }->{$long} = 1;
1392
1390
   if ( $opt->{is_cumulative} ) {
1393
1391
      $opt->{value}++;
1394
1392
   }
1395
 
   elsif ( !($opt->{optional_value} && !$val) ) {
 
1393
   else {
1396
1394
      $opt->{value} = $val;
1397
1395
   }
1398
1396
   $opt->{got} = 1;
1933
1931
sub _parse_attribs {
1934
1932
   my ( $self, $option, $attribs ) = @_;
1935
1933
   my $types = $self->{types};
1936
 
   my $eq    = $attribs->{'value_is_optional'} ? ':' : '=';
1937
1934
   return $option
1938
1935
      . ($attribs->{'short form'} ? '|' . $attribs->{'short form'}   : '' )
1939
1936
      . ($attribs->{'negatable'}  ? '!'                              : '' )
1940
1937
      . ($attribs->{'cumulative'} ? '+'                              : '' )
1941
 
      . ($attribs->{'type'}       ? $eq . $types->{$attribs->{type}} : '' );
 
1938
      . ($attribs->{'type'}       ? '=' . $types->{$attribs->{type}} : '' );
1942
1939
}
1943
1940
 
1944
1941
sub _parse_synopsis {
11314
11311
};
11315
11312
 
11316
11313
sub version_check {
11317
 
   my $args        = pop @_;
11318
 
   my (@instances) = @_;
 
11314
   my %args      = @_;
 
11315
   my @instances = $args{instances} ? @{ $args{instances} } : ();
11319
11316
 
11320
11317
   if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
11321
 
      print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
 
11318
      warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
11322
11319
                   "environment variable.\n\n";
11323
11320
      return;
11324
11321
   }
 
11322
 
 
11323
   $args{protocol} ||= 'https';
 
11324
   my @protocols = $args{protocol} eq 'auto'
 
11325
                 ? qw(https http)
 
11326
                 : $args{protocol};
11325
11327
   
11326
11328
   my $instances_to_check = [];
11327
11329
   my $time               = int(time());
11336
11338
      ($time_to_check, $instances_to_check)
11337
11339
         = time_to_check($check_time_file, \@instances, $time);
11338
11340
      if ( !$time_to_check ) {
11339
 
         print STDERR 'It is not time to --version-check again; ',
 
11341
         warn 'It is not time to --version-check again; ',
11340
11342
                      "only 1 check per day.\n\n";
11341
11343
         return;
11342
11344
      }
11343
11345
 
11344
 
      my $protocol = $args->{protocol} || 'https';
11345
 
      my $advice = pingback(
11346
 
         url       => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
11347
 
         instances => $instances_to_check,
11348
 
         protocol  => $args->{protocol},
11349
 
      );
 
11346
      my $advice;
 
11347
      my $e;
 
11348
      for my $protocol ( @protocols ) {
 
11349
         $advice = eval { pingback(
 
11350
            url       => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
 
11351
            instances => $instances_to_check,
 
11352
            protocol  => $protocol,
 
11353
         ) };
 
11354
         last if !$advice && !$EVAL_ERROR;
 
11355
         $e ||= $EVAL_ERROR;
 
11356
      }
11350
11357
      if ( $advice ) {
11351
11358
         print "# Percona suggests these upgrades:\n";
11352
11359
         print join("\n", map { "#   * $_" } @$advice), "\n\n";
11353
11360
      }
11354
11361
      else {
 
11362
         die $e if $e;
11355
11363
         print "# No suggestions at this time.\n\n";
11356
11364
         ($ENV{PTVCDEBUG} || PTDEBUG )
11357
11365
            && _d('--version-check worked, but there were no suggestions');
11377
11385
 
11378
11386
   my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
11379
11387
 
11380
 
   $ua ||= HTTPMicro->new( timeout => 2 );
 
11388
   $ua ||= HTTPMicro->new( timeout => 5 );
11381
11389
   $vc ||= VersionCheck->new();
11382
11390
 
11383
11391
   my $response = $ua->request('GET', $url);
11593
11601
   return $client_response;
11594
11602
}
11595
11603
 
 
11604
sub validate_options {
 
11605
   my ($o) = @_;
 
11606
 
 
11607
   return if !$o->got('version-check');
 
11608
 
 
11609
   my $value  = $o->get('version-check');
 
11610
   my @values = split /, /,
 
11611
                $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
 
11612
   chomp(@values);
 
11613
                
 
11614
   return if grep { $value eq $_ } @values;
 
11615
   $o->save_error("--version-check invalid value $value.  Accepted values are "
 
11616
                . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
 
11617
}
 
11618
 
11596
11619
sub _d {
11597
11620
   my ($package, undef, $line) = caller 0;
11598
11621
   @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
11686
11709
      $o->save_error('Specify at least one host DSN');
11687
11710
   }
11688
11711
 
 
11712
   Pingback::validate_options($o);
 
11713
   
11689
11714
   $o->usage_or_errors();
11690
11715
 
11691
11716
   if ( $o->get('explain-hosts') ) {
11947
11972
   # ########################################################################
11948
11973
   # Do the version-check
11949
11974
   # ########################################################################
11950
 
   if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
 
11975
   if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
11951
11976
      Pingback::version_check(
11952
 
         map({ +{ dbh => $_->{dbh}, dsn => $_->{dsn} } } @$hosts),
11953
 
         { protocol => $o->get('version-check') },
 
11977
         instances => [ map({ +{ dbh => $_->{dbh}, dsn => $_->{dsn} } } @$hosts) ],
 
11978
         protocol  => $o->get('version-check'),
11954
11979
      );
11955
11980
   }
11956
11981
 
12884
12909
 
12885
12910
=item --version-check
12886
12911
 
12887
 
type: string; value_is_optional: yes; default: https
 
12912
type: string; default: off
12888
12913
 
12889
12914
Send program versions to Percona and print suggested upgrades and problems.
12890
 
 
12891
 
If specified without a value, it will use https by default; However, this
12892
 
might fail if C<IO::Socket::SSL> is not installed on your system, in which
12893
 
case you may choose to use C<--version-check http>, which will forgo
12894
 
encryption but should work out of the box.
 
12915
Possible values for --version-check:
 
12916
 
 
12917
=for comment ignore-pt-internal-value
 
12918
MAGIC_version_check
 
12919
 
 
12920
https, http, auto, off
 
12921
 
 
12922
C<auto> first tries using C<https>, and resorts to C<http> if that fails.
 
12923
Keep in mind that C<https> might not be available if
 
12924
C<IO::Socket::SSL> is not installed on your system, although
 
12925
C<--version-check http> should work everywhere.
12895
12926
 
12896
12927
The version check feature causes the tool to send and receive data from
12897
12928
Percona over the web.  The data contains program versions from the local