Merge lp:~percona-toolkit-dev/percona-toolkit/OptionParser-remove-optional_value into lp:percona-toolkit/2.1

Proposed by Brian Fraser
Status: Merged
Approved by: Daniel Nichter
Approved revision: 439
Merged at revision: 454
Proposed branch: lp:~percona-toolkit-dev/percona-toolkit/OptionParser-remove-optional_value
Merge into: lp:percona-toolkit/2.1
Diff against target: 4383 lines (+1264/-677)
31 files modified
bin/pt-archiver (+62/-29)
bin/pt-config-diff (+58/-28)
bin/pt-deadlock-logger (+62/-29)
bin/pt-diskstats (+57/-27)
bin/pt-duplicate-key-checker (+59/-29)
bin/pt-fifo-split (+5/-8)
bin/pt-find (+59/-28)
bin/pt-fingerprint (+5/-8)
bin/pt-fk-error-logger (+62/-29)
bin/pt-heartbeat (+61/-27)
bin/pt-index-usage (+62/-29)
bin/pt-kill (+59/-28)
bin/pt-log-player (+5/-8)
bin/pt-online-schema-change (+60/-29)
bin/pt-query-advisor (+62/-29)
bin/pt-query-digest (+63/-30)
bin/pt-show-grants (+5/-8)
bin/pt-slave-delay (+62/-29)
bin/pt-slave-find (+5/-8)
bin/pt-slave-restart (+59/-28)
bin/pt-table-checksum (+62/-29)
bin/pt-table-sync (+61/-27)
bin/pt-tcp-model (+5/-8)
bin/pt-trend (+5/-8)
bin/pt-upgrade (+59/-28)
bin/pt-variable-advisor (+59/-28)
lib/OptionParser.pm (+5/-8)
lib/Pingback.pm (+42/-11)
t/lib/OptionParser.t (+3/-62)
t/lib/Pingback.t (+18/-0)
t/pt-query-digest/version_check.t (+13/-0)
To merge this branch: bzr merge lp:~percona-toolkit-dev/percona-toolkit/OptionParser-remove-optional_value
Reviewer Review Type Date Requested Status
Daniel Nichter Approve
Review via email: mp+132222@code.launchpad.net
To post a comment you must log in.
Revision history for this message
Daniel Nichter (daniel-nichter) wrote :

In Pingback.pm:

