Merged OptionParser-remove-optional_value & updated modules

This commit is contained in:
Brian Fraser
2012-11-09 13:31:13 -03:00
31 changed files with 1272 additions and 671 deletions

View File

@@ -818,7 +818,6 @@ sub new {
'default' => 1,
'cumulative' => 1,
'negatable' => 1,
'value_is_optional' => 1,
);
my $self = {
@@ -1060,10 +1059,9 @@ sub _parse_specs {
$opt->{short} = undef;
}
$opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
$opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
$opt->{optional_value} = $opt->{spec} =~ m/:/ ? 1 : 0;
$opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
$opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0;
$opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0;
$opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0;
$opt->{group} ||= 'default';
$self->{groups}->{ $opt->{group} }->{$long} = 1;
@@ -1199,7 +1197,7 @@ sub _set_option {
if ( $opt->{is_cumulative} ) {
$opt->{value}++;
}
elsif ( !($opt->{optional_value} && !$val) ) {
else {
$opt->{value} = $val;
}
$opt->{got} = 1;
@@ -1740,12 +1738,11 @@ sub _parse_size {
sub _parse_attribs {
my ( $self, $option, $attribs ) = @_;
my $types = $self->{types};
my $eq = $attribs->{'value_is_optional'} ? ':' : '=';
return $option
. ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' )
. ($attribs->{'negatable'} ? '!' : '' )
. ($attribs->{'cumulative'} ? '+' : '' )
. ($attribs->{'type'} ? $eq . $types->{$attribs->{type}} : '' );
. ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' );
}
sub _parse_synopsis {
@@ -4250,14 +4247,19 @@ eval {
};
sub version_check {
my $args = pop @_;
my (@instances) = @_;
my %args = @_;
my @instances = $args{instances} ? @{ $args{instances} } : ();
if (exists $ENV{PERCONA_VERSION_CHECK} && !$ENV{PERCONA_VERSION_CHECK}) {
print STDERR '--version-check is disabled by the PERCONA_VERSION_CHECK ',
warn '--version-check is disabled by the PERCONA_VERSION_CHECK ',
"environment variable.\n\n";
return;
}
$args{protocol} ||= 'https';
my @protocols = $args{protocol} eq 'auto'
? qw(https http)
: $args{protocol};
my $instances_to_check = [];
my $time = int(time());
@@ -4272,22 +4274,28 @@ sub version_check {
($time_to_check, $instances_to_check)
= time_to_check($check_time_file, \@instances, $time);
if ( !$time_to_check ) {
print STDERR 'It is not time to --version-check again; ',
warn 'It is not time to --version-check again; ',
"only 1 check per day.\n\n";
return;
}
my $protocol = $args->{protocol} || 'https';
my $advice = pingback(
url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
instances => $instances_to_check,
protocol => $args->{protocol},
);
my $advice;
my $e;
for my $protocol ( @protocols ) {
$advice = eval { pingback(
url => $ENV{PERCONA_VERSION_CHECK_URL} || "$protocol://v.percona.com",
instances => $instances_to_check,
protocol => $protocol,
) };
last if !$advice && !$EVAL_ERROR;
$e ||= $EVAL_ERROR;
}
if ( $advice ) {
print "# Percona suggests these upgrades:\n";
print join("\n", map { "# * $_" } @$advice), "\n\n";
}
else {
die $e if $e;
print "# No suggestions at this time.\n\n";
($ENV{PTVCDEBUG} || PTDEBUG )
&& _d('--version-check worked, but there were no suggestions');
@@ -4313,7 +4321,7 @@ sub pingback {
my ($instances, $ua, $vc) = @args{qw(instances ua VersionCheck)};
$ua ||= HTTPMicro->new( timeout => 2 );
$ua ||= HTTPMicro->new( timeout => 5 );
$vc ||= VersionCheck->new();
my $response = $ua->request('GET', $url);
@@ -4529,6 +4537,21 @@ sub encode_client_response {
return $client_response;
}
sub validate_options {
my ($o) = @_;
return if !$o->got('version-check');
my $value = $o->get('version-check');
my @values = split /, /,
$o->read_para_after(__FILE__, qr/MAGIC_version_check/);
chomp(@values);
return if grep { $value eq $_ } @values;
$o->save_error("--version-check invalid value $value. Accepted values are "
. join(", ", @values[0..$#values-1]) . " and $values[-1]" );
}
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
@@ -4630,6 +4653,8 @@ sub main {
$o->save_error("Invalid --recursion-method: $EVAL_ERROR")
}
Pingback::validate_options($o);
$o->usage_or_errors();
# ########################################################################
@@ -4980,8 +5005,11 @@ sub main {
# ########################################################################
# Do the version-check
# ########################################################################
if ( $o->got('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) {
Pingback::version_check({dbh => $dbh, dsn => $dsn}, { protocol => $o->get('version-check') });
if ( $o->get('version-check') ne 'off' && (!$o->has('quiet') || !$o->get('quiet')) ) {
Pingback::version_check(
instances => [ {dbh => $dbh, dsn => $dsn} ],
protocol => $o->get('version-check'),
);
}
# ########################################################################
@@ -5713,14 +5741,20 @@ Show version and exit.
=item --version-check
type: string; value_is_optional: yes; default: https
type: string; default: off
Send program versions to Percona and print suggested upgrades and problems.
Possible values for --version-check:
If specified without a value, it will use https by default; However, this
might fail if C<IO::Socket::SSL> is not installed on your system, in which
case you may choose to use C<--version-check http>, which will forgo
encryption but should work out of the box.
=for comment ignore-pt-internal-value
MAGIC_version_check
https, http, auto, off
C<auto> first tries using C<https>, and resorts to C<http> if that fails.
Keep in mind that C<https> might not be available if
C<IO::Socket::SSL> is not installed on your system, although
C<--version-check http> should work everywhere.
The version check feature causes the tool to send and receive data from
Percona over the web. The data contains program versions from the local