sub version_check {
   my $args = pop @_;
   my (@instances) = @_;

That should be our standard %args.

      print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
                   "environment variable.\n\n";

I think those should just be warn "..." (we tend not to use print STDERR for whatever reason).

      $args->{protocol} ||= 'https';
      my @protocols = $args->{protocol} ne 'https' && $args->{protocol} ne 'http'
                    ? qw(https http)
                    : $args->{protocol};

Let's do this earlier, before the eval, and check for 'off'. If 'off', then return. This will need to happen in the future when we switch the default to 'auto'.

Also, make the ?: more clear because right now it reads like "if not https and not http, then use https and http"--huh? (because 'auto', but that's not clear).

Also, --version-check '' on the cmd line isn't handled, so we need to check the --version-check value before $o->usage_or_errors(). To do this, make a MAGIC_version_check_protocols lists and use that so the docs become the actual values we check for (see MAGIC_history_cols in pqd for an example).

While v-c is a manual thing, let's increase,

   $ua ||= HTTPMicro->new( timeout => 2 );

to 5 since the user, knowing what v-c does, should be a little more lenient (and eventually they'll get either "No advice" or a warning or something, so they'll know the delay was due to v-c working).

review: Needs Fixing
437. By Brian Fraser

Updates per Daniel's review

438. By Brian Fraser

Fixed a typo and added some regression tests

Revision history for this message
Daniel Nichter (daniel-nichter) wrote :

516for my $exec ( grep { slurp_file($_) =~ /package Pingback;/ }
 517 grep { !/~/ }
 518 glob("$trunk/bin/*")
 519 )

That's good, but let's do it a little more light-weight. Remember, our poor test boxes are already strained. Why not just:

my @vc_tools = map { /(\S+)/ } `grep --files-with-matches Pingback $trunk/bin/*`;
foreach my $tool ( @vc_tools ) {
...

In this error: "--version-check invalud value $value. Accepted values are", double space between the sentence, i.e. \s\s instead of just \s before "Accepted" (blame Baron for encouraging my grammatical zealousness).

Typo in --version-check docs: ""auto" first tries using "https", and resolts to"

review: Needs Fixing
439. By Brian Fraser

Fixes per Daniel's review

Revision history for this message
Daniel Nichter (daniel-nichter) :
review: Approve

Preview Diff

[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
1=== modified file 'bin/pt-archiver'
2--- bin/pt-archiver 2012-11-05 17:57:11 +0000
3+++ bin/pt-archiver 2012-11-06 15:04:24 +0000
4@@ -86,7 +86,6 @@
5 'default' => 1,
6 'cumulative' => 1,
7 'negatable' => 1,
8- 'value_is_optional' => 1,
9 );
10
11 my $self = {
12@@ -328,10 +327,9 @@
13 $opt->{short} = undef;
14 }
15
16- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
17- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
18- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
19- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
20+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
21+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
22+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
23
24 $opt->{group} ||= 'default';
25 $self->{groups}->{ $opt->{group} }->{$long} = 1;
26@@ -467,7 +465,7 @@
27 if ( $opt->{is_cumulative} ) {
28 $opt->{value}++;
29 }
30- elsif ( !($opt->{optional_value} && !$val) ) {
31+ else {
32 $opt->{value} = $val;
33 }
34 $opt->{got} = 1;
35@@ -1008,12 +1006,11 @@
36 sub _parse_attribs {
37 my ( $self, $option, $attribs ) = @_;
38 my $types = $self->{types};
39- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
40 return $option
41 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
42 . ($attribs->{'negatable'} ? '!' : '' )
43 . ($attribs->{'cumulative'} ? '+' : '' )
44- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
45+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
46 }
47
48 sub _parse_synopsis {
49@@ -4810,14 +4807,19 @@
50 };
51
52 sub version_check {
53- my $args = pop @_;
54- my (@instances) = @_;
55+ my %args = @_;
56+ my @instances = $args{instances} ? @{ $args{instances} } : ();
57
58 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
59- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
60+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
61 "environment variable.\n\n";
62 return;
63 }
64+
65+ $args{protocol} ||= 'https';
66+ my @protocols = $args{protocol} eq 'auto'
67+ ? qw(https http)
68+ : $args{protocol};
69
70 my $instances_to_check = [];
71 my $time = int(time());
72@@ -4832,22 +4834,28 @@
73 ($time_to_check, $instances_to_check)
74 = time_to_check($check_time_file, \@instances, $time);
75 if ( !$time_to_check ) {
76- print STDERR 'It is not time to --version-check again; ',
77+ warn 'It is not time to --version-check again; ',
78 "only 1 check per day.\n\n";
79 return;
80 }
81
82- my $protocol = $args->{protocol} || 'https';
83- my $advice = pingback(
84- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
85- instances => $instances_to_check,
86- protocol => $args->{protocol},
87- );
88+ my $advice;
89+ my $e;
90+ for my $protocol ( @protocols ) {
91+ $advice = eval { pingback(
92+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
93+ instances => $instances_to_check,
94+ protocol => $protocol,
95+ ) };
96+ last if !$advice && !$EVAL_ERROR;
97+ $e ||= $EVAL_ERROR;
98+ }
99 if ( $advice ) {
100 print "# Percona suggests these upgrades:\n";
101 print join("\n", map { "# * $_" } @$advice), "\n\n";
102 }
103 else {
104+ die $e if $e;
105 print "# No suggestions at this time.\n\n";
106 ($ENV{PTVCDEBUG} || PTDEBUG )
107 && _d('--version-check worked, but there were no suggestions');
108@@ -4873,7 +4881,7 @@
109
110 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
111
112- $ua ||= HTTPMicro->new( timeout => 2 );
113+ $ua ||= HTTPMicro->new( timeout => 5 );
114 $vc ||= VersionCheck->new();
115
116 my $response = $ua->request('GET', $url);
117@@ -5089,6 +5097,21 @@
118 return $client_response;
119 }
120
121+sub validate_options {
122+ my ($o) = @_;
123+
124+ return if !$o->got('version-check');
125+
126+ my $value = $o->get('version-check');
127+ my @values = split /, /,
128+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
129+ chomp(@values);
130+
131+ return if grep { $value eq $_ } @values;
132+ $o->save_error("--version-check invalid value $value. Accepted values are "
133+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
134+}
135+
136 sub _d {
137 my ($package, undef, $line) = caller 0;
138 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
139@@ -5233,6 +5256,8 @@
140 $o->save_error("--bulk-delete is meaningless with --limit 1");
141 }
142
143+ Pingback::validate_options($o);
144+
145 }
146
147 if ( $bulk_del || $o->get('bulk-insert') ) {
148@@ -5630,11 +5655,13 @@
149 # ########################################################################
150 # Do the version-check
151 # ########################################################################
152- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
153+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
154 Pingback::version_check(
155- { dbh => $src->{dbh}, dsn => $src->{dsn} },
156- ( $dst ? { dbh => $dst->{dbh}, dsn => $dst->{dsn} } : () ),
157- { protocol => $o->get('version-check') },
158+ instances => [
159+ { dbh => $src->{dbh}, dsn => $src->{dsn} },
160+ ( $dst ? { dbh => $dst->{dbh}, dsn => $dst->{dsn} } : () ),
161+ ],
162+ protocol => $o->get('version-check'),
163 );
164 }
165
166@@ -7071,14 +7098,20 @@
167
168 =item --version-check
169
170-type: string; value_is_optional: yes; default: https
171+type: string; default: off
172
173 Send program versions to Percona and print suggested upgrades and problems.
174-
175-If specified without a value, it will use https by default; However, this
176-might fail if C<IO::Socket::SSL> is not installed on your system; for the
177-latter case, you may choose to use C<--version-check http>, which will forgo
178-encryption but should work out of the box.
179+Possible values for --version-check:
180+
181+=for comment ignore-pt-internal-value
182+MAGIC_version_check
183+
184+https, http, auto, off
185+
186+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
187+Keep in mind that C<https> might not be available if
188+C<IO::Socket::SSL> is not installed on your system, although
189+C<--version-check http> should work everywhere.
190
191 The version check feature causes the tool to send and receive data from
192 Percona over the web. The data contains program versions from the local
193
194=== modified file 'bin/pt-config-diff'
195--- bin/pt-config-diff 2012-10-31 09:18:34 +0000
196+++ bin/pt-config-diff 2012-11-06 15:04:24 +0000
197@@ -85,7 +85,6 @@
198 'default' => 1,
199 'cumulative' => 1,
200 'negatable' => 1,
201- 'value_is_optional' => 1,
202 );
203
204 my $self = {
205@@ -327,10 +326,9 @@
206 $opt->{short} = undef;
207 }
208
209- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
210- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
211- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
212- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
213+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
214+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
215+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
216
217 $opt->{group} ||= 'default';
218 $self->{groups}->{ $opt->{group} }->{$long} = 1;
219@@ -466,7 +464,7 @@
220 if ( $opt->{is_cumulative} ) {
221 $opt->{value}++;
222 }
223- elsif ( !($opt->{optional_value} && !$val) ) {
224+ else {
225 $opt->{value} = $val;
226 }
227 $opt->{got} = 1;
228@@ -1007,12 +1005,11 @@
229 sub _parse_attribs {
230 my ( $self, $option, $attribs ) = @_;
231 my $types = $self->{types};
232- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
233 return $option
234 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
235 . ($attribs->{'negatable'} ? '!' : '' )
236 . ($attribs->{'cumulative'} ? '+' : '' )
237- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
238+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
239 }
240
241 sub _parse_synopsis {
242@@ -3959,14 +3956,19 @@
243 };
244
245 sub version_check {
246- my $args = pop @_;
247- my (@instances) = @_;
248+ my %args = @_;
249+ my @instances = $args{instances} ? @{ $args{instances} } : ();
250
251 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
252- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
253+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
254 "environment variable.\n\n";
255 return;
256 }
257+
258+ $args{protocol} ||= 'https';
259+ my @protocols = $args{protocol} eq 'auto'
260+ ? qw(https http)
261+ : $args{protocol};
262
263 my $instances_to_check = [];
264 my $time = int(time());
265@@ -3981,22 +3983,28 @@
266 ($time_to_check, $instances_to_check)
267 = time_to_check($check_time_file, \@instances, $time);
268 if ( !$time_to_check ) {
269- print STDERR 'It is not time to --version-check again; ',
270+ warn 'It is not time to --version-check again; ',
271 "only 1 check per day.\n\n";
272 return;
273 }
274
275- my $protocol = $args->{protocol} || 'https';
276- my $advice = pingback(
277- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
278- instances => $instances_to_check,
279- protocol => $args->{protocol},
280- );
281+ my $advice;
282+ my $e;
283+ for my $protocol ( @protocols ) {
284+ $advice = eval { pingback(
285+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
286+ instances => $instances_to_check,
287+ protocol => $protocol,
288+ ) };
289+ last if !$advice && !$EVAL_ERROR;
290+ $e ||= $EVAL_ERROR;
291+ }
292 if ( $advice ) {
293 print "# Percona suggests these upgrades:\n";
294 print join("\n", map { "# * $_" } @$advice), "\n\n";
295 }
296 else {
297+ die $e if $e;
298 print "# No suggestions at this time.\n\n";
299 ($ENV{PTVCDEBUG} || PTDEBUG )
300 && _d('--version-check worked, but there were no suggestions');
301@@ -4022,7 +4030,7 @@
302
303 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
304
305- $ua ||= HTTPMicro->new( timeout => 2 );
306+ $ua ||= HTTPMicro->new( timeout => 5 );
307 $vc ||= VersionCheck->new();
308
309 my $response = $ua->request('GET', $url);
310@@ -4238,6 +4246,21 @@
311 return $client_response;
312 }
313
314+sub validate_options {
315+ my ($o) = @_;
316+
317+ return if !$o->got('version-check');
318+
319+ my $value = $o->get('version-check');
320+ my @values = split /, /,
321+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
322+ chomp(@values);
323+
324+ return if grep { $value eq $_ } @values;
325+ $o->save_error("--version-check invalid value $value. Accepted values are "
326+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
327+}
328+
329 sub _d {
330 my ($package, undef, $line) = caller 0;
331 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
332@@ -4290,6 +4313,7 @@
333 if ( @ARGV < 1 ) {
334 $o->save_error("Specify at least one file or DSN on the command line");
335 }
336+ Pingback::validate_options($o);
337 }
338
339 $o->usage_or_errors();
340@@ -4364,10 +4388,10 @@
341 # ########################################################################
342 # Do the version-check
343 # ########################################################################
344- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
345+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
346 Pingback::version_check(
347- map({ +{ dbh => $_->dbh, dsn => $_->dsn } } @cxn),
348- { protocol => $o->get('version-check') },
349+ instances => [ map({ +{ dbh => $_->dbh, dsn => $_->dsn } } @cxn) ],
350+ protocol => $o->get('version-check'),
351 );
352 }
353
354@@ -4651,14 +4675,20 @@
355
356 =item --version-check
357
358-type: string; value_is_optional: yes; default: https
359+type: string; default: off
360
361 Send program versions to Percona and print suggested upgrades and problems.
362-
363-If specified without a value, it will use https by default; However, this
364-might fail if C<IO::Socket::SSL> is not installed on your system, in which
365-case you may choose to use C<--version-check http>, which will forgo
366-encryption but should work out of the box.
367+Possible values for --version-check:
368+
369+=for comment ignore-pt-internal-value
370+MAGIC_version_check
371+
372+https, http, auto, off
373+
374+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
375+Keep in mind that C<https> might not be available if
376+C<IO::Socket::SSL> is not installed on your system, although
377+C<--version-check http> should work everywhere.
378
379 The version check feature causes the tool to send and receive data from
380 Percona over the web. The data contains program versions from the local
381
382=== modified file 'bin/pt-deadlock-logger'
383--- bin/pt-deadlock-logger 2012-10-31 09:18:34 +0000
384+++ bin/pt-deadlock-logger 2012-11-06 15:04:24 +0000
385@@ -83,7 +83,6 @@
386 'default' => 1,
387 'cumulative' => 1,
388 'negatable' => 1,
389- 'value_is_optional' => 1,
390 );
391
392 my $self = {
393@@ -325,10 +324,9 @@
394 $opt->{short} = undef;
395 }
396
397- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
398- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
399- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
400- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
401+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
402+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
403+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
404
405 $opt->{group} ||= 'default';
406 $self->{groups}->{ $opt->{group} }->{$long} = 1;
407@@ -464,7 +462,7 @@
408 if ( $opt->{is_cumulative} ) {
409 $opt->{value}++;
410 }
411- elsif ( !($opt->{optional_value} && !$val) ) {
412+ else {
413 $opt->{value} = $val;
414 }
415 $opt->{got} = 1;
416@@ -1005,12 +1003,11 @@
417 sub _parse_attribs {
418 my ( $self, $option, $attribs ) = @_;
419 my $types = $self->{types};
420- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
421 return $option
422 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
423 . ($attribs->{'negatable'} ? '!' : '' )
424 . ($attribs->{'cumulative'} ? '+' : '' )
425- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
426+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
427 }
428
429 sub _parse_synopsis {
430@@ -3401,14 +3398,19 @@
431 };
432
433 sub version_check {
434- my $args = pop @_;
435- my (@instances) = @_;
436+ my %args = @_;
437+ my @instances = $args{instances} ? @{ $args{instances} } : ();
438
439 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
440- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
441+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
442 "environment variable.\n\n";
443 return;
444 }
445+
446+ $args{protocol} ||= 'https';
447+ my @protocols = $args{protocol} eq 'auto'
448+ ? qw(https http)
449+ : $args{protocol};
450
451 my $instances_to_check = [];
452 my $time = int(time());
453@@ -3423,22 +3425,28 @@
454 ($time_to_check, $instances_to_check)
455 = time_to_check($check_time_file, \@instances, $time);
456 if ( !$time_to_check ) {
457- print STDERR 'It is not time to --version-check again; ',
458+ warn 'It is not time to --version-check again; ',
459 "only 1 check per day.\n\n";
460 return;
461 }
462
463- my $protocol = $args->{protocol} || 'https';
464- my $advice = pingback(
465- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
466- instances => $instances_to_check,
467- protocol => $args->{protocol},
468- );
469+ my $advice;
470+ my $e;
471+ for my $protocol ( @protocols ) {
472+ $advice = eval { pingback(
473+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
474+ instances => $instances_to_check,
475+ protocol => $protocol,
476+ ) };
477+ last if !$advice && !$EVAL_ERROR;
478+ $e ||= $EVAL_ERROR;
479+ }
480 if ( $advice ) {
481 print "# Percona suggests these upgrades:\n";
482 print join("\n", map { "# * $_" } @$advice), "\n\n";
483 }
484 else {
485+ die $e if $e;
486 print "# No suggestions at this time.\n\n";
487 ($ENV{PTVCDEBUG} || PTDEBUG )
488 && _d('--version-check worked, but there were no suggestions');
489@@ -3464,7 +3472,7 @@
490
491 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
492
493- $ua ||= HTTPMicro->new( timeout => 2 );
494+ $ua ||= HTTPMicro->new( timeout => 5 );
495 $vc ||= VersionCheck->new();
496
497 my $response = $ua->request('GET', $url);
498@@ -3680,6 +3688,21 @@
499 return $client_response;
500 }
501
502+sub validate_options {
503+ my ($o) = @_;
504+
505+ return if !$o->got('version-check');
506+
507+ my $value = $o->get('version-check');
508+ my @values = split /, /,
509+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
510+ chomp(@values);
511+
512+ return if grep { $value eq $_ } @values;
513+ $o->save_error("--version-check invalid value $value. Accepted values are "
514+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
515+}
516+
517 sub _d {
518 my ($package, undef, $line) = caller 0;
519 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
520@@ -3802,6 +3825,8 @@
521 $o->save_error("--dest requires a 't' (table) part");
522 }
523
524+ Pingback::validate_options($o);
525+
526 # Avoid running forever with zero second interval.
527 if ( $o->get('run-time') && !$o->get('interval') ) {
528 $o->set('interval', 1);
529@@ -3871,11 +3896,13 @@
530 # ########################################################################
531 # Do the version-check
532 # ########################################################################
533- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
534+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
535 Pingback::version_check(
536- { dbh => $dbh, dsn => $source_dsn },
537- ($dest_dsn ? { dbh => $dest_dsn, dsn => $dest_dsn } : ()),
538- { protocol => $o->get('version-check') },
539+ instances => [
540+ { dbh => $dbh, dsn => $source_dsn },
541+ ($dest_dsn ? { dbh => $dest_dsn, dsn => $dest_dsn } : ()),
542+ ],
543+ protocol => $o->get('version-check'),
544 );
545 }
546
547@@ -4563,14 +4590,20 @@
548
549 =item --version-check
550
551-type: string; value_is_optional: yes; default: https
552+type: string; default: off
553
554 Send program versions to Percona and print suggested upgrades and problems.
555-
556-If specified without a value, it will use https by default; However, this
557-might fail if C<IO::Socket::SSL> is not installed on your system, in which
558-case you may choose to use C<--version-check http>, which will forgo
559-encryption but should work out of the box.
560+Possible values for --version-check:
561+
562+=for comment ignore-pt-internal-value
563+MAGIC_version_check
564+
565+https, http, auto, off
566+
567+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
568+Keep in mind that C<https> might not be available if
569+C<IO::Socket::SSL> is not installed on your system, although
570+C<--version-check http> should work everywhere.
571
572 The version check feature causes the tool to send and receive data from
573 Percona over the web. The data contains program versions from the local
574
575=== modified file 'bin/pt-diskstats'
576--- bin/pt-diskstats 2012-10-22 18:17:08 +0000
577+++ bin/pt-diskstats 2012-11-06 15:04:24 +0000
578@@ -85,7 +85,6 @@
579 'default' => 1,
580 'cumulative' => 1,
581 'negatable' => 1,
582- 'value_is_optional' => 1,
583 );
584
585 my $self = {
586@@ -327,10 +326,9 @@
587 $opt->{short} = undef;
588 }
589
590- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
591- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
592- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
593- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
594+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
595+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
596+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
597
598 $opt->{group} ||= 'default';
599 $self->{groups}->{ $opt->{group} }->{$long} = 1;
600@@ -466,7 +464,7 @@
601 if ( $opt->{is_cumulative} ) {
602 $opt->{value}++;
603 }
604- elsif ( !($opt->{optional_value} && !$val) ) {
605+ else {
606 $opt->{value} = $val;
607 }
608 $opt->{got} = 1;
609@@ -1007,12 +1005,11 @@
610 sub _parse_attribs {
611 my ( $self, $option, $attribs ) = @_;
612 my $types = $self->{types};
613- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
614 return $option
615 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
616 . ($attribs->{'negatable'} ? '!' : '' )
617 . ($attribs->{'cumulative'} ? '+' : '' )
618- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
619+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
620 }
621
622 sub _parse_synopsis {
623@@ -4496,14 +4493,19 @@
624 };
625
626 sub version_check {
627- my $args = pop @_;
628- my (@instances) = @_;
629+ my %args = @_;
630+ my @instances = $args{instances} ? @{ $args{instances} } : ();
631
632 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
633- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
634+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
635 "environment variable.\n\n";
636 return;
637 }
638+
639+ $args{protocol} ||= 'https';
640+ my @protocols = $args{protocol} eq 'auto'
641+ ? qw(https http)
642+ : $args{protocol};
643
644 my $instances_to_check = [];
645 my $time = int(time());
646@@ -4518,22 +4520,28 @@
647 ($time_to_check, $instances_to_check)
648 = time_to_check($check_time_file, \@instances, $time);
649 if ( !$time_to_check ) {
650- print STDERR 'It is not time to --version-check again; ',
651+ warn 'It is not time to --version-check again; ',
652 "only 1 check per day.\n\n";
653 return;
654 }
655
656- my $protocol = $args->{protocol} || 'https';
657- my $advice = pingback(
658- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
659- instances => $instances_to_check,
660- protocol => $args->{protocol},
661- );
662+ my $advice;
663+ my $e;
664+ for my $protocol ( @protocols ) {
665+ $advice = eval { pingback(
666+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
667+ instances => $instances_to_check,
668+ protocol => $protocol,
669+ ) };
670+ last if !$advice && !$EVAL_ERROR;
671+ $e ||= $EVAL_ERROR;
672+ }
673 if ( $advice ) {
674 print "# Percona suggests these upgrades:\n";
675 print join("\n", map { "# * $_" } @$advice), "\n\n";
676 }
677 else {
678+ die $e if $e;
679 print "# No suggestions at this time.\n\n";
680 ($ENV{PTVCDEBUG} || PTDEBUG )
681 && _d('--version-check worked, but there were no suggestions');
682@@ -4559,7 +4567,7 @@
683
684 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
685
686- $ua ||= HTTPMicro->new( timeout => 2 );
687+ $ua ||= HTTPMicro->new( timeout => 5 );
688 $vc ||= VersionCheck->new();
689
690 my $response = $ua->request('GET', $url);
691@@ -4775,6 +4783,21 @@
692 return $client_response;
693 }
694
695+sub validate_options {
696+ my ($o) = @_;
697+
698+ return if !$o->got('version-check');
699+
700+ my $value = $o->get('version-check');
701+ my @values = split /, /,
702+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
703+ chomp(@values);
704+
705+ return if grep { $value eq $_ } @values;
706+ $o->save_error("--version-check invalid value $value. Accepted values are "
707+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
708+}
709+
710 sub _d {
711 my ($package, undef, $line) = caller 0;
712 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
713@@ -4828,6 +4851,7 @@
714 if ( !$o->get('columns-regex') ) {
715 $o->save_error("A regex pattern for --column-regex must be specified");
716 }
717+ Pingback::validate_options($o);
718 }
719
720 $o->usage_or_errors();
721@@ -4835,8 +4859,8 @@
722 # ########################################################################
723 # Do the version-check
724 # ########################################################################
725- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
726- Pingback::version_check({ protocol => $o->get('version-check') });
727+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
728+ Pingback::version_check(protocol => $o->get('version-check'));
729 }
730
731 # ########################################################################
732@@ -5427,14 +5451,20 @@
733
734 =item --version-check
735
736-type: string; value_is_optional: yes; default: https
737+type: string; default: off
738
739 Send program versions to Percona and print suggested upgrades and problems.
740-
741-If specified without a value, it will use https by default; However, this
742-might fail if C<IO::Socket::SSL> is not installed on your system, in which
743-case you may choose to use C<--version-check http>, which will forgo
744-encryption but should work out of the box.
745+Possible values for --version-check:
746+
747+=for comment ignore-pt-internal-value
748+MAGIC_version_check
749+
750+https, http, auto, off
751+
752+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
753+Keep in mind that C<https> might not be available if
754+C<IO::Socket::SSL> is not installed on your system, although
755+C<--version-check http> should work everywhere.
756
757 The version check feature causes the tool to send and receive data from
758 Percona over the web. The data contains program versions from the local
759
760=== modified file 'bin/pt-duplicate-key-checker'
761--- bin/pt-duplicate-key-checker 2012-11-05 17:57:11 +0000
762+++ bin/pt-duplicate-key-checker 2012-11-06 15:04:24 +0000
763@@ -992,7 +992,6 @@
764 'default' => 1,
765 'cumulative' => 1,
766 'negatable' => 1,
767- 'value_is_optional' => 1,
768 );
769
770 my $self = {
771@@ -1234,10 +1233,9 @@
772 $opt->{short} = undef;
773 }
774
775- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
776- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
777- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
778- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
779+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
780+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
781+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
782
783 $opt->{group} ||= 'default';
784 $self->{groups}->{ $opt->{group} }->{$long} = 1;
785@@ -1373,7 +1371,7 @@
786 if ( $opt->{is_cumulative} ) {
787 $opt->{value}++;
788 }
789- elsif ( !($opt->{optional_value} && !$val) ) {
790+ else {
791 $opt->{value} = $val;
792 }
793 $opt->{got} = 1;
794@@ -1914,12 +1912,11 @@
795 sub _parse_attribs {
796 my ( $self, $option, $attribs ) = @_;
797 my $types = $self->{types};
798- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
799 return $option
800 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
801 . ($attribs->{'negatable'} ? '!' : '' )
802 . ($attribs->{'cumulative'} ? '+' : '' )
803- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
804+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
805 }
806
807 sub _parse_synopsis {
808@@ -4326,14 +4323,19 @@
809 };
810
811 sub version_check {
812- my $args = pop @_;
813- my (@instances) = @_;
814+ my %args = @_;
815+ my @instances = $args{instances} ? @{ $args{instances} } : ();
816
817 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
818- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
819+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
820 "environment variable.\n\n";
821 return;
822 }
823+
824+ $args{protocol} ||= 'https';
825+ my @protocols = $args{protocol} eq 'auto'
826+ ? qw(https http)
827+ : $args{protocol};
828
829 my $instances_to_check = [];
830 my $time = int(time());
831@@ -4348,22 +4350,28 @@
832 ($time_to_check, $instances_to_check)
833 = time_to_check($check_time_file, \@instances, $time);
834 if ( !$time_to_check ) {
835- print STDERR 'It is not time to --version-check again; ',
836+ warn 'It is not time to --version-check again; ',
837 "only 1 check per day.\n\n";
838 return;
839 }
840
841- my $protocol = $args->{protocol} || 'https';
842- my $advice = pingback(
843- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
844- instances => $instances_to_check,
845- protocol => $args->{protocol},
846- );
847+ my $advice;
848+ my $e;
849+ for my $protocol ( @protocols ) {
850+ $advice = eval { pingback(
851+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
852+ instances => $instances_to_check,
853+ protocol => $protocol,
854+ ) };
855+ last if !$advice && !$EVAL_ERROR;
856+ $e ||= $EVAL_ERROR;
857+ }
858 if ( $advice ) {
859 print "# Percona suggests these upgrades:\n";
860 print join("\n", map { "# * $_" } @$advice), "\n\n";
861 }
862 else {
863+ die $e if $e;
864 print "# No suggestions at this time.\n\n";
865 ($ENV{PTVCDEBUG} || PTDEBUG )
866 && _d('--version-check worked, but there were no suggestions');
867@@ -4389,7 +4397,7 @@
868
869 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
870
871- $ua ||= HTTPMicro->new( timeout => 2 );
872+ $ua ||= HTTPMicro->new( timeout => 5 );
873 $vc ||= VersionCheck->new();
874
875 my $response = $ua->request('GET', $url);
876@@ -4605,6 +4613,21 @@
877 return $client_response;
878 }
879
880+sub validate_options {
881+ my ($o) = @_;
882+
883+ return if !$o->got('version-check');
884+
885+ my $value = $o->get('version-check');
886+ my @values = split /, /,
887+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
888+ chomp(@values);
889+
890+ return if grep { $value eq $_ } @values;
891+ $o->save_error("--version-check invalid value $value. Accepted values are "
892+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
893+}
894+
895 sub _d {
896 my ($package, undef, $line) = caller 0;
897 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
898@@ -4662,7 +4685,8 @@
899
900 my $dp = $o->DSNParser();
901 $dp->prop('set-vars', $o->get('set-vars'));
902-
903+ Pingback::validate_options($o);
904+
905 $o->usage_or_errors();
906
907 # ########################################################################
908@@ -4692,10 +4716,10 @@
909 # ########################################################################
910 # Do the version-check
911 # ########################################################################
912- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
913+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
914 Pingback::version_check(
915- {dbh => $dbh, dsn => $dsn},
916- { protocol => $o->get('version-check') },
917+ instances => [ {dbh => $dbh, dsn => $dsn} ],
918+ protocol => $o->get('version-check'),
919 );
920 }
921
922@@ -5199,14 +5223,20 @@
923
924 =item --version-check
925
926-type: string; value_is_optional: yes; default: https
927+type: string; default: off
928
929 Send program versions to Percona and print suggested upgrades and problems.
930-
931-If specified without a value, it will use https by default; However, this
932-might fail if C<IO::Socket::SSL> is not installed on your system, in which
933-case you may choose to use C<--version-check http>, which will forgo
934-encryption but should work out of the box.
935+Possible values for --version-check:
936+
937+=for comment ignore-pt-internal-value
938+MAGIC_version_check
939+
940+https, http, auto, off
941+
942+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
943+Keep in mind that C<https> might not be available if
944+C<IO::Socket::SSL> is not installed on your system, although
945+C<--version-check http> should work everywhere.
946
947 The version check feature causes the tool to send and receive data from
948 Percona over the web. The data contains program versions from the local
949
950=== modified file 'bin/pt-fifo-split'
951--- bin/pt-fifo-split 2012-10-31 01:14:11 +0000
952+++ bin/pt-fifo-split 2012-11-06 15:04:24 +0000
953@@ -57,7 +57,6 @@
954 'default' => 1,
955 'cumulative' => 1,
956 'negatable' => 1,
957- 'value_is_optional' => 1,
958 );
959
960 my $self = {
961@@ -299,10 +298,9 @@
962 $opt->{short} = undef;
963 }
964
965- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
966- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
967- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
968- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
969+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
970+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
971+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
972
973 $opt->{group} ||= 'default';
974 $self->{groups}->{ $opt->{group} }->{$long} = 1;
975@@ -438,7 +436,7 @@
976 if ( $opt->{is_cumulative} ) {
977 $opt->{value}++;
978 }
979- elsif ( !($opt->{optional_value} && !$val) ) {
980+ else {
981 $opt->{value} = $val;
982 }
983 $opt->{got} = 1;
984@@ -979,12 +977,11 @@
985 sub _parse_attribs {
986 my ( $self, $option, $attribs ) = @_;
987 my $types = $self->{types};
988- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
989 return $option
990 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
991 . ($attribs->{'negatable'} ? '!' : '' )
992 . ($attribs->{'cumulative'} ? '+' : '' )
993- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
994+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
995 }
996
997 sub _parse_synopsis {
998
999=== modified file 'bin/pt-find'
1000--- bin/pt-find 2012-11-05 17:57:11 +0000
1001+++ bin/pt-find 2012-11-06 15:04:24 +0000
1002@@ -459,7 +459,6 @@
1003 'default' => 1,
1004 'cumulative' => 1,
1005 'negatable' => 1,
1006- 'value_is_optional' => 1,
1007 );
1008
1009 my $self = {
1010@@ -701,10 +700,9 @@
1011 $opt->{short} = undef;
1012 }
1013
1014- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
1015- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
1016- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
1017- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
1018+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
1019+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
1020+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
1021
1022 $opt->{group} ||= 'default';
1023 $self->{groups}->{ $opt->{group} }->{$long} = 1;
1024@@ -840,7 +838,7 @@
1025 if ( $opt->{is_cumulative} ) {
1026 $opt->{value}++;
1027 }
1028- elsif ( !($opt->{optional_value} && !$val) ) {
1029+ else {
1030 $opt->{value} = $val;
1031 }
1032 $opt->{got} = 1;
1033@@ -1381,12 +1379,11 @@
1034 sub _parse_attribs {
1035 my ( $self, $option, $attribs ) = @_;
1036 my $types = $self->{types};
1037- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
1038 return $option
1039 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
1040 . ($attribs->{'negatable'} ? '!' : '' )
1041 . ($attribs->{'cumulative'} ? '+' : '' )
1042- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
1043+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
1044 }
1045
1046 sub _parse_synopsis {
1047@@ -3166,14 +3163,19 @@
1048 };
1049
1050 sub version_check {
1051- my $args = pop @_;
1052- my (@instances) = @_;
1053+ my %args = @_;
1054+ my @instances = $args{instances} ? @{ $args{instances} } : ();
1055
1056 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
1057- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
1058+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
1059 "environment variable.\n\n";
1060 return;
1061 }
1062+
1063+ $args{protocol} ||= 'https';
1064+ my @protocols = $args{protocol} eq 'auto'
1065+ ? qw(https http)
1066+ : $args{protocol};
1067
1068 my $instances_to_check = [];
1069 my $time = int(time());
1070@@ -3188,22 +3190,28 @@
1071 ($time_to_check, $instances_to_check)
1072 = time_to_check($check_time_file, \@instances, $time);
1073 if ( !$time_to_check ) {
1074- print STDERR 'It is not time to --version-check again; ',
1075+ warn 'It is not time to --version-check again; ',
1076 "only 1 check per day.\n\n";
1077 return;
1078 }
1079
1080- my $protocol = $args->{protocol} || 'https';
1081- my $advice = pingback(
1082- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
1083- instances => $instances_to_check,
1084- protocol => $args->{protocol},
1085- );
1086+ my $advice;
1087+ my $e;
1088+ for my $protocol ( @protocols ) {
1089+ $advice = eval { pingback(
1090+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
1091+ instances => $instances_to_check,
1092+ protocol => $protocol,
1093+ ) };
1094+ last if !$advice && !$EVAL_ERROR;
1095+ $e ||= $EVAL_ERROR;
1096+ }
1097 if ( $advice ) {
1098 print "# Percona suggests these upgrades:\n";
1099 print join("\n", map { "# * $_" } @$advice), "\n\n";
1100 }
1101 else {
1102+ die $e if $e;
1103 print "# No suggestions at this time.\n\n";
1104 ($ENV{PTVCDEBUG} || PTDEBUG )
1105 && _d('--version-check worked, but there were no suggestions');
1106@@ -3229,7 +3237,7 @@
1107
1108 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
1109
1110- $ua ||= HTTPMicro->new( timeout => 2 );
1111+ $ua ||= HTTPMicro->new( timeout => 5 );
1112 $vc ||= VersionCheck->new();
1113
1114 my $response = $ua->request('GET', $url);
1115@@ -3445,6 +3453,21 @@
1116 return $client_response;
1117 }
1118
1119+sub validate_options {
1120+ my ($o) = @_;
1121+
1122+ return if !$o->got('version-check');
1123+
1124+ my $value = $o->get('version-check');
1125+ my @values = split /, /,
1126+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
1127+ chomp(@values);
1128+
1129+ return if grep { $value eq $_ } @values;
1130+ $o->save_error("--version-check invalid value $value. Accepted values are "
1131+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
1132+}
1133+
1134 sub _d {
1135 my ($package, undef, $line) = caller 0;
1136 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
1137@@ -3761,6 +3784,8 @@
1138 $o->save_error("--server-id regex doesn't capture digits with (\\d+)");
1139 }
1140
1141+ Pingback::validate_options($o);
1142+
1143 $o->usage_or_errors();
1144
1145 # Interpolate strings for printf and exec. At the same time discover whether
1146@@ -3860,10 +3885,10 @@
1147 # ########################################################################
1148 # Do the version-check
1149 # ########################################################################
1150- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
1151+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
1152 Pingback::version_check(
1153- {dbh => $dbh, dsn => $dsn},
1154- {protocol => $o->get('version-check')},
1155+ instances => [{dbh => $dbh, dsn => $dsn}],
1156+ protocol => $o->get('version-check'),
1157 );
1158 }
1159
1160@@ -4316,14 +4341,20 @@
1161
1162 =item --version-check
1163
1164-type: string; value_is_optional: yes; default: https
1165+type: string; default: off
1166
1167 Send program versions to Percona and print suggested upgrades and problems.
1168-
1169-If specified without a value, it will use https by default; However, this
1170-might fail if C<IO::Socket::SSL> is not installed on your system, in which
1171-case you may choose to use C<--version-check http>, which will forgo
1172-encryption but should work out of the box.
1173+Possible values for --version-check:
1174+
1175+=for comment ignore-pt-internal-value
1176+MAGIC_version_check
1177+
1178+https, http, auto, off
1179+
1180+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
1181+Keep in mind that C<https> might not be available if
1182+C<IO::Socket::SSL> is not installed on your system, although
1183+C<--version-check http> should work everywhere.
1184
1185 The version check feature causes the tool to send and receive data from
1186 Percona over the web. The data contains program versions from the local
1187
1188=== modified file 'bin/pt-fingerprint'
1189--- bin/pt-fingerprint 2012-10-22 18:17:08 +0000
1190+++ bin/pt-fingerprint 2012-11-06 15:04:24 +0000
1191@@ -58,7 +58,6 @@
1192 'default' => 1,
1193 'cumulative' => 1,
1194 'negatable' => 1,
1195- 'value_is_optional' => 1,
1196 );
1197
1198 my $self = {
1199@@ -300,10 +299,9 @@
1200 $opt->{short} = undef;
1201 }
1202
1203- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
1204- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
1205- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
1206- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
1207+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
1208+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
1209+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
1210
1211 $opt->{group} ||= 'default';
1212 $self->{groups}->{ $opt->{group} }->{$long} = 1;
1213@@ -439,7 +437,7 @@
1214 if ( $opt->{is_cumulative} ) {
1215 $opt->{value}++;
1216 }
1217- elsif ( !($opt->{optional_value} && !$val) ) {
1218+ else {
1219 $opt->{value} = $val;
1220 }
1221 $opt->{got} = 1;
1222@@ -980,12 +978,11 @@
1223 sub _parse_attribs {
1224 my ( $self, $option, $attribs ) = @_;
1225 my $types = $self->{types};
1226- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
1227 return $option
1228 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
1229 . ($attribs->{'negatable'} ? '!' : '' )
1230 . ($attribs->{'cumulative'} ? '+' : '' )
1231- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
1232+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
1233 }
1234
1235 sub _parse_synopsis {
1236
1237=== modified file 'bin/pt-fk-error-logger'
1238--- bin/pt-fk-error-logger 2012-10-31 09:18:34 +0000
1239+++ bin/pt-fk-error-logger 2012-11-06 15:04:24 +0000
1240@@ -82,7 +82,6 @@
1241 'default' => 1,
1242 'cumulative' => 1,
1243 'negatable' => 1,
1244- 'value_is_optional' => 1,
1245 );
1246
1247 my $self = {
1248@@ -324,10 +323,9 @@
1249 $opt->{short} = undef;
1250 }
1251
1252- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
1253- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
1254- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
1255- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
1256+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
1257+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
1258+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
1259
1260 $opt->{group} ||= 'default';
1261 $self->{groups}->{ $opt->{group} }->{$long} = 1;
1262@@ -463,7 +461,7 @@
1263 if ( $opt->{is_cumulative} ) {
1264 $opt->{value}++;
1265 }
1266- elsif ( !($opt->{optional_value} && !$val) ) {
1267+ else {
1268 $opt->{value} = $val;
1269 }
1270 $opt->{got} = 1;
1271@@ -1004,12 +1002,11 @@
1272 sub _parse_attribs {
1273 my ( $self, $option, $attribs ) = @_;
1274 my $types = $self->{types};
1275- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
1276 return $option
1277 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
1278 . ($attribs->{'negatable'} ? '!' : '' )
1279 . ($attribs->{'cumulative'} ? '+' : '' )
1280- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
1281+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
1282 }
1283
1284 sub _parse_synopsis {
1285@@ -3105,14 +3102,19 @@
1286 };
1287
1288 sub version_check {
1289- my $args = pop @_;
1290- my (@instances) = @_;
1291+ my %args = @_;
1292+ my @instances = $args{instances} ? @{ $args{instances} } : ();
1293
1294 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
1295- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
1296+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
1297 "environment variable.\n\n";
1298 return;
1299 }
1300+
1301+ $args{protocol} ||= 'https';
1302+ my @protocols = $args{protocol} eq 'auto'
1303+ ? qw(https http)
1304+ : $args{protocol};
1305
1306 my $instances_to_check = [];
1307 my $time = int(time());
1308@@ -3127,22 +3129,28 @@
1309 ($time_to_check, $instances_to_check)
1310 = time_to_check($check_time_file, \@instances, $time);
1311 if ( !$time_to_check ) {
1312- print STDERR 'It is not time to --version-check again; ',
1313+ warn 'It is not time to --version-check again; ',
1314 "only 1 check per day.\n\n";
1315 return;
1316 }
1317
1318- my $protocol = $args->{protocol} || 'https';
1319- my $advice = pingback(
1320- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
1321- instances => $instances_to_check,
1322- protocol => $args->{protocol},
1323- );
1324+ my $advice;
1325+ my $e;
1326+ for my $protocol ( @protocols ) {
1327+ $advice = eval { pingback(
1328+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
1329+ instances => $instances_to_check,
1330+ protocol => $protocol,
1331+ ) };
1332+ last if !$advice && !$EVAL_ERROR;
1333+ $e ||= $EVAL_ERROR;
1334+ }
1335 if ( $advice ) {
1336 print "# Percona suggests these upgrades:\n";
1337 print join("\n", map { "# * $_" } @$advice), "\n\n";
1338 }
1339 else {
1340+ die $e if $e;
1341 print "# No suggestions at this time.\n\n";
1342 ($ENV{PTVCDEBUG} || PTDEBUG )
1343 && _d('--version-check worked, but there were no suggestions');
1344@@ -3168,7 +3176,7 @@
1345
1346 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
1347
1348- $ua ||= HTTPMicro->new( timeout => 2 );
1349+ $ua ||= HTTPMicro->new( timeout => 5 );
1350 $vc ||= VersionCheck->new();
1351
1352 my $response = $ua->request('GET', $url);
1353@@ -3384,6 +3392,21 @@
1354 return $client_response;
1355 }
1356
1357+sub validate_options {
1358+ my ($o) = @_;
1359+
1360+ return if !$o->got('version-check');
1361+
1362+ my $value = $o->get('version-check');
1363+ my @values = split /, /,
1364+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
1365+ chomp(@values);
1366+
1367+ return if grep { $value eq $_ } @values;
1368+ $o->save_error("--version-check invalid value $value. Accepted values are "
1369+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
1370+}
1371+
1372 sub _d {
1373 my ($package, undef, $line) = caller 0;
1374 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
1375@@ -3456,6 +3479,8 @@
1376 if ( $dst_dsn && !$dst_dsn->{t} ) {
1377 $o->save_error("--dest requires a 't' (table) part");
1378 }
1379+
1380+ Pingback::validate_options($o);
1381 }
1382
1383 $o->usage_or_errors();
1384@@ -3516,11 +3541,13 @@
1385 # ########################################################################
1386 # Do the version-check
1387 # ########################################################################
1388- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
1389+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
1390 Pingback::version_check(
1391- { dbh => $dbh, dsn => $src_dsn },
1392- ($dst_dbh ? { dbh => $dst_dbh, dsn => $dst_dsn } : ()),
1393- { protocol => $o->get('version-check') },
1394+ instances => [
1395+ { dbh => $dbh, dsn => $src_dsn },
1396+ ($dst_dbh ? { dbh => $dst_dbh, dsn => $dst_dsn } : ())
1397+ ],
1398+ protocol => $o->get('version-check'),
1399 );
1400 }
1401
1402@@ -3810,14 +3837,20 @@
1403
1404 =item --version-check
1405
1406-type: string; value_is_optional: yes; default: https
1407+type: string; default: off
1408
1409 Send program versions to Percona and print suggested upgrades and problems.
1410-
1411-If specified without a value, it will use https by default; However, this
1412-might fail if C<IO::Socket::SSL> is not installed on your system, in which
1413-case you may choose to use C<--version-check http>, which will forgo
1414-encryption but should work out of the box.
1415+Possible values for --version-check:
1416+
1417+=for comment ignore-pt-internal-value
1418+MAGIC_version_check
1419+
1420+https, http, auto, off
1421+
1422+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
1423+Keep in mind that C<https> might not be available if
1424+C<IO::Socket::SSL> is not installed on your system, although
1425+C<--version-check http> should work everywhere.
1426
1427 The version check feature causes the tool to send and receive data from
1428 Percona over the web. The data contains program versions from the local
1429
1430=== modified file 'bin/pt-heartbeat'
1431--- bin/pt-heartbeat 2012-11-05 17:57:11 +0000
1432+++ bin/pt-heartbeat 2012-11-06 15:04:24 +0000
1433@@ -818,7 +818,6 @@
1434 'default' => 1,
1435 'cumulative' => 1,
1436 'negatable' => 1,
1437- 'value_is_optional' => 1,
1438 );
1439
1440 my $self = {
1441@@ -1060,10 +1059,9 @@
1442 $opt->{short} = undef;
1443 }
1444
1445- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
1446- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
1447- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
1448- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
1449+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
1450+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
1451+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
1452
1453 $opt->{group} ||= 'default';
1454 $self->{groups}->{ $opt->{group} }->{$long} = 1;
1455@@ -1199,7 +1197,7 @@
1456 if ( $opt->{is_cumulative} ) {
1457 $opt->{value}++;
1458 }
1459- elsif ( !($opt->{optional_value} && !$val) ) {
1460+ else {
1461 $opt->{value} = $val;
1462 }
1463 $opt->{got} = 1;
1464@@ -1740,12 +1738,11 @@
1465 sub _parse_attribs {
1466 my ( $self, $option, $attribs ) = @_;
1467 my $types = $self->{types};
1468- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
1469 return $option
1470 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
1471 . ($attribs->{'negatable'} ? '!' : '' )
1472 . ($attribs->{'cumulative'} ? '+' : '' )
1473- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
1474+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
1475 }
1476
1477 sub _parse_synopsis {
1478@@ -4250,14 +4247,19 @@
1479 };
1480
1481 sub version_check {
1482- my $args = pop @_;
1483- my (@instances) = @_;
1484+ my %args = @_;
1485+ my @instances = $args{instances} ? @{ $args{instances} } : ();
1486
1487 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
1488- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
1489+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
1490 "environment variable.\n\n";
1491 return;
1492 }
1493+
1494+ $args{protocol} ||= 'https';
1495+ my @protocols = $args{protocol} eq 'auto'
1496+ ? qw(https http)
1497+ : $args{protocol};
1498
1499 my $instances_to_check = [];
1500 my $time = int(time());
1501@@ -4272,22 +4274,28 @@
1502 ($time_to_check, $instances_to_check)
1503 = time_to_check($check_time_file, \@instances, $time);
1504 if ( !$time_to_check ) {
1505- print STDERR 'It is not time to --version-check again; ',
1506+ warn 'It is not time to --version-check again; ',
1507 "only 1 check per day.\n\n";
1508 return;
1509 }
1510
1511- my $protocol = $args->{protocol} || 'https';
1512- my $advice = pingback(
1513- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
1514- instances => $instances_to_check,
1515- protocol => $args->{protocol},
1516- );
1517+ my $advice;
1518+ my $e;
1519+ for my $protocol ( @protocols ) {
1520+ $advice = eval { pingback(
1521+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
1522+ instances => $instances_to_check,
1523+ protocol => $protocol,
1524+ ) };
1525+ last if !$advice && !$EVAL_ERROR;
1526+ $e ||= $EVAL_ERROR;
1527+ }
1528 if ( $advice ) {
1529 print "# Percona suggests these upgrades:\n";
1530 print join("\n", map { "# * $_" } @$advice), "\n\n";
1531 }
1532 else {
1533+ die $e if $e;
1534 print "# No suggestions at this time.\n\n";
1535 ($ENV{PTVCDEBUG} || PTDEBUG )
1536 && _d('--version-check worked, but there were no suggestions');
1537@@ -4313,7 +4321,7 @@
1538
1539 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
1540
1541- $ua ||= HTTPMicro->new( timeout => 2 );
1542+ $ua ||= HTTPMicro->new( timeout => 5 );
1543 $vc ||= VersionCheck->new();
1544
1545 my $response = $ua->request('GET', $url);
1546@@ -4529,6 +4537,21 @@
1547 return $client_response;
1548 }
1549
1550+sub validate_options {
1551+ my ($o) = @_;
1552+
1553+ return if !$o->got('version-check');
1554+
1555+ my $value = $o->get('version-check');
1556+ my @values = split /, /,
1557+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
1558+ chomp(@values);
1559+
1560+ return if grep { $value eq $_ } @values;
1561+ $o->save_error("--version-check invalid value $value. Accepted values are "
1562+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
1563+}
1564+
1565 sub _d {
1566 my ($package, undef, $line) = caller 0;
1567 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
1568@@ -4630,6 +4653,8 @@
1569 $o->save_error("Invalid --recursion-method: $EVAL_ERROR")
1570 }
1571
1572+ Pingback::validate_options($o);
1573+
1574 $o->usage_or_errors();
1575
1576 # ########################################################################
1577@@ -4980,8 +5005,11 @@
1578 # ########################################################################
1579 # Do the version-check
1580 # ########################################################################
1581- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
1582- Pingback::version_check({dbh => $dbh, dsn => $dsn}, { protocol => $o->get('version-check') });
1583+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
1584+ Pingback::version_check(
1585+ instances => [ {dbh => $dbh, dsn => $dsn} ],
1586+ protocol => $o->get('version-check'),
1587+ );
1588 }
1589
1590 # ########################################################################
1591@@ -5713,14 +5741,20 @@
1592
1593 =item --version-check
1594
1595-type: string; value_is_optional: yes; default: https
1596+type: string; default: off
1597
1598 Send program versions to Percona and print suggested upgrades and problems.
1599-
1600-If specified without a value, it will use https by default; However, this
1601-might fail if C<IO::Socket::SSL> is not installed on your system, in which
1602-case you may choose to use C<--version-check http>, which will forgo
1603-encryption but should work out of the box.
1604+Possible values for --version-check:
1605+
1606+=for comment ignore-pt-internal-value
1607+MAGIC_version_check
1608+
1609+https, http, auto, off
1610+
1611+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
1612+Keep in mind that C<https> might not be available if
1613+C<IO::Socket::SSL> is not installed on your system, although
1614+C<--version-check http> should work everywhere.
1615
1616 The version check feature causes the tool to send and receive data from
1617 Percona over the web. The data contains program versions from the local
1618
1619=== modified file 'bin/pt-index-usage'
1620--- bin/pt-index-usage 2012-11-05 17:57:11 +0000
1621+++ bin/pt-index-usage 2012-11-06 15:04:24 +0000
1622@@ -589,7 +589,6 @@
1623 'default' => 1,
1624 'cumulative' => 1,
1625 'negatable' => 1,
1626- 'value_is_optional' => 1,
1627 );
1628
1629 my $self = {
1630@@ -831,10 +830,9 @@
1631 $opt->{short} = undef;
1632 }
1633
1634- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
1635- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
1636- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
1637- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
1638+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
1639+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
1640+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
1641
1642 $opt->{group} ||= 'default';
1643 $self->{groups}->{ $opt->{group} }->{$long} = 1;
1644@@ -970,7 +968,7 @@
1645 if ( $opt->{is_cumulative} ) {
1646 $opt->{value}++;
1647 }
1648- elsif ( !($opt->{optional_value} && !$val) ) {
1649+ else {
1650 $opt->{value} = $val;
1651 }
1652 $opt->{got} = 1;
1653@@ -1511,12 +1509,11 @@
1654 sub _parse_attribs {
1655 my ( $self, $option, $attribs ) = @_;
1656 my $types = $self->{types};
1657- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
1658 return $option
1659 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
1660 . ($attribs->{'negatable'} ? '!' : '' )
1661 . ($attribs->{'cumulative'} ? '+' : '' )
1662- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
1663+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
1664 }
1665
1666 sub _parse_synopsis {
1667@@ -5820,14 +5817,19 @@
1668 };
1669
1670 sub version_check {
1671- my $args = pop @_;
1672- my (@instances) = @_;
1673+ my %args = @_;
1674+ my @instances = $args{instances} ? @{ $args{instances} } : ();
1675
1676 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
1677- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
1678+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
1679 "environment variable.\n\n";
1680 return;
1681 }
1682+
1683+ $args{protocol} ||= 'https';
1684+ my @protocols = $args{protocol} eq 'auto'
1685+ ? qw(https http)
1686+ : $args{protocol};
1687
1688 my $instances_to_check = [];
1689 my $time = int(time());
1690@@ -5842,22 +5844,28 @@
1691 ($time_to_check, $instances_to_check)
1692 = time_to_check($check_time_file, \@instances, $time);
1693 if ( !$time_to_check ) {
1694- print STDERR 'It is not time to --version-check again; ',
1695+ warn 'It is not time to --version-check again; ',
1696 "only 1 check per day.\n\n";
1697 return;
1698 }
1699
1700- my $protocol = $args->{protocol} || 'https';
1701- my $advice = pingback(
1702- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
1703- instances => $instances_to_check,
1704- protocol => $args->{protocol},
1705- );
1706+ my $advice;
1707+ my $e;
1708+ for my $protocol ( @protocols ) {
1709+ $advice = eval { pingback(
1710+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
1711+ instances => $instances_to_check,
1712+ protocol => $protocol,
1713+ ) };
1714+ last if !$advice && !$EVAL_ERROR;
1715+ $e ||= $EVAL_ERROR;
1716+ }
1717 if ( $advice ) {
1718 print "# Percona suggests these upgrades:\n";
1719 print join("\n", map { "# * $_" } @$advice), "\n\n";
1720 }
1721 else {
1722+ die $e if $e;
1723 print "# No suggestions at this time.\n\n";
1724 ($ENV{PTVCDEBUG} || PTDEBUG )
1725 && _d('--version-check worked, but there were no suggestions');
1726@@ -5883,7 +5891,7 @@
1727
1728 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
1729
1730- $ua ||= HTTPMicro->new( timeout => 2 );
1731+ $ua ||= HTTPMicro->new( timeout => 5 );
1732 $vc ||= VersionCheck->new();
1733
1734 my $response = $ua->request('GET', $url);
1735@@ -6099,6 +6107,21 @@
1736 return $client_response;
1737 }
1738
1739+sub validate_options {
1740+ my ($o) = @_;
1741+
1742+ return if !$o->got('version-check');
1743+
1744+ my $value = $o->get('version-check');
1745+ my @values = split /, /,
1746+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
1747+ chomp(@values);
1748+
1749+ return if grep { $value eq $_ } @values;
1750+ $o->save_error("--version-check invalid value $value. Accepted values are "
1751+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
1752+}
1753+
1754 sub _d {
1755 my ($package, undef, $line) = caller 0;
1756 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
1757@@ -6168,6 +6191,8 @@
1758 . "--save-results-database DSN");
1759 }
1760 }
1761+
1762+ Pingback::validate_options($o);
1763 }
1764
1765 $o->usage_or_errors();
1766@@ -6311,11 +6336,13 @@
1767 # ########################################################################
1768 # Do the version-check
1769 # ########################################################################
1770- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
1771+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
1772 Pingback::version_check(
1773- { dbh => $dbh, dsn => $dsn },
1774- ($res_dbh ? { dbh => $res_dbh, dsn => $res_dsn } : ()),
1775- { protocol => $o->get('version-check') },
1776+ instances => [
1777+ { dbh => $dbh, dsn => $dsn },
1778+ ($res_dbh ? { dbh => $res_dbh, dsn => $res_dsn } : ())
1779+ ],
1780+ protocol => $o->get('version-check'),
1781 );
1782 }
1783
1784@@ -7230,14 +7257,20 @@
1785
1786 =item --version-check
1787
1788-type: string; value_is_optional: yes; default: https
1789+type: string; default: off
1790
1791 Send program versions to Percona and print suggested upgrades and problems.
1792-
1793-If specified without a value, it will use https by default; However, this
1794-might fail if C<IO::Socket::SSL> is not installed on your system, in which
1795-case you may choose to use C<--version-check http>, which will forgo
1796-encryption but should work out of the box.
1797+Possible values for --version-check:
1798+
1799+=for comment ignore-pt-internal-value
1800+MAGIC_version_check
1801+
1802+https, http, auto, off
1803+
1804+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
1805+Keep in mind that C<https> might not be available if
1806+C<IO::Socket::SSL> is not installed on your system, although
1807+C<--version-check http> should work everywhere.
1808
1809 The version check feature causes the tool to send and receive data from
1810 Percona over the web. The data contains program versions from the local
1811
1812=== modified file 'bin/pt-kill'
1813--- bin/pt-kill 2012-11-05 17:57:11 +0000
1814+++ bin/pt-kill 2012-11-06 15:04:24 +0000
1815@@ -90,7 +90,6 @@
1816 'default' => 1,
1817 'cumulative' => 1,
1818 'negatable' => 1,
1819- 'value_is_optional' => 1,
1820 );
1821
1822 my $self = {
1823@@ -332,10 +331,9 @@
1824 $opt->{short} = undef;
1825 }
1826
1827- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
1828- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
1829- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
1830- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
1831+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
1832+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
1833+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
1834
1835 $opt->{group} ||= 'default';
1836 $self->{groups}->{ $opt->{group} }->{$long} = 1;
1837@@ -471,7 +469,7 @@
1838 if ( $opt->{is_cumulative} ) {
1839 $opt->{value}++;
1840 }
1841- elsif ( !($opt->{optional_value} && !$val) ) {
1842+ else {
1843 $opt->{value} = $val;
1844 }
1845 $opt->{got} = 1;
1846@@ -1012,12 +1010,11 @@
1847 sub _parse_attribs {
1848 my ( $self, $option, $attribs ) = @_;
1849 my $types = $self->{types};
1850- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
1851 return $option
1852 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
1853 . ($attribs->{'negatable'} ? '!' : '' )
1854 . ($attribs->{'cumulative'} ? '+' : '' )
1855- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
1856+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
1857 }
1858
1859 sub _parse_synopsis {
1860@@ -5843,14 +5840,19 @@
1861 };
1862
1863 sub version_check {
1864- my $args = pop @_;
1865- my (@instances) = @_;
1866+ my %args = @_;
1867+ my @instances = $args{instances} ? @{ $args{instances} } : ();
1868
1869 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
1870- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
1871+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
1872 "environment variable.\n\n";
1873 return;
1874 }
1875+
1876+ $args{protocol} ||= 'https';
1877+ my @protocols = $args{protocol} eq 'auto'
1878+ ? qw(https http)
1879+ : $args{protocol};
1880
1881 my $instances_to_check = [];
1882 my $time = int(time());
1883@@ -5865,22 +5867,28 @@
1884 ($time_to_check, $instances_to_check)
1885 = time_to_check($check_time_file, \@instances, $time);
1886 if ( !$time_to_check ) {
1887- print STDERR 'It is not time to --version-check again; ',
1888+ warn 'It is not time to --version-check again; ',
1889 "only 1 check per day.\n\n";
1890 return;
1891 }
1892
1893- my $protocol = $args->{protocol} || 'https';
1894- my $advice = pingback(
1895- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
1896- instances => $instances_to_check,
1897- protocol => $args->{protocol},
1898- );
1899+ my $advice;
1900+ my $e;
1901+ for my $protocol ( @protocols ) {
1902+ $advice = eval { pingback(
1903+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
1904+ instances => $instances_to_check,
1905+ protocol => $protocol,
1906+ ) };
1907+ last if !$advice && !$EVAL_ERROR;
1908+ $e ||= $EVAL_ERROR;
1909+ }
1910 if ( $advice ) {
1911 print "# Percona suggests these upgrades:\n";
1912 print join("\n", map { "# * $_" } @$advice), "\n\n";
1913 }
1914 else {
1915+ die $e if $e;
1916 print "# No suggestions at this time.\n\n";
1917 ($ENV{PTVCDEBUG} || PTDEBUG )
1918 && _d('--version-check worked, but there were no suggestions');
1919@@ -5906,7 +5914,7 @@
1920
1921 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
1922
1923- $ua ||= HTTPMicro->new( timeout => 2 );
1924+ $ua ||= HTTPMicro->new( timeout => 5 );
1925 $vc ||= VersionCheck->new();
1926
1927 my $response = $ua->request('GET', $url);
1928@@ -6122,6 +6130,21 @@
1929 return $client_response;
1930 }
1931
1932+sub validate_options {
1933+ my ($o) = @_;
1934+
1935+ return if !$o->got('version-check');
1936+
1937+ my $value = $o->get('version-check');
1938+ my @values = split /, /,
1939+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
1940+ chomp(@values);
1941+
1942+ return if grep { $value eq $_ } @values;
1943+ $o->save_error("--version-check invalid value $value. Accepted values are "
1944+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
1945+}
1946+
1947 sub _d {
1948 my ($package, undef, $line) = caller 0;
1949 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
1950@@ -6205,6 +6228,8 @@
1951 $o->save_error("Invalid value for --victims: $victims");
1952 }
1953
1954+ Pingback::validate_options($o);
1955+
1956 $o->usage_or_errors();
1957
1958 # ########################################################################
1959@@ -6485,10 +6510,10 @@
1960 # ########################################################################
1961 # Do the version-check
1962 # ########################################################################
1963- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
1964+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
1965 Pingback::version_check(
1966- ($dbh ? { dbh => $dbh, dsn => $cxn->dsn() } : ()),
1967- { protocol => $o->get('version-check') },
1968+ instances => [ ($dbh ? { dbh => $dbh, dsn => $cxn->dsn() } : ()) ],
1969+ protocol => $o->get('version-check'),
1970 );
1971 }
1972
1973@@ -7219,14 +7244,20 @@
1974
1975 =item --version-check
1976
1977-type: string; value_is_optional: yes; default: https
1978+type: string; default: off
1979
1980 Send program versions to Percona and print suggested upgrades and problems.
1981-
1982-If specified without a value, it will use https by default; However, this
1983-might fail if C<IO::Socket::SSL> is not installed on your system, in which
1984-case you may choose to use C<--version-check http>, which will forgo
1985-encryption but should work out of the box.
1986+Possible values for --version-check:
1987+
1988+=for comment ignore-pt-internal-value
1989+MAGIC_version_check
1990+
1991+https, http, auto, off
1992+
1993+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
1994+Keep in mind that C<https> might not be available if
1995+C<IO::Socket::SSL> is not installed on your system, although
1996+C<--version-check http> should work everywhere.
1997
1998 The version check feature causes the tool to send and receive data from
1999 Percona over the web. The data contains program versions from the local
2000
2001=== modified file 'bin/pt-log-player'
2002--- bin/pt-log-player 2012-10-31 09:18:34 +0000
2003+++ bin/pt-log-player 2012-11-06 15:04:24 +0000
2004@@ -62,7 +62,6 @@
2005 'default' => 1,
2006 'cumulative' => 1,
2007 'negatable' => 1,
2008- 'value_is_optional' => 1,
2009 );
2010
2011 my $self = {
2012@@ -304,10 +303,9 @@
2013 $opt->{short} = undef;
2014 }
2015
2016- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
2017- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
2018- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
2019- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
2020+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
2021+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
2022+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
2023
2024 $opt->{group} ||= 'default';
2025 $self->{groups}->{ $opt->{group} }->{$long} = 1;
2026@@ -443,7 +441,7 @@
2027 if ( $opt->{is_cumulative} ) {
2028 $opt->{value}++;
2029 }
2030- elsif ( !($opt->{optional_value} && !$val) ) {
2031+ else {
2032 $opt->{value} = $val;
2033 }
2034 $opt->{got} = 1;
2035@@ -984,12 +982,11 @@
2036 sub _parse_attribs {
2037 my ( $self, $option, $attribs ) = @_;
2038 my $types = $self->{types};
2039- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
2040 return $option
2041 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
2042 . ($attribs->{'negatable'} ? '!' : '' )
2043 . ($attribs->{'cumulative'} ? '+' : '' )
2044- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
2045+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
2046 }
2047
2048 sub _parse_synopsis {
2049
2050=== modified file 'bin/pt-online-schema-change'
2051--- bin/pt-online-schema-change 2012-11-05 17:57:11 +0000
2052+++ bin/pt-online-schema-change 2012-11-06 15:04:24 +0000
2053@@ -96,7 +96,6 @@
2054 'default' => 1,
2055 'cumulative' => 1,
2056 'negatable' => 1,
2057- 'value_is_optional' => 1,
2058 );
2059
2060 my $self = {
2061@@ -338,10 +337,9 @@
2062 $opt->{short} = undef;
2063 }
2064
2065- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
2066- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
2067- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
2068- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
2069+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
2070+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
2071+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
2072
2073 $opt->{group} ||= 'default';
2074 $self->{groups}->{ $opt->{group} }->{$long} = 1;
2075@@ -477,7 +475,7 @@
2076 if ( $opt->{is_cumulative} ) {
2077 $opt->{value}++;
2078 }
2079- elsif ( !($opt->{optional_value} && !$val) ) {
2080+ else {
2081 $opt->{value} = $val;
2082 }
2083 $opt->{got} = 1;
2084@@ -1018,12 +1016,11 @@
2085 sub _parse_attribs {
2086 my ( $self, $option, $attribs ) = @_;
2087 my $types = $self->{types};
2088- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
2089 return $option
2090 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
2091 . ($attribs->{'negatable'} ? '!' : '' )
2092 . ($attribs->{'cumulative'} ? '+' : '' )
2093- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
2094+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
2095 }
2096
2097 sub _parse_synopsis {
2098@@ -6865,14 +6862,19 @@
2099 };
2100
2101 sub version_check {
2102- my $args = pop @_;
2103- my (@instances) = @_;
2104+ my %args = @_;
2105+ my @instances = $args{instances} ? @{ $args{instances} } : ();
2106
2107 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
2108- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
2109+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
2110 "environment variable.\n\n";
2111 return;
2112 }
2113+
2114+ $args{protocol} ||= 'https';
2115+ my @protocols = $args{protocol} eq 'auto'
2116+ ? qw(https http)
2117+ : $args{protocol};
2118
2119 my $instances_to_check = [];
2120 my $time = int(time());
2121@@ -6887,22 +6889,28 @@
2122 ($time_to_check, $instances_to_check)
2123 = time_to_check($check_time_file, \@instances, $time);
2124 if ( !$time_to_check ) {
2125- print STDERR 'It is not time to --version-check again; ',
2126+ warn 'It is not time to --version-check again; ',
2127 "only 1 check per day.\n\n";
2128 return;
2129 }
2130
2131- my $protocol = $args->{protocol} || 'https';
2132- my $advice = pingback(
2133- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
2134- instances => $instances_to_check,
2135- protocol => $args->{protocol},
2136- );
2137+ my $advice;
2138+ my $e;
2139+ for my $protocol ( @protocols ) {
2140+ $advice = eval { pingback(
2141+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
2142+ instances => $instances_to_check,
2143+ protocol => $protocol,
2144+ ) };
2145+ last if !$advice && !$EVAL_ERROR;
2146+ $e ||= $EVAL_ERROR;
2147+ }
2148 if ( $advice ) {
2149 print "# Percona suggests these upgrades:\n";
2150 print join("\n", map { "# * $_" } @$advice), "\n\n";
2151 }
2152 else {
2153+ die $e if $e;
2154 print "# No suggestions at this time.\n\n";
2155 ($ENV{PTVCDEBUG} || PTDEBUG )
2156 && _d('--version-check worked, but there were no suggestions');
2157@@ -6928,7 +6936,7 @@
2158
2159 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
2160
2161- $ua ||= HTTPMicro->new( timeout => 2 );
2162+ $ua ||= HTTPMicro->new( timeout => 5 );
2163 $vc ||= VersionCheck->new();
2164
2165 my $response = $ua->request('GET', $url);
2166@@ -7144,6 +7152,21 @@
2167 return $client_response;
2168 }
2169
2170+sub validate_options {
2171+ my ($o) = @_;
2172+
2173+ return if !$o->got('version-check');
2174+
2175+ my $value = $o->get('version-check');
2176+ my @values = split /, /,
2177+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
2178+ chomp(@values);
2179+
2180+ return if grep { $value eq $_ } @values;
2181+ $o->save_error("--version-check invalid value $value. Accepted values are "
2182+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
2183+}
2184+
2185 sub _d {
2186 my ($package, undef, $line) = caller 0;
2187 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
2188@@ -7293,6 +7316,8 @@
2189 $o->save_error("Invalid --recursion-method: $EVAL_ERROR")
2190 }
2191
2192+ Pingback::validate_options($o);
2193+
2194 $o->usage_or_errors();
2195
2196 if ( $o->get('quiet') ) {
2197@@ -7546,11 +7571,11 @@
2198 # ########################################################################
2199 # Do the version-check
2200 # ########################################################################
2201- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
2202+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
2203 Pingback::version_check(
2204- map({ +{ dbh => $_->dbh(), dsn => $_->dsn() } }
2205- $cxn, ($slaves ? @$slaves : ())),
2206- { protocol => $o->get('version-check') },
2207+ instances => [ map({ +{ dbh => $_->dbh(), dsn => $_->dsn() } }
2208+ $cxn, ($slaves ? @$slaves : ())) ],
2209+ protocol => $o->get('version-check'),
2210 );
2211 }
2212
2213@@ -9881,14 +9906,20 @@
2214
2215 =item --version-check
2216
2217-type: string; value_is_optional: yes; default: https
2218+type: string; default: off
2219
2220 Send program versions to Percona and print suggested upgrades and problems.
2221-
2222-If specified without a value, it will use https by default; However, this
2223-might fail if C<IO::Socket::SSL> is not installed on your system, in which
2224-case you may choose to use C<--version-check http>, which will forgo
2225-encryption but should work out of the box.
2226+Possible values for --version-check:
2227+
2228+=for comment ignore-pt-internal-value
2229+MAGIC_version_check
2230+
2231+https, http, auto, off
2232+
2233+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
2234+Keep in mind that C<https> might not be available if
2235+C<IO::Socket::SSL> is not installed on your system, although
2236+C<--version-check http> should work everywhere.
2237
2238 The version check feature causes the tool to send and receive data from
2239 Percona over the web. The data contains program versions from the local
2240
2241=== modified file 'bin/pt-query-advisor'
2242--- bin/pt-query-advisor 2012-11-05 17:57:11 +0000
2243+++ bin/pt-query-advisor 2012-11-06 15:04:24 +0000
2244@@ -470,7 +470,6 @@
2245 'default' => 1,
2246 'cumulative' => 1,
2247 'negatable' => 1,
2248- 'value_is_optional' => 1,
2249 );
2250
2251 my $self = {
2252@@ -712,10 +711,9 @@
2253 $opt->{short} = undef;
2254 }
2255
2256- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
2257- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
2258- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
2259- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
2260+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
2261+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
2262+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
2263
2264 $opt->{group} ||= 'default';
2265 $self->{groups}->{ $opt->{group} }->{$long} = 1;
2266@@ -851,7 +849,7 @@
2267 if ( $opt->{is_cumulative} ) {
2268 $opt->{value}++;
2269 }
2270- elsif ( !($opt->{optional_value} && !$val) ) {
2271+ else {
2272 $opt->{value} = $val;
2273 }
2274 $opt->{got} = 1;
2275@@ -1392,12 +1390,11 @@
2276 sub _parse_attribs {
2277 my ( $self, $option, $attribs ) = @_;
2278 my $types = $self->{types};
2279- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
2280 return $option
2281 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
2282 . ($attribs->{'negatable'} ? '!' : '' )
2283 . ($attribs->{'cumulative'} ? '+' : '' )
2284- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
2285+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
2286 }
2287
2288 sub _parse_synopsis {
2289@@ -7017,14 +7014,19 @@
2290 };
2291
2292 sub version_check {
2293- my $args = pop @_;
2294- my (@instances) = @_;
2295+ my %args = @_;
2296+ my @instances = $args{instances} ? @{ $args{instances} } : ();
2297
2298 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
2299- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
2300+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
2301 "environment variable.\n\n";
2302 return;
2303 }
2304+
2305+ $args{protocol} ||= 'https';
2306+ my @protocols = $args{protocol} eq 'auto'
2307+ ? qw(https http)
2308+ : $args{protocol};
2309
2310 my $instances_to_check = [];
2311 my $time = int(time());
2312@@ -7039,22 +7041,28 @@
2313 ($time_to_check, $instances_to_check)
2314 = time_to_check($check_time_file, \@instances, $time);
2315 if ( !$time_to_check ) {
2316- print STDERR 'It is not time to --version-check again; ',
2317+ warn 'It is not time to --version-check again; ',
2318 "only 1 check per day.\n\n";
2319 return;
2320 }
2321
2322- my $protocol = $args->{protocol} || 'https';
2323- my $advice = pingback(
2324- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
2325- instances => $instances_to_check,
2326- protocol => $args->{protocol},
2327- );
2328+ my $advice;
2329+ my $e;
2330+ for my $protocol ( @protocols ) {
2331+ $advice = eval { pingback(
2332+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
2333+ instances => $instances_to_check,
2334+ protocol => $protocol,
2335+ ) };
2336+ last if !$advice && !$EVAL_ERROR;
2337+ $e ||= $EVAL_ERROR;
2338+ }
2339 if ( $advice ) {
2340 print "# Percona suggests these upgrades:\n";
2341 print join("\n", map { "# * $_" } @$advice), "\n\n";
2342 }
2343 else {
2344+ die $e if $e;
2345 print "# No suggestions at this time.\n\n";
2346 ($ENV{PTVCDEBUG} || PTDEBUG )
2347 && _d('--version-check worked, but there were no suggestions');
2348@@ -7080,7 +7088,7 @@
2349
2350 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
2351
2352- $ua ||= HTTPMicro->new( timeout => 2 );
2353+ $ua ||= HTTPMicro->new( timeout => 5 );
2354 $vc ||= VersionCheck->new();
2355
2356 my $response = $ua->request('GET', $url);
2357@@ -7296,6 +7304,21 @@
2358 return $client_response;
2359 }
2360
2361+sub validate_options {
2362+ my ($o) = @_;
2363+
2364+ return if !$o->got('version-check');
2365+
2366+ my $value = $o->get('version-check');
2367+ my @values = split /, /,
2368+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
2369+ chomp(@values);
2370+
2371+ return if grep { $value eq $_ } @values;
2372+ $o->save_error("--version-check invalid value $value. Accepted values are "
2373+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
2374+}
2375+
2376 sub _d {
2377 my ($package, undef, $line) = caller 0;
2378 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
2379@@ -7373,6 +7396,8 @@
2380 $o->save_error("Invalid --group-by value. Valid values are: "
2381 . "rule_id, query_id, none");
2382 }
2383+
2384+ Pingback::validate_options($o);
2385 }
2386
2387 $o->usage_or_errors();
2388@@ -7702,11 +7727,13 @@
2389 # ########################################################################
2390 # Do the version-check
2391 # ########################################################################
2392- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
2393+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
2394 Pingback::version_check(
2395- ($review_dbh ? { dbh => $review_dbh, dsn => $review_dsn } : ()),
2396- ($dbh ? { dbh => $dbh, dsn => $dsn } : ()),
2397- { protocol => $o->get('version-check') },
2398+ instances => [
2399+ ($review_dbh ? { dbh => $review_dbh, dsn => $review_dsn } : ()),
2400+ ($dbh ? { dbh => $dbh, dsn => $dsn } : ()),
2401+ ],
2402+ protocol => $o->get('version-check'),
2403 );
2404 }
2405
2406@@ -8479,14 +8506,20 @@
2407
2408 =item --version-check
2409
2410-type: string; value_is_optional: yes; default: https
2411+type: string; default: off
2412
2413 Send program versions to Percona and print suggested upgrades and problems.
2414-
2415-If specified without a value, it will use https by default; However, this
2416-might fail if C<IO::Socket::SSL> is not installed on your system, in which
2417-case you may choose to use C<--version-check http>, which will forgo
2418-encryption but should work out of the box.
2419+Possible values for --version-check:
2420+
2421+=for comment ignore-pt-internal-value
2422+MAGIC_version_check
2423+
2424+https, http, auto, off
2425+
2426+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
2427+Keep in mind that C<https> might not be available if
2428+C<IO::Socket::SSL> is not installed on your system, although
2429+C<--version-check http> should work everywhere.
2430
2431 The version check feature causes the tool to send and receive data from
2432 Percona over the web. The data contains program versions from the local
2433
2434=== modified file 'bin/pt-query-digest'
2435--- bin/pt-query-digest 2012-11-05 17:57:11 +0000
2436+++ bin/pt-query-digest 2012-11-06 15:04:24 +0000
2437@@ -608,7 +608,6 @@
2438 'default' => 1,
2439 'cumulative' => 1,
2440 'negatable' => 1,
2441- 'value_is_optional' => 1,
2442 );
2443
2444 my $self = {
2445@@ -850,10 +849,9 @@
2446 $opt->{short} = undef;
2447 }
2448
2449- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
2450- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
2451- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
2452- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
2453+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
2454+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
2455+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
2456
2457 $opt->{group} ||= 'default';
2458 $self->{groups}->{ $opt->{group} }->{$long} = 1;
2459@@ -989,7 +987,7 @@
2460 if ( $opt->{is_cumulative} ) {
2461 $opt->{value}++;
2462 }
2463- elsif ( !($opt->{optional_value} && !$val) ) {
2464+ else {
2465 $opt->{value} = $val;
2466 }
2467 $opt->{got} = 1;
2468@@ -1530,12 +1528,11 @@
2469 sub _parse_attribs {
2470 my ( $self, $option, $attribs ) = @_;
2471 my $types = $self->{types};
2472- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
2473 return $option
2474 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
2475 . ($attribs->{'negatable'} ? '!' : '' )
2476 . ($attribs->{'cumulative'} ? '+' : '' )
2477- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
2478+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
2479 }
2480
2481 sub _parse_synopsis {
2482@@ -12947,14 +12944,19 @@
2483 };
2484
2485 sub version_check {
2486- my $args = pop @_;
2487- my (@instances) = @_;
2488+ my %args = @_;
2489+ my @instances = $args{instances} ? @{ $args{instances} } : ();
2490
2491 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
2492- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
2493+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
2494 "environment variable.\n\n";
2495 return;
2496 }
2497+
2498+ $args{protocol} ||= 'https';
2499+ my @protocols = $args{protocol} eq 'auto'
2500+ ? qw(https http)
2501+ : $args{protocol};
2502
2503 my $instances_to_check = [];
2504 my $time = int(time());
2505@@ -12969,22 +12971,28 @@
2506 ($time_to_check, $instances_to_check)
2507 = time_to_check($check_time_file, \@instances, $time);
2508 if ( !$time_to_check ) {
2509- print STDERR 'It is not time to --version-check again; ',
2510+ warn 'It is not time to --version-check again; ',
2511 "only 1 check per day.\n\n";
2512 return;
2513 }
2514
2515- my $protocol = $args->{protocol} || 'https';
2516- my $advice = pingback(
2517- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
2518- instances => $instances_to_check,
2519- protocol => $args->{protocol},
2520- );
2521+ my $advice;
2522+ my $e;
2523+ for my $protocol ( @protocols ) {
2524+ $advice = eval { pingback(
2525+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
2526+ instances => $instances_to_check,
2527+ protocol => $protocol,
2528+ ) };
2529+ last if !$advice && !$EVAL_ERROR;
2530+ $e ||= $EVAL_ERROR;
2531+ }
2532 if ( $advice ) {
2533 print "# Percona suggests these upgrades:\n";
2534 print join("\n", map { "# * $_" } @$advice), "\n\n";
2535 }
2536 else {
2537+ die $e if $e;
2538 print "# No suggestions at this time.\n\n";
2539 ($ENV{PTVCDEBUG} || PTDEBUG )
2540 && _d('--version-check worked, but there were no suggestions');
2541@@ -13010,7 +13018,7 @@
2542
2543 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
2544
2545- $ua ||= HTTPMicro->new( timeout => 2 );
2546+ $ua ||= HTTPMicro->new( timeout => 5 );
2547 $vc ||= VersionCheck->new();
2548
2549 my $response = $ua->request('GET', $url);
2550@@ -13226,6 +13234,21 @@
2551 return $client_response;
2552 }
2553
2554+sub validate_options {
2555+ my ($o) = @_;
2556+
2557+ return if !$o->got('version-check');
2558+
2559+ my $value = $o->get('version-check');
2560+ my @values = split /, /,
2561+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
2562+ chomp(@values);
2563+
2564+ return if grep { $value eq $_ } @values;
2565+ $o->save_error("--version-check invalid value $value. Accepted values are "
2566+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
2567+}
2568+
2569 sub _d {
2570 my ($package, undef, $line) = caller 0;
2571 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
2572@@ -13373,6 +13396,8 @@
2573 $o->save_error($EVAL_ERROR);
2574 }
2575
2576+ Pingback::validate_options($o);
2577+
2578 $o->usage_or_errors();
2579
2580 # ########################################################################
2581@@ -14583,12 +14608,14 @@
2582 # ########################################################################
2583 # Do the version-check
2584 # ########################################################################
2585- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
2586+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
2587 Pingback::version_check(
2588- ($qv_dbh ? { dbh => $qv_dbh, dsn => $review_dsn } : ()),
2589- ($ps_dbh ? { dbh => $ps_dbh, dsn => $ps_dsn } : ()),
2590- ($ex_dbh ? { dbh => $ex_dbh, dsn => $ex_dsn } : ()),
2591- { protocol => $o->get('version-check') },
2592+ instances => [
2593+ ($qv_dbh ? { dbh => $qv_dbh, dsn => $review_dsn } : ()),
2594+ ($ps_dbh ? { dbh => $ps_dbh, dsn => $ps_dsn } : ()),
2595+ ($ex_dbh ? { dbh => $ex_dbh, dsn => $ex_dsn } : ())
2596+ ],
2597+ protocol => $o->get('version-check'),
2598 );
2599 }
2600
2601@@ -16974,14 +17001,20 @@
2602
2603 =item --version-check
2604
2605-type: string; value_is_optional: yes; default: https
2606+type: string; default: off
2607
2608 Send program versions to Percona and print suggested upgrades and problems.
2609-
2610-If specified without a value, it will use https by default; However, this
2611-might fail if C<IO::Socket::SSL> is not installed on your system, in which
2612-case you may choose to use C<--version-check http>, which will forgo
2613-encryption but should work out of the box.
2614+Possible values for --version-check:
2615+
2616+=for comment ignore-pt-internal-value
2617+MAGIC_version_check
2618+
2619+https, http, auto, off
2620+
2621+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
2622+Keep in mind that C<https> might not be available if
2623+C<IO::Socket::SSL> is not installed on your system, although
2624+C<--version-check http> should work everywhere.
2625
2626 The version check feature causes the tool to send and receive data from
2627 Percona over the web. The data contains program versions from the local
2628
2629=== modified file 'bin/pt-show-grants'
2630--- bin/pt-show-grants 2012-11-01 09:15:54 +0000
2631+++ bin/pt-show-grants 2012-11-06 15:04:24 +0000
2632@@ -58,7 +58,6 @@
2633 'default' => 1,
2634 'cumulative' => 1,
2635 'negatable' => 1,
2636- 'value_is_optional' => 1,
2637 );
2638
2639 my $self = {
2640@@ -300,10 +299,9 @@
2641 $opt->{short} = undef;
2642 }
2643
2644- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
2645- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
2646- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
2647- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
2648+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
2649+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
2650+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
2651
2652 $opt->{group} ||= 'default';
2653 $self->{groups}->{ $opt->{group} }->{$long} = 1;
2654@@ -439,7 +437,7 @@
2655 if ( $opt->{is_cumulative} ) {
2656 $opt->{value}++;
2657 }
2658- elsif ( !($opt->{optional_value} && !$val) ) {
2659+ else {
2660 $opt->{value} = $val;
2661 }
2662 $opt->{got} = 1;
2663@@ -980,12 +978,11 @@
2664 sub _parse_attribs {
2665 my ( $self, $option, $attribs ) = @_;
2666 my $types = $self->{types};
2667- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
2668 return $option
2669 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
2670 . ($attribs->{'negatable'} ? '!' : '' )
2671 . ($attribs->{'cumulative'} ? '+' : '' )
2672- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
2673+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
2674 }
2675
2676 sub _parse_synopsis {
2677
2678=== modified file 'bin/pt-slave-delay'
2679--- bin/pt-slave-delay 2012-10-31 09:18:34 +0000
2680+++ bin/pt-slave-delay 2012-11-06 15:04:24 +0000
2681@@ -83,7 +83,6 @@
2682 'default' => 1,
2683 'cumulative' => 1,
2684 'negatable' => 1,
2685- 'value_is_optional' => 1,
2686 );
2687
2688 my $self = {
2689@@ -325,10 +324,9 @@
2690 $opt->{short} = undef;
2691 }
2692
2693- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
2694- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
2695- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
2696- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
2697+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
2698+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
2699+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
2700
2701 $opt->{group} ||= 'default';
2702 $self->{groups}->{ $opt->{group} }->{$long} = 1;
2703@@ -464,7 +462,7 @@
2704 if ( $opt->{is_cumulative} ) {
2705 $opt->{value}++;
2706 }
2707- elsif ( !($opt->{optional_value} && !$val) ) {
2708+ else {
2709 $opt->{value} = $val;
2710 }
2711 $opt->{got} = 1;
2712@@ -1005,12 +1003,11 @@
2713 sub _parse_attribs {
2714 my ( $self, $option, $attribs ) = @_;
2715 my $types = $self->{types};
2716- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
2717 return $option
2718 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
2719 . ($attribs->{'negatable'} ? '!' : '' )
2720 . ($attribs->{'cumulative'} ? '+' : '' )
2721- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
2722+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
2723 }
2724
2725 sub _parse_synopsis {
2726@@ -3514,14 +3511,19 @@
2727 };
2728
2729 sub version_check {
2730- my $args = pop @_;
2731- my (@instances) = @_;
2732+ my %args = @_;
2733+ my @instances = $args{instances} ? @{ $args{instances} } : ();
2734
2735 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
2736- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
2737+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
2738 "environment variable.\n\n";
2739 return;
2740 }
2741+
2742+ $args{protocol} ||= 'https';
2743+ my @protocols = $args{protocol} eq 'auto'
2744+ ? qw(https http)
2745+ : $args{protocol};
2746
2747 my $instances_to_check = [];
2748 my $time = int(time());
2749@@ -3536,22 +3538,28 @@
2750 ($time_to_check, $instances_to_check)
2751 = time_to_check($check_time_file, \@instances, $time);
2752 if ( !$time_to_check ) {
2753- print STDERR 'It is not time to --version-check again; ',
2754+ warn 'It is not time to --version-check again; ',
2755 "only 1 check per day.\n\n";
2756 return;
2757 }
2758
2759- my $protocol = $args->{protocol} || 'https';
2760- my $advice = pingback(
2761- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
2762- instances => $instances_to_check,
2763- protocol => $args->{protocol},
2764- );
2765+ my $advice;
2766+ my $e;
2767+ for my $protocol ( @protocols ) {
2768+ $advice = eval { pingback(
2769+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
2770+ instances => $instances_to_check,
2771+ protocol => $protocol,
2772+ ) };
2773+ last if !$advice && !$EVAL_ERROR;
2774+ $e ||= $EVAL_ERROR;
2775+ }
2776 if ( $advice ) {
2777 print "# Percona suggests these upgrades:\n";
2778 print join("\n", map { "# * $_" } @$advice), "\n\n";
2779 }
2780 else {
2781+ die $e if $e;
2782 print "# No suggestions at this time.\n\n";
2783 ($ENV{PTVCDEBUG} || PTDEBUG )
2784 && _d('--version-check worked, but there were no suggestions');
2785@@ -3577,7 +3585,7 @@
2786
2787 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
2788
2789- $ua ||= HTTPMicro->new( timeout => 2 );
2790+ $ua ||= HTTPMicro->new( timeout => 5 );
2791 $vc ||= VersionCheck->new();
2792
2793 my $response = $ua->request('GET', $url);
2794@@ -3793,6 +3801,21 @@
2795 return $client_response;
2796 }
2797
2798+sub validate_options {
2799+ my ($o) = @_;
2800+
2801+ return if !$o->got('version-check');
2802+
2803+ my $value = $o->get('version-check');
2804+ my @values = split /, /,
2805+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
2806+ chomp(@values);
2807+
2808+ return if grep { $value eq $_ } @values;
2809+ $o->save_error("--version-check invalid value $value. Accepted values are "
2810+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
2811+}
2812+
2813 sub _d {
2814 my ($package, undef, $line) = caller 0;
2815 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
2816@@ -3856,6 +3879,8 @@
2817 $o->set('run-time', max($o->get('run-time'), 1));
2818 }
2819
2820+ Pingback::validate_options($o);
2821+
2822 $o->usage_or_errors();
2823
2824 # #######################################################################
2825@@ -3909,14 +3934,16 @@
2826 # ########################################################################
2827 # Do the version-check
2828 # ########################################################################
2829- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
2830+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
2831 my $tmp_master_dsn = $master_dsn
2832 ? $master_dsn
2833 : { h => $status->{master_host}, P => $status->{master_port} };
2834 Pingback::version_check(
2835- { dbh => $slave_dbh, dsn => $slave_dsn },
2836- { dbh => $master_dbh, dsn => $tmp_master_dsn },
2837- { protocol => $o->get('version-check') },
2838+ instances => [
2839+ { dbh => $slave_dbh, dsn => $slave_dsn },
2840+ { dbh => $master_dbh, dsn => $tmp_master_dsn }
2841+ ],
2842+ protocol => $o->get('version-check'),
2843 );
2844 }
2845
2846@@ -4393,14 +4420,20 @@
2847
2848 =item --version-check
2849
2850-type: string; value_is_optional: yes; default: https
2851+type: string; default: off
2852
2853 Send program versions to Percona and print suggested upgrades and problems.
2854-
2855-If specified without a value, it will use https by default; However, this
2856-might fail if C<IO::Socket::SSL> is not installed on your system, in which
2857-case you may choose to use C<--version-check http>, which will forgo
2858-encryption but should work out of the box.
2859+Possible values for --version-check:
2860+
2861+=for comment ignore-pt-internal-value
2862+MAGIC_version_check
2863+
2864+https, http, auto, off
2865+
2866+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
2867+Keep in mind that C<https> might not be available if
2868+C<IO::Socket::SSL> is not installed on your system, although
2869+C<--version-check http> should work everywhere.
2870
2871 The version check feature causes the tool to send and receive data from
2872 Percona over the web. The data contains program versions from the local
2873
2874=== modified file 'bin/pt-slave-find'
2875--- bin/pt-slave-find 2012-10-31 09:18:34 +0000
2876+++ bin/pt-slave-find 2012-11-06 15:04:24 +0000
2877@@ -62,7 +62,6 @@
2878 'default' => 1,
2879 'cumulative' => 1,
2880 'negatable' => 1,
2881- 'value_is_optional' => 1,
2882 );
2883
2884 my $self = {
2885@@ -304,10 +303,9 @@
2886 $opt->{short} = undef;
2887 }
2888
2889- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
2890- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
2891- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
2892- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
2893+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
2894+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
2895+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
2896
2897 $opt->{group} ||= 'default';
2898 $self->{groups}->{ $opt->{group} }->{$long} = 1;
2899@@ -443,7 +441,7 @@
2900 if ( $opt->{is_cumulative} ) {
2901 $opt->{value}++;
2902 }
2903- elsif ( !($opt->{optional_value} && !$val) ) {
2904+ else {
2905 $opt->{value} = $val;
2906 }
2907 $opt->{got} = 1;
2908@@ -984,12 +982,11 @@
2909 sub _parse_attribs {
2910 my ( $self, $option, $attribs ) = @_;
2911 my $types = $self->{types};
2912- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
2913 return $option
2914 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
2915 . ($attribs->{'negatable'} ? '!' : '' )
2916 . ($attribs->{'cumulative'} ? '+' : '' )
2917- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
2918+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
2919 }
2920
2921 sub _parse_synopsis {
2922
2923=== modified file 'bin/pt-slave-restart'
2924--- bin/pt-slave-restart 2012-10-31 09:18:34 +0000
2925+++ bin/pt-slave-restart 2012-11-06 15:04:24 +0000
2926@@ -204,7 +204,6 @@
2927 'default' => 1,
2928 'cumulative' => 1,
2929 'negatable' => 1,
2930- 'value_is_optional' => 1,
2931 );
2932
2933 my $self = {
2934@@ -446,10 +445,9 @@
2935 $opt->{short} = undef;
2936 }
2937
2938- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
2939- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
2940- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
2941- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
2942+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
2943+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
2944+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
2945
2946 $opt->{group} ||= 'default';
2947 $self->{groups}->{ $opt->{group} }->{$long} = 1;
2948@@ -585,7 +583,7 @@
2949 if ( $opt->{is_cumulative} ) {
2950 $opt->{value}++;
2951 }
2952- elsif ( !($opt->{optional_value} && !$val) ) {
2953+ else {
2954 $opt->{value} = $val;
2955 }
2956 $opt->{got} = 1;
2957@@ -1126,12 +1124,11 @@
2958 sub _parse_attribs {
2959 my ( $self, $option, $attribs ) = @_;
2960 my $types = $self->{types};
2961- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
2962 return $option
2963 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
2964 . ($attribs->{'negatable'} ? '!' : '' )
2965 . ($attribs->{'cumulative'} ? '+' : '' )
2966- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
2967+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
2968 }
2969
2970 sub _parse_synopsis {
2971@@ -4137,14 +4134,19 @@
2972 };
2973
2974 sub version_check {
2975- my $args = pop @_;
2976- my (@instances) = @_;
2977+ my %args = @_;
2978+ my @instances = $args{instances} ? @{ $args{instances} } : ();
2979
2980 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
2981- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
2982+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
2983 "environment variable.\n\n";
2984 return;
2985 }
2986+
2987+ $args{protocol} ||= 'https';
2988+ my @protocols = $args{protocol} eq 'auto'
2989+ ? qw(https http)
2990+ : $args{protocol};
2991
2992 my $instances_to_check = [];
2993 my $time = int(time());
2994@@ -4159,22 +4161,28 @@
2995 ($time_to_check, $instances_to_check)
2996 = time_to_check($check_time_file, \@instances, $time);
2997 if ( !$time_to_check ) {
2998- print STDERR 'It is not time to --version-check again; ',
2999+ warn 'It is not time to --version-check again; ',
3000 "only 1 check per day.\n\n";
3001 return;
3002 }
3003
3004- my $protocol = $args->{protocol} || 'https';
3005- my $advice = pingback(
3006- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
3007- instances => $instances_to_check,
3008- protocol => $args->{protocol},
3009- );
3010+ my $advice;
3011+ my $e;
3012+ for my $protocol ( @protocols ) {
3013+ $advice = eval { pingback(
3014+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
3015+ instances => $instances_to_check,
3016+ protocol => $protocol,
3017+ ) };
3018+ last if !$advice && !$EVAL_ERROR;
3019+ $e ||= $EVAL_ERROR;
3020+ }
3021 if ( $advice ) {
3022 print "# Percona suggests these upgrades:\n";
3023 print join("\n", map { "# * $_" } @$advice), "\n\n";
3024 }
3025 else {
3026+ die $e if $e;
3027 print "# No suggestions at this time.\n\n";
3028 ($ENV{PTVCDEBUG} || PTDEBUG )
3029 && _d('--version-check worked, but there were no suggestions');
3030@@ -4200,7 +4208,7 @@
3031
3032 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
3033
3034- $ua ||= HTTPMicro->new( timeout => 2 );
3035+ $ua ||= HTTPMicro->new( timeout => 5 );
3036 $vc ||= VersionCheck->new();
3037
3038 my $response = $ua->request('GET', $url);
3039@@ -4416,6 +4424,21 @@
3040 return $client_response;
3041 }
3042
3043+sub validate_options {
3044+ my ($o) = @_;
3045+
3046+ return if !$o->got('version-check');
3047+
3048+ my $value = $o->get('version-check');
3049+ my @values = split /, /,
3050+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
3051+ chomp(@values);
3052+
3053+ return if grep { $value eq $_ } @values;
3054+ $o->save_error("--version-check invalid value $value. Accepted values are "
3055+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
3056+}
3057+
3058 sub _d {
3059 my ($package, undef, $line) = caller 0;
3060 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
3061@@ -4491,6 +4514,8 @@
3062 $o->save_error("Invalid --recursion-method: $EVAL_ERROR")
3063 }
3064
3065+ Pingback::validate_options($o);
3066+
3067 $o->usage_or_errors();
3068
3069 # ########################################################################
3070@@ -4595,10 +4620,10 @@
3071 # ########################################################################
3072 # Do the version-check
3073 # ########################################################################
3074- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
3075+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
3076 Pingback::version_check(
3077- { dbh => $dbh, dsn => $dsn }, @servers_to_watch,
3078- { protocol => $o->get('version-check') },
3079+ instances => [ { dbh => $dbh, dsn => $dsn }, @servers_to_watch ],
3080+ protocol => $o->get('version-check'),
3081 );
3082 }
3083
3084@@ -5312,14 +5337,20 @@
3085
3086 =item --version-check
3087
3088-type: string; value_is_optional: yes; default: https
3089+type: string; default: off
3090
3091 Send program versions to Percona and print suggested upgrades and problems.
3092-
3093-If specified without a value, it will use https by default; However, this
3094-might fail if C<IO::Socket::SSL> is not installed on your system, in which
3095-case you may choose to use C<--version-check http>, which will forgo
3096-encryption but should work out of the box.
3097+Possible values for --version-check:
3098+
3099+=for comment ignore-pt-internal-value
3100+MAGIC_version_check
3101+
3102+https, http, auto, off
3103+
3104+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
3105+Keep in mind that C<https> might not be available if
3106+C<IO::Socket::SSL> is not installed on your system, although
3107+C<--version-check http> should work everywhere.
3108
3109 The version check feature causes the tool to send and receive data from
3110 Percona over the web. The data contains program versions from the local
3111
3112=== modified file 'bin/pt-table-checksum'
3113--- bin/pt-table-checksum 2012-11-05 17:57:11 +0000
3114+++ bin/pt-table-checksum 2012-11-06 15:04:24 +0000
3115@@ -1047,14 +1047,19 @@
3116 };
3117
3118 sub version_check {
3119- my $args = pop @_;
3120- my (@instances) = @_;
3121+ my %args = @_;
3122+ my @instances = $args{instances} ? @{ $args{instances} } : ();
3123
3124 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
3125- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
3126+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
3127 "environment variable.\n\n";
3128 return;
3129 }
3130+
3131+ $args{protocol} ||= 'https';
3132+ my @protocols = $args{protocol} eq 'auto'
3133+ ? qw(https http)
3134+ : $args{protocol};
3135
3136 my $instances_to_check = [];
3137 my $time = int(time());
3138@@ -1069,22 +1074,28 @@
3139 ($time_to_check, $instances_to_check)
3140 = time_to_check($check_time_file, \@instances, $time);
3141 if ( !$time_to_check ) {
3142- print STDERR 'It is not time to --version-check again; ',
3143+ warn 'It is not time to --version-check again; ',
3144 "only 1 check per day.\n\n";
3145 return;
3146 }
3147
3148- my $protocol = $args->{protocol} || 'https';
3149- my $advice = pingback(
3150- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
3151- instances => $instances_to_check,
3152- protocol => $args->{protocol},
3153- );
3154+ my $advice;
3155+ my $e;
3156+ for my $protocol ( @protocols ) {
3157+ $advice = eval { pingback(
3158+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
3159+ instances => $instances_to_check,
3160+ protocol => $protocol,
3161+ ) };
3162+ last if !$advice && !$EVAL_ERROR;
3163+ $e ||= $EVAL_ERROR;
3164+ }
3165 if ( $advice ) {
3166 print "# Percona suggests these upgrades:\n";
3167 print join("\n", map { "# * $_" } @$advice), "\n\n";
3168 }
3169 else {
3170+ die $e if $e;
3171 print "# No suggestions at this time.\n\n";
3172 ($ENV{PTVCDEBUG} || PTDEBUG )
3173 && _d('--version-check worked, but there were no suggestions');
3174@@ -1110,7 +1121,7 @@
3175
3176 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
3177
3178- $ua ||= HTTPMicro->new( timeout => 2 );
3179+ $ua ||= HTTPMicro->new( timeout => 5 );
3180 $vc ||= VersionCheck->new();
3181
3182 my $response = $ua->request('GET', $url);
3183@@ -1326,6 +1337,21 @@
3184 return $client_response;
3185 }
3186
3187+sub validate_options {
3188+ my ($o) = @_;
3189+
3190+ return if !$o->got('version-check');
3191+
3192+ my $value = $o->get('version-check');
3193+ my @values = split /, /,
3194+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
3195+ chomp(@values);
3196+
3197+ return if grep { $value eq $_ } @values;
3198+ $o->save_error("--version-check invalid value $value. Accepted values are "
3199+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
3200+}
3201+
3202 sub _d {
3203 my ($package, undef, $line) = caller 0;
3204 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
3205@@ -1756,7 +1782,6 @@
3206 'default' => 1,
3207 'cumulative' => 1,
3208 'negatable' => 1,
3209- 'value_is_optional' => 1,
3210 );
3211
3212 my $self = {
3213@@ -1998,10 +2023,9 @@
3214 $opt->{short} = undef;
3215 }
3216
3217- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
3218- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
3219- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
3220- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
3221+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
3222+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
3223+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
3224
3225 $opt->{group} ||= 'default';
3226 $self->{groups}->{ $opt->{group} }->{$long} = 1;
3227@@ -2137,7 +2161,7 @@
3228 if ( $opt->{is_cumulative} ) {
3229 $opt->{value}++;
3230 }
3231- elsif ( !($opt->{optional_value} && !$val) ) {
3232+ else {
3233 $opt->{value} = $val;
3234 }
3235 $opt->{got} = 1;
3236@@ -2678,12 +2702,11 @@
3237 sub _parse_attribs {
3238 my ( $self, $option, $attribs ) = @_;
3239 my $types = $self->{types};
3240- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
3241 return $option
3242 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
3243 . ($attribs->{'negatable'} ? '!' : '' )
3244 . ($attribs->{'cumulative'} ? '+' : '' )
3245- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
3246+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
3247 }
3248
3249 sub _parse_synopsis {
3250@@ -8376,6 +8399,8 @@
3251 $o->save_error("Invalid --recursion-method: $EVAL_ERROR")
3252 }
3253
3254+ Pingback::validate_options($o);
3255+
3256 $o->usage_or_errors();
3257
3258 # ########################################################################
3259@@ -8827,11 +8852,13 @@
3260 # ########################################################################
3261 # Do the version-check
3262 # ########################################################################
3263- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
3264+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
3265 Pingback::version_check(
3266- { dbh => $master_dbh, dsn => $master_dsn },
3267- map({ +{ dbh => $_->dbh(), dsn => $_->dsn() } } @$slaves),
3268- { protocol => $o->get('version-check') },
3269+ instances => [
3270+ { dbh => $master_dbh, dsn => $master_dsn },
3271+ map({ +{ dbh => $_->dbh(), dsn => $_->dsn() } } @$slaves)
3272+ ],
3273+ protocol => $o->get('version-check'),
3274 );
3275 }
3276
3277@@ -11321,14 +11348,20 @@
3278
3279 =item --version-check
3280
3281-type: string; value_is_optional: yes; default: https
3282+type: string; default: off
3283
3284 Send program versions to Percona and print suggested upgrades and problems.
3285-
3286-If specified without a value, it will use https by default; However, this
3287-might fail if C<IO::Socket::SSL> is not installed on your system, in which
3288-case you may choose to use C<--version-check http>, which will forgo
3289-encryption but should work out of the box.
3290+Possible values for --version-check:
3291+
3292+=for comment ignore-pt-internal-value
3293+MAGIC_version_check
3294+
3295+https, http, auto, off
3296+
3297+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
3298+Keep in mind that C<https> might not be available if
3299+C<IO::Socket::SSL> is not installed on your system, although
3300+C<--version-check http> should work everywhere.
3301
3302 The version check feature causes the tool to send and receive data from
3303 Percona over the web. The data contains program versions from the local
3304
3305=== modified file 'bin/pt-table-sync'
3306--- bin/pt-table-sync 2012-11-05 17:57:11 +0000
3307+++ bin/pt-table-sync 2012-11-06 15:04:24 +0000
3308@@ -99,7 +99,6 @@
3309 'default' => 1,
3310 'cumulative' => 1,
3311 'negatable' => 1,
3312- 'value_is_optional' => 1,
3313 );
3314
3315 my $self = {
3316@@ -341,10 +340,9 @@
3317 $opt->{short} = undef;
3318 }
3319
3320- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
3321- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
3322- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
3323- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
3324+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
3325+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
3326+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
3327
3328 $opt->{group} ||= 'default';
3329 $self->{groups}->{ $opt->{group} }->{$long} = 1;
3330@@ -480,7 +478,7 @@
3331 if ( $opt->{is_cumulative} ) {
3332 $opt->{value}++;
3333 }
3334- elsif ( !($opt->{optional_value} && !$val) ) {
3335+ else {
3336 $opt->{value} = $val;
3337 }
3338 $opt->{got} = 1;
3339@@ -1021,12 +1019,11 @@
3340 sub _parse_attribs {
3341 my ( $self, $option, $attribs ) = @_;
3342 my $types = $self->{types};
3343- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
3344 return $option
3345 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
3346 . ($attribs->{'negatable'} ? '!' : '' )
3347 . ($attribs->{'cumulative'} ? '+' : '' )
3348- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
3349+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
3350 }
3351
3352 sub _parse_synopsis {
3353@@ -9242,14 +9239,19 @@
3354 };
3355
3356 sub version_check {
3357- my $args = pop @_;
3358- my (@instances) = @_;
3359+ my %args = @_;
3360+ my @instances = $args{instances} ? @{ $args{instances} } : ();
3361
3362 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
3363- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
3364+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
3365 "environment variable.\n\n";
3366 return;
3367 }
3368+
3369+ $args{protocol} ||= 'https';
3370+ my @protocols = $args{protocol} eq 'auto'
3371+ ? qw(https http)
3372+ : $args{protocol};
3373
3374 my $instances_to_check = [];
3375 my $time = int(time());
3376@@ -9264,22 +9266,28 @@
3377 ($time_to_check, $instances_to_check)
3378 = time_to_check($check_time_file, \@instances, $time);
3379 if ( !$time_to_check ) {
3380- print STDERR 'It is not time to --version-check again; ',
3381+ warn 'It is not time to --version-check again; ',
3382 "only 1 check per day.\n\n";
3383 return;
3384 }
3385
3386- my $protocol = $args->{protocol} || 'https';
3387- my $advice = pingback(
3388- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
3389- instances => $instances_to_check,
3390- protocol => $args->{protocol},
3391- );
3392+ my $advice;
3393+ my $e;
3394+ for my $protocol ( @protocols ) {
3395+ $advice = eval { pingback(
3396+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
3397+ instances => $instances_to_check,
3398+ protocol => $protocol,
3399+ ) };
3400+ last if !$advice && !$EVAL_ERROR;
3401+ $e ||= $EVAL_ERROR;
3402+ }
3403 if ( $advice ) {
3404 print "# Percona suggests these upgrades:\n";
3405 print join("\n", map { "# * $_" } @$advice), "\n\n";
3406 }
3407 else {
3408+ die $e if $e;
3409 print "# No suggestions at this time.\n\n";
3410 ($ENV{PTVCDEBUG} || PTDEBUG )
3411 && _d('--version-check worked, but there were no suggestions');
3412@@ -9305,7 +9313,7 @@
3413
3414 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
3415
3416- $ua ||= HTTPMicro->new( timeout => 2 );
3417+ $ua ||= HTTPMicro->new( timeout => 5 );
3418 $vc ||= VersionCheck->new();
3419
3420 my $response = $ua->request('GET', $url);
3421@@ -9521,6 +9529,21 @@
3422 return $client_response;
3423 }
3424
3425+sub validate_options {
3426+ my ($o) = @_;
3427+
3428+ return if !$o->got('version-check');
3429+
3430+ my $value = $o->get('version-check');
3431+ my @values = split /, /,
3432+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
3433+ chomp(@values);
3434+
3435+ return if grep { $value eq $_ } @values;
3436+ $o->save_error("--version-check invalid value $value. Accepted values are "
3437+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
3438+}
3439+
3440 sub _d {
3441 my ($package, undef, $line) = caller 0;
3442 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
3443@@ -9668,6 +9691,8 @@
3444 $o->save_error("Invalid --recursion-method: $EVAL_ERROR")
3445 }
3446
3447+ Pingback::validate_options($o);
3448+
3449 $o->usage_or_errors();
3450
3451 # ########################################################################
3452@@ -9778,8 +9803,11 @@
3453 +{ dbh => $dbh, dsn => $dsn }
3454 } @dsns;
3455
3456- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
3457- Pingback::version_check(@instances, { protocol => $o->get('version-check') });
3458+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
3459+ Pingback::version_check(
3460+ instances => [@instances],
3461+ protocol => $o->get('version-check'),
3462+ );
3463 }
3464
3465 map { $_->disconnect } @vc_dbhs; # disconnect dbh created for version check
3466@@ -12291,14 +12319,20 @@
3467
3468 =item --version-check
3469
3470-type: string; value_is_optional: yes; default: https
3471+type: string; default: off
3472
3473 Send program versions to Percona and print suggested upgrades and problems.
3474-
3475-If specified without a value, it will use https by default; However, this
3476-might fail if C<IO::Socket::SSL> is not installed on your system, in which
3477-case you may choose to use C<--version-check http>, which will forgo
3478-encryption but should work out of the box.
3479+Possible values for --version-check:
3480+
3481+=for comment ignore-pt-internal-value
3482+MAGIC_version_check
3483+
3484+https, http, auto, off
3485+
3486+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
3487+Keep in mind that C<https> might not be available if
3488+C<IO::Socket::SSL> is not installed on your system, although
3489+C<--version-check http> should work everywhere.
3490
3491 The version check feature causes the tool to send and receive data from
3492 Percona over the web. The data contains program versions from the local
3493
3494=== modified file 'bin/pt-tcp-model'
3495--- bin/pt-tcp-model 2012-10-22 18:17:08 +0000
3496+++ bin/pt-tcp-model 2012-11-06 15:04:24 +0000
3497@@ -61,7 +61,6 @@
3498 'default' => 1,
3499 'cumulative' => 1,
3500 'negatable' => 1,
3501- 'value_is_optional' => 1,
3502 );
3503
3504 my $self = {
3505@@ -303,10 +302,9 @@
3506 $opt->{short} = undef;
3507 }
3508
3509- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
3510- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
3511- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
3512- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
3513+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
3514+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
3515+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
3516
3517 $opt->{group} ||= 'default';
3518 $self->{groups}->{ $opt->{group} }->{$long} = 1;
3519@@ -442,7 +440,7 @@
3520 if ( $opt->{is_cumulative} ) {
3521 $opt->{value}++;
3522 }
3523- elsif ( !($opt->{optional_value} && !$val) ) {
3524+ else {
3525 $opt->{value} = $val;
3526 }
3527 $opt->{got} = 1;
3528@@ -983,12 +981,11 @@
3529 sub _parse_attribs {
3530 my ( $self, $option, $attribs ) = @_;
3531 my $types = $self->{types};
3532- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
3533 return $option
3534 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
3535 . ($attribs->{'negatable'} ? '!' : '' )
3536 . ($attribs->{'cumulative'} ? '+' : '' )
3537- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
3538+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
3539 }
3540
3541 sub _parse_synopsis {
3542
3543=== modified file 'bin/pt-trend'
3544--- bin/pt-trend 2012-10-30 23:04:22 +0000
3545+++ bin/pt-trend 2012-11-06 15:04:24 +0000
3546@@ -61,7 +61,6 @@
3547 'default' => 1,
3548 'cumulative' => 1,
3549 'negatable' => 1,
3550- 'value_is_optional' => 1,
3551 );
3552
3553 my $self = {
3554@@ -303,10 +302,9 @@
3555 $opt->{short} = undef;
3556 }
3557
3558- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
3559- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
3560- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
3561- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
3562+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
3563+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
3564+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
3565
3566 $opt->{group} ||= 'default';
3567 $self->{groups}->{ $opt->{group} }->{$long} = 1;
3568@@ -442,7 +440,7 @@
3569 if ( $opt->{is_cumulative} ) {
3570 $opt->{value}++;
3571 }
3572- elsif ( !($opt->{optional_value} && !$val) ) {
3573+ else {
3574 $opt->{value} = $val;
3575 }
3576 $opt->{got} = 1;
3577@@ -983,12 +981,11 @@
3578 sub _parse_attribs {
3579 my ( $self, $option, $attribs ) = @_;
3580 my $types = $self->{types};
3581- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
3582 return $option
3583 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
3584 . ($attribs->{'negatable'} ? '!' : '' )
3585 . ($attribs->{'cumulative'} ? '+' : '' )
3586- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
3587+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
3588 }
3589
3590 sub _parse_synopsis {
3591
3592=== modified file 'bin/pt-upgrade'
3593--- bin/pt-upgrade 2012-11-05 17:57:11 +0000
3594+++ bin/pt-upgrade 2012-11-06 15:04:24 +0000
3595@@ -1011,7 +1011,6 @@
3596 'default' => 1,
3597 'cumulative' => 1,
3598 'negatable' => 1,
3599- 'value_is_optional' => 1,
3600 );
3601
3602 my $self = {
3603@@ -1253,10 +1252,9 @@
3604 $opt->{short} = undef;
3605 }
3606
3607- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
3608- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
3609- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
3610- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
3611+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
3612+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
3613+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
3614
3615 $opt->{group} ||= 'default';
3616 $self->{groups}->{ $opt->{group} }->{$long} = 1;
3617@@ -1392,7 +1390,7 @@
3618 if ( $opt->{is_cumulative} ) {
3619 $opt->{value}++;
3620 }
3621- elsif ( !($opt->{optional_value} && !$val) ) {
3622+ else {
3623 $opt->{value} = $val;
3624 }
3625 $opt->{got} = 1;
3626@@ -1933,12 +1931,11 @@
3627 sub _parse_attribs {
3628 my ( $self, $option, $attribs ) = @_;
3629 my $types = $self->{types};
3630- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
3631 return $option
3632 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
3633 . ($attribs->{'negatable'} ? '!' : '' )
3634 . ($attribs->{'cumulative'} ? '+' : '' )
3635- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
3636+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
3637 }
3638
3639 sub _parse_synopsis {
3640@@ -11314,14 +11311,19 @@
3641 };
3642
3643 sub version_check {
3644- my $args = pop @_;
3645- my (@instances) = @_;
3646+ my %args = @_;
3647+ my @instances = $args{instances} ? @{ $args{instances} } : ();
3648
3649 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
3650- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
3651+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
3652 "environment variable.\n\n";
3653 return;
3654 }
3655+
3656+ $args{protocol} ||= 'https';
3657+ my @protocols = $args{protocol} eq 'auto'
3658+ ? qw(https http)
3659+ : $args{protocol};
3660
3661 my $instances_to_check = [];
3662 my $time = int(time());
3663@@ -11336,22 +11338,28 @@
3664 ($time_to_check, $instances_to_check)
3665 = time_to_check($check_time_file, \@instances, $time);
3666 if ( !$time_to_check ) {
3667- print STDERR 'It is not time to --version-check again; ',
3668+ warn 'It is not time to --version-check again; ',
3669 "only 1 check per day.\n\n";
3670 return;
3671 }
3672
3673- my $protocol = $args->{protocol} || 'https';
3674- my $advice = pingback(
3675- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
3676- instances => $instances_to_check,
3677- protocol => $args->{protocol},
3678- );
3679+ my $advice;
3680+ my $e;
3681+ for my $protocol ( @protocols ) {
3682+ $advice = eval { pingback(
3683+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
3684+ instances => $instances_to_check,
3685+ protocol => $protocol,
3686+ ) };
3687+ last if !$advice && !$EVAL_ERROR;
3688+ $e ||= $EVAL_ERROR;
3689+ }
3690 if ( $advice ) {
3691 print "# Percona suggests these upgrades:\n";
3692 print join("\n", map { "# * $_" } @$advice), "\n\n";
3693 }
3694 else {
3695+ die $e if $e;
3696 print "# No suggestions at this time.\n\n";
3697 ($ENV{PTVCDEBUG} || PTDEBUG )
3698 && _d('--version-check worked, but there were no suggestions');
3699@@ -11377,7 +11385,7 @@
3700
3701 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
3702
3703- $ua ||= HTTPMicro->new( timeout => 2 );
3704+ $ua ||= HTTPMicro->new( timeout => 5 );
3705 $vc ||= VersionCheck->new();
3706
3707 my $response = $ua->request('GET', $url);
3708@@ -11593,6 +11601,21 @@
3709 return $client_response;
3710 }
3711
3712+sub validate_options {
3713+ my ($o) = @_;
3714+
3715+ return if !$o->got('version-check');
3716+
3717+ my $value = $o->get('version-check');
3718+ my @values = split /, /,
3719+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
3720+ chomp(@values);
3721+
3722+ return if grep { $value eq $_ } @values;
3723+ $o->save_error("--version-check invalid value $value. Accepted values are "
3724+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
3725+}
3726+
3727 sub _d {
3728 my ($package, undef, $line) = caller 0;
3729 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
3730@@ -11686,6 +11709,8 @@
3731 $o->save_error('Specify at least one host DSN');
3732 }
3733
3734+ Pingback::validate_options($o);
3735+
3736 $o->usage_or_errors();
3737
3738 if ( $o->get('explain-hosts') ) {
3739@@ -11947,10 +11972,10 @@
3740 # ########################################################################
3741 # Do the version-check
3742 # ########################################################################
3743- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
3744+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
3745 Pingback::version_check(
3746- map({ +{ dbh => $_->{dbh}, dsn => $_->{dsn} } } @$hosts),
3747- { protocol => $o->get('version-check') },
3748+ instances => [ map({ +{ dbh => $_->{dbh}, dsn => $_->{dsn} } } @$hosts) ],
3749+ protocol => $o->get('version-check'),
3750 );
3751 }
3752
3753@@ -12884,14 +12909,20 @@
3754
3755 =item --version-check
3756
3757-type: string; value_is_optional: yes; default: https
3758+type: string; default: off
3759
3760 Send program versions to Percona and print suggested upgrades and problems.
3761-
3762-If specified without a value, it will use https by default; However, this
3763-might fail if C<IO::Socket::SSL> is not installed on your system, in which
3764-case you may choose to use C<--version-check http>, which will forgo
3765-encryption but should work out of the box.
3766+Possible values for --version-check:
3767+
3768+=for comment ignore-pt-internal-value
3769+MAGIC_version_check
3770+
3771+https, http, auto, off
3772+
3773+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
3774+Keep in mind that C<https> might not be available if
3775+C<IO::Socket::SSL> is not installed on your system, although
3776+C<--version-check http> should work everywhere.
3777
3778 The version check feature causes the tool to send and receive data from
3779 Percona over the web. The data contains program versions from the local
3780
3781=== modified file 'bin/pt-variable-advisor'
3782--- bin/pt-variable-advisor 2012-10-31 09:18:34 +0000
3783+++ bin/pt-variable-advisor 2012-11-06 15:04:24 +0000
3784@@ -87,7 +87,6 @@
3785 'default' => 1,
3786 'cumulative' => 1,
3787 'negatable' => 1,
3788- 'value_is_optional' => 1,
3789 );
3790
3791 my $self = {
3792@@ -329,10 +328,9 @@
3793 $opt->{short} = undef;
3794 }
3795
3796- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
3797- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
3798- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
3799- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
3800+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
3801+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
3802+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
3803
3804 $opt->{group} ||= 'default';
3805 $self->{groups}->{ $opt->{group} }->{$long} = 1;
3806@@ -468,7 +466,7 @@
3807 if ( $opt->{is_cumulative} ) {
3808 $opt->{value}++;
3809 }
3810- elsif ( !($opt->{optional_value} && !$val) ) {
3811+ else {
3812 $opt->{value} = $val;
3813 }
3814 $opt->{got} = 1;
3815@@ -1009,12 +1007,11 @@
3816 sub _parse_attribs {
3817 my ( $self, $option, $attribs ) = @_;
3818 my $types = $self->{types};
3819- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
3820 return $option
3821 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
3822 . ($attribs->{'negatable'} ? '!' : '' )
3823 . ($attribs->{'cumulative'} ? '+' : '' )
3824- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
3825+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
3826 }
3827
3828 sub _parse_synopsis {
3829@@ -4426,14 +4423,19 @@
3830 };
3831
3832 sub version_check {
3833- my $args = pop @_;
3834- my (@instances) = @_;
3835+ my %args = @_;
3836+ my @instances = $args{instances} ? @{ $args{instances} } : ();
3837
3838 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
3839- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
3840+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
3841 "environment variable.\n\n";
3842 return;
3843 }
3844+
3845+ $args{protocol} ||= 'https';
3846+ my @protocols = $args{protocol} eq 'auto'
3847+ ? qw(https http)
3848+ : $args{protocol};
3849
3850 my $instances_to_check = [];
3851 my $time = int(time());
3852@@ -4448,22 +4450,28 @@
3853 ($time_to_check, $instances_to_check)
3854 = time_to_check($check_time_file, \@instances, $time);
3855 if ( !$time_to_check ) {
3856- print STDERR 'It is not time to --version-check again; ',
3857+ warn 'It is not time to --version-check again; ',
3858 "only 1 check per day.\n\n";
3859 return;
3860 }
3861
3862- my $protocol = $args->{protocol} || 'https';
3863- my $advice = pingback(
3864- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
3865- instances => $instances_to_check,
3866- protocol => $args->{protocol},
3867- );
3868+ my $advice;
3869+ my $e;
3870+ for my $protocol ( @protocols ) {
3871+ $advice = eval { pingback(
3872+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
3873+ instances => $instances_to_check,
3874+ protocol => $protocol,
3875+ ) };
3876+ last if !$advice && !$EVAL_ERROR;
3877+ $e ||= $EVAL_ERROR;
3878+ }
3879 if ( $advice ) {
3880 print "# Percona suggests these upgrades:\n";
3881 print join("\n", map { "# * $_" } @$advice), "\n\n";
3882 }
3883 else {
3884+ die $e if $e;
3885 print "# No suggestions at this time.\n\n";
3886 ($ENV{PTVCDEBUG} || PTDEBUG )
3887 && _d('--version-check worked, but there were no suggestions');
3888@@ -4489,7 +4497,7 @@
3889
3890 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
3891
3892- $ua ||= HTTPMicro->new( timeout => 2 );
3893+ $ua ||= HTTPMicro->new( timeout => 5 );
3894 $vc ||= VersionCheck->new();
3895
3896 my $response = $ua->request('GET', $url);
3897@@ -4705,6 +4713,21 @@
3898 return $client_response;
3899 }
3900
3901+sub validate_options {
3902+ my ($o) = @_;
3903+
3904+ return if !$o->got('version-check');
3905+
3906+ my $value = $o->get('version-check');
3907+ my @values = split /, /,
3908+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
3909+ chomp(@values);
3910+
3911+ return if grep { $value eq $_ } @values;
3912+ $o->save_error("--version-check invalid value $value. Accepted values are "
3913+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
3914+}
3915+
3916 sub _d {
3917 my ($package, undef, $line) = caller 0;
3918 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
3919@@ -4761,6 +4784,8 @@
3920 }
3921 }
3922
3923+ Pingback::validate_options($o);
3924+
3925 $o->usage_or_errors();
3926
3927 # #########################################################################
3928@@ -4835,10 +4860,10 @@
3929 # ########################################################################
3930 # Do the version-check
3931 # ########################################################################
3932- if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
3933+ if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
3934 Pingback::version_check(
3935- ($dbh ? { dbh => $dbh, dsn => $dsn } : ()),
3936- { protocol => $o->get('version-check') },
3937+ instances => [ ($dbh ? { dbh => $dbh, dsn => $dsn } : ()) ],
3938+ protocol => $o->get('version-check'),
3939 );
3940 }
3941
3942@@ -5667,14 +5692,20 @@
3943
3944 =item --version-check
3945
3946-type: string; value_is_optional: yes; default: https
3947+type: string; default: off
3948
3949 Send program versions to Percona and print suggested upgrades and problems.
3950-
3951-If specified without a value, it will use https by default; However, this
3952-might fail if C<IO::Socket::SSL> is not installed on your system, in which
3953-case you may choose to use C<--version-check http>, which will forgo
3954-encryption but should work out of the box.
3955+Possible values for --version-check:
3956+
3957+=for comment ignore-pt-internal-value
3958+MAGIC_version_check
3959+
3960+https, http, auto, off
3961+
3962+C<auto> first tries using C<https>, and resorts to C<http> if that fails.
3963+Keep in mind that C<https> might not be available if
3964+C<IO::Socket::SSL> is not installed on your system, although
3965+C<--version-check http> should work everywhere.
3966
3967 The version check feature causes the tool to send and receive data from
3968 Percona over the web. The data contains program versions from the local
3969
3970=== modified file 'lib/OptionParser.pm'
3971--- lib/OptionParser.pm 2012-10-22 17:43:33 +0000
3972+++ lib/OptionParser.pm 2012-11-06 15:04:24 +0000
3973@@ -107,7 +107,6 @@
3974 'default' => 1,
3975 'cumulative' => 1,
3976 'negatable' => 1,
3977- 'value_is_optional' => 1,
3978 );
3979
3980 my $self = {
3981@@ -414,10 +413,9 @@
3982 $opt->{short} = undef;
3983 }
3984
3985- $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
3986- $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
3987- $opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
3988- $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
3989+ $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
3990+ $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
3991+ $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
3992
3993 $opt->{group} ||= 'default';
3994 $self->{groups}->{ $opt->{group} }->{$long} = 1;
3995@@ -600,7 +598,7 @@
3996 if ( $opt->{is_cumulative} ) {
3997 $opt->{value}++;
3998 }
3999- elsif ( !($opt->{optional_value} && !$val) ) {
4000+ else {
4001 $opt->{value} = $val;
4002 }
4003 $opt->{got} = 1;
4004@@ -1275,12 +1273,11 @@
4005 sub _parse_attribs {
4006 my ( $self, $option, $attribs ) = @_;
4007 my $types = $self->{types};
4008- my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
4009 return $option
4010 . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
4011 . ($attribs->{'negatable'} ? '!' : '' )
4012 . ($attribs->{'cumulative'} ? '+' : '' )
4013- . ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
4014+ . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
4015 }
4016
4017 sub _parse_synopsis {
4018
4019=== modified file 'lib/Pingback.pm'
4020--- lib/Pingback.pm 2012-09-24 19:24:11 +0000
4021+++ lib/Pingback.pm 2012-11-06 15:04:24 +0000
4022@@ -55,17 +55,25 @@
4023 };
4024
4025 sub version_check {
4026- my $args = pop @_;
4027- my (@instances) = @_;
4028+ my %args = @_;
4029+ my @instances = $args{instances} ? @{ $args{instances} } : ();
4030 # If this blows up, oh well, don't bother the user about it.
4031 # This feature is a "best effort" only; we don't want it to
4032 # get in the way of the tool's real work.
4033
4034 if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
4035- print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
4036+ warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
4037 "environment variable.\n\n";
4038 return;
4039 }
4040+
4041+ # we got here if the protocol wasn't "off", and the values
4042+ # were validated earlier, so just handle auto
4043+ # This line is mostly here for the test suite:
4044+ $args{protocol} ||= 'https';
4045+ my @protocols = $args{protocol} eq 'auto'
4046+ ? qw(https http)
4047+ : $args{protocol};
4048
4049 my $instances_to_check = [];
4050 my $time = int(time());
4051@@ -82,22 +90,29 @@
4052 ($time_to_check, $instances_to_check)
4053 = time_to_check($check_time_file, \@instances, $time);
4054 if ( !$time_to_check ) {
4055- print STDERR 'It is not time to --version-check again; ',
4056+ warn 'It is not time to --version-check again; ',
4057 "only 1 check per day.\n\n";
4058 return;
4059 }
4060
4061- my $protocol = $args->{protocol} || 'https';
4062- my $advice = pingback(
4063- url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
4064- instances => $instances_to_check,
4065- protocol => $args->{protocol},
4066- );
4067+ my $advice;
4068+ my $e;
4069+ for my $protocol ( @protocols ) {
4070+ $advice = eval { pingback(
4071+ url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
4072+ instances => $instances_to_check,
4073+ protocol => $protocol,
4074+ ) };
4075+ # No advice, and no error, so no reason to keep trying.
4076+ last if !$advice && !$EVAL_ERROR;
4077+ $e ||= $EVAL_ERROR;
4078+ }
4079 if ( $advice ) {
4080 print "# Percona suggests these upgrades:\n";
4081 print join("\n", map { "# * $_" } @$advice), "\n\n";
4082 }
4083 else {
4084+ die $e if $e;
4085 print "# No suggestions at this time.\n\n";
4086 ($ENV{PTVCDEBUG} || PTDEBUG )
4087 && _d('--version-check worked, but there were no suggestions');
4088@@ -124,7 +139,7 @@
4089 # Optional args
4090 my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
4091
4092- $ua ||= HTTPMicro->new( timeout => 2 );
4093+ $ua ||= HTTPMicro->new( timeout => 5 );
4094 $vc ||= VersionCheck->new();
4095
4096 # GET https://upgrade.percona.com, the server will return
4097@@ -393,6 +408,22 @@
4098 return $client_response;
4099 }
4100
4101+sub validate_options {
4102+ my ($o) = @_;
4103+
4104+ # No need to validate anything if we didn't get an explicit v-c
4105+ return if !$o->got('version-check');
4106+
4107+ my $value = $o->get('version-check');
4108+ my @values = split /, /,
4109+ $o->read_para_after(__FILE__, qr/MAGIC_version_check/);
4110+ chomp(@values);
4111+
4112+ return if grep { $value eq $_ } @values;
4113+ $o->save_error("--version-check invalid value $value. Accepted values are "
4114+ . join(", ", @values[0..$#values-1]) . " and $values[-1]" );
4115+}
4116+
4117 sub _d {
4118 my ($package, undef, $line) = caller 0;
4119 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
4120
4121=== modified file 't/lib/OptionParser.t'
4122--- t/lib/OptionParser.t 2012-10-22 18:16:42 +0000
4123+++ t/lib/OptionParser.t 2012-11-06 15:04:24 +0000
4124@@ -145,7 +145,6 @@
4125 type => 's',
4126 got => 0,
4127 value => undef,
4128- optional_value => 0,
4129 },
4130 'port' => {
4131 spec => 'port|p=i',
4132@@ -159,7 +158,6 @@
4133 type => 'i',
4134 got => 0,
4135 value => undef,
4136- optional_value => 0,
4137 },
4138 'price' => {
4139 spec => 'price=f',
4140@@ -173,7 +171,6 @@
4141 type => 'f',
4142 got => 0,
4143 value => undef,
4144- optional_value => 0,
4145 },
4146 'hash-req' => {
4147 spec => 'hash-req=s',
4148@@ -187,7 +184,6 @@
4149 type => 'H',
4150 got => 0,
4151 value => undef,
4152- optional_value => 0,
4153 },
4154 'hash-opt' => {
4155 spec => 'hash-opt=s',
4156@@ -201,7 +197,6 @@
4157 type => 'h',
4158 got => 0,
4159 value => undef,
4160- optional_value => 0,
4161 },
4162 'array-req' => {
4163 spec => 'array-req=s',
4164@@ -215,7 +210,6 @@
4165 type => 'A',
4166 got => 0,
4167 value => undef,
4168- optional_value => 0,
4169 },
4170 'array-opt' => {
4171 spec => 'array-opt=s',
4172@@ -229,7 +223,6 @@
4173 type => 'a',
4174 got => 0,
4175 value => undef,
4176- optional_value => 0,
4177 },
4178 'host' => {
4179 spec => 'host=s',
4180@@ -243,7 +236,6 @@
4181 type => 'd',
4182 got => 0,
4183 value => undef,
4184- optional_value => 0,
4185 },
4186 'chunk-size' => {
4187 spec => 'chunk-size=s',
4188@@ -257,7 +249,6 @@
4189 type => 'z',
4190 got => 0,
4191 value => undef,
4192- optional_value => 0,
4193 },
4194 'time' => {
4195 spec => 'time=s',
4196@@ -271,7 +262,6 @@
4197 type => 'm',
4198 got => 0,
4199 value => undef,
4200- optional_value => 0,
4201 },
4202 'help' => {
4203 spec => 'help+',
4204@@ -285,7 +275,6 @@
4205 type => undef,
4206 got => 0,
4207 value => undef,
4208- optional_value => 0,
4209 },
4210 'other' => {
4211 spec => 'other!',
4212@@ -299,7 +288,6 @@
4213 type => undef,
4214 got => 0,
4215 value => undef,
4216- optional_value => 0,
4217 }
4218 },
4219 'Parse opt specs'
4220@@ -520,7 +508,6 @@
4221 type => undef,
4222 got => 0,
4223 value => undef,
4224- optional_value => 0,
4225 },
4226 'defaultset' => {
4227 spec => 'defaultset!',
4228@@ -536,7 +523,6 @@
4229 type => undef,
4230 got => 0,
4231 value => undef,
4232- optional_value => 0,
4233 },
4234 'defaults-file' => {
4235 spec => 'defaults-file|F=s',
4236@@ -550,7 +536,6 @@
4237 type => 's',
4238 got => 0,
4239 value => undef,
4240- optional_value => 0,
4241 },
4242 'dog' => {
4243 spec => 'dog|D=s',
4244@@ -564,7 +549,6 @@
4245 type => 's',
4246 got => 0,
4247 value => undef,
4248- optional_value => 0,
4249 },
4250 'love' => {
4251 spec => 'love|l+',
4252@@ -578,7 +562,6 @@
4253 type => undef,
4254 got => 0,
4255 value => undef,
4256- optional_value => 0,
4257 },
4258 },
4259 'Parse dog specs'
4260@@ -978,7 +961,6 @@
4261 long => 'bar',
4262 type => undef,
4263 parsed => 1,
4264- optional_value=> 0,
4265 },
4266 'Disabled opt is not destroyed'
4267 );
4268@@ -2008,55 +1990,13 @@
4269 $output = output(
4270 sub { $o->usage_or_errors(undef, 1); },
4271 );
4272+$synop{usage} =~ s/([\[\]])/\\$1/g;
4273 like(
4274 $output,
4275- qr/^$synop{description} For more details.+\nUsage: \Q$synop{usage}\E\n?$/m,
4276+ qr/^$synop{description} For more details.+\nUsage: $synop{usage}$/m,
4277 "Uses desc and usage from SYNOPSIS for help"
4278 );
4279
4280-# Add a value_is_optional option
4281-@ARGV = qw();
4282-$o->get_opts();
4283-
4284-ok(
4285- !$o->got('version-check'),
4286- "version-check is not true by default"
4287-);
4288-
4289-is(
4290- $o->get('version-check'),
4291- "https",
4292- "..but it still has a value",
4293-);
4294-
4295-@ARGV = qw(--version-check);
4296-$o->get_opts();
4297-
4298-ok(
4299- $o->got('version-check'),
4300- "version-check is true if specified without arguments"
4301-);
4302-
4303-is(
4304- $o->get('version-check'),
4305- "https",
4306- "..and has the default value",
4307-);
4308-
4309-@ARGV = qw(--version-check http);
4310-$o->get_opts();
4311-
4312-ok(
4313- $o->got('version-check'),
4314- "version-check is true if specified with arguments"
4315-);
4316-
4317-is(
4318- $o->get('version-check'),
4319- "http",
4320- "..and has the specified value",
4321-);
4322-
4323 # #############################################################################
4324 # Bug 1039074: Tools exit 0 on error parsing options, should exit non-zero
4325 # #############################################################################
4326@@ -2094,3 +2034,4 @@
4327 );
4328
4329 done_testing;
4330+exit;
4331
4332=== modified file 't/lib/Pingback.t'
4333--- t/lib/Pingback.t 2012-10-06 17:39:02 +0000
4334+++ t/lib/Pingback.t 2012-11-06 15:04:24 +0000
4335@@ -510,6 +510,24 @@
4336 }
4337
4338 # #############################################################################
4339+# Check that the --v-c OPT validation works everywhere
4340+# #############################################################################
4341+
4342+use File::Basename qw(basename);
4343+
4344+my @vc_tools = grep { chomp; basename($_) =~ /\A[a-z-]+\z/ }
4345+ `grep --files-with-matches Pingback $trunk/bin/*`;
4346+
4347+foreach my $tool ( @vc_tools ) {
4348+ my $output = `$tool --version-check ftp`;
4349+ like(
4350+ $output,
4351+ qr/\Q* --version-check invalid value ftp. Accepted values are https, http, auto and off/,
4352+ "Valid values for v-c are checked in $tool"
4353+ );
4354+}
4355+
4356+# #############################################################################
4357 # Done.
4358 # #############################################################################
4359 $sb->wipe_clean($master_dbh) if $master_dbh;
4360
4361=== modified file 't/pt-query-digest/version_check.t'
4362--- t/pt-query-digest/version_check.t 2012-09-24 20:12:53 +0000
4363+++ t/pt-query-digest/version_check.t 2012-11-06 15:04:24 +0000
4364@@ -109,6 +109,19 @@
4365 "percona-toolkit-version-check file not created with --no-version-check"
4366 );
4367
4368+$output = `PTVCDEBUG=1 $cmd --version-check off @args 2>&1`;
4369+
4370+unlike(
4371+ $output,
4372+ qr/(?:VersionCheck|Pingback|Percona suggests)/,
4373+ "Looks like --version-check off disabled the version-check"
4374+) or diag($output);
4375+
4376+ok(
4377+ !-f $check_time_file,
4378+ "percona-toolkit-version-check file not created with --version-check off"
4379+);
4380+
4381 # PERCONA_VERSION_CHECK=0 is handled in Pingback, so it will print a line
4382 # for PTVCDEBUG saying why it didn't run. So we just check that it doesn't
4383 # create the file which also signifies that it didn't run.

Subscribers

People subscribed via source and target branches