~percona-toolkit-dev/percona-toolkit/pt-duplicate-key-checker-docs-dont-explain-how-Size-Duplicate-Indexes-is-calculated-1415646
» Revision
594
: bin/pt-diskstats
« back to all changes in this revision
Viewing changes to bin/pt-diskstats
- browse files at revision 594
- compare with another revision
- download diff
- download tarball
- view history from revision 594
- Committer: Daniel Nichter
- Date: 2014-02-20 03:00:02 UTC
- Revision ID: daniel@percona.com-20140220030002-gsj22qr101mb2fbp
Remove version check bin type. Update all tools.
- files modified:
- bin/pt-agent
added
removed
bin/pt-diskstats
22
22
DiskstatsGroupByDisk
23
23
DiskstatsGroupBySample
24
24
DiskstatsMenu
25
HTTPMicro
25
HTTP::Micro
26
26
VersionCheck
27
27
));
28
28
}
3606
3606
# ###########################################################################
3607
3607
3608
3608
# ###########################################################################
3609
# HTTPMicro package
3609
# HTTP::Micro package
3610
3610
# This package is a copy without comments from the original. The original
3611
3611
# with comments and its test file can be found in the Bazaar repository at,
3612
# lib/HTTPMicro.pm
3613
# t/lib/HTTPMicro.t
3612
# lib/HTTP/Micro.pm
3613
# t/lib/HTTP/Micro.t
3614
3614
# See https://launchpad.net/percona-toolkit for more information.
3615
3615
# ###########################################################################
3616
3616
{
3617
3618
package HTTPMicro;
3619
BEGIN {
3620
$HTTPMicro::VERSION = '0.001';
3621
}
3617
package HTTP::Micro;
3618
3619
our $VERSION = '0.01';
3620
3622
3621
use strict;
3623
use warnings;
3624
3622
use warnings FATAL => 'all';
3623
use English qw(-no_match_vars);
3625
3624
use Carp ();
3626
3625
3627
3628
3626
my @attributes;
3629
3627
BEGIN {
3630
3628
@attributes = qw(agent timeout);
3695
3693
headers => {},
3696
3694
};
3697
3695
3698
my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout});
3696
my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout});
3699
3697
3700
3698
$handle->connect($scheme, $host, $port);
3701
3699
3760
3758
return ($scheme, $host, $port, $path_query);
3761
3759
}
3762
3760
3763
package
3764
HTTPMicro::Handle; # hide from PAUSE/indexers
3765
use strict;
3766
use warnings;
3767
3768
use Carp qw[croak];
3769
use Errno qw[EINTR EPIPE];
3770
use IO::Socket qw[SOCK_STREAM];
3771
3772
sub BUFSIZE () { 32768 }
3773
3774
my $Printable = sub {
3775
local $_ = shift;
3776
s/\r/\\r/g;
3777
s/\n/\\n/g;
3778
s/\t/\\t/g;
3779
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
3780
$_;
3781
};
3782
3783
sub new {
3784
my ($class, %args) = @_;
3785
return bless {
3786
rbuf => '',
3787
timeout => 60,
3788
max_line_size => 16384,
3789
%args
3790
}, $class;
3791
}
3792
3793
my $ssl_verify_args = {
3794
check_cn => "when_only",
3795
wildcards_in_alt => "anywhere",
3796
wildcards_in_cn => "anywhere"
3797
};
3798
3799
sub connect {
3800
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
3801
my ($self, $scheme, $host, $port) = @_;
3802
3803
if ( $scheme eq 'https' ) {
3804
eval "require IO::Socket::SSL"
3805
unless exists $INC{'IO/Socket/SSL.pm'};
3806
croak(qq/IO::Socket::SSL must be installed for https support\n/)
3807
unless $INC{'IO/Socket/SSL.pm'};
3808
}
3809
elsif ( $scheme ne 'http' ) {
3810
croak(qq/Unsupported URL scheme '$scheme'\n/);
3811
}
3812
3813
$self->{fh} = 'IO::Socket::INET'->new(
3814
PeerHost => $host,
3815
PeerPort => $port,
3816
Proto => 'tcp',
3817
Type => SOCK_STREAM,
3818
Timeout => $self->{timeout}
3819
) or croak(qq/Could not connect to '$host:$port': $@/);
3820
3821
binmode($self->{fh})
3822
or croak(qq/Could not binmode() socket: '$!'/);
3823
3824
if ( $scheme eq 'https') {
3825
IO::Socket::SSL->start_SSL($self->{fh});
3826
ref($self->{fh}) eq 'IO::Socket::SSL'
3827
or die(qq/SSL connection failed for $host\n/);
3828
if ( $self->{fh}->can("verify_hostname") ) {
3829
$self->{fh}->verify_hostname( $host, $ssl_verify_args );
3830
}
3831
else {
3832
my $fh = $self->{fh};
3833
_verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
3834
or die(qq/SSL certificate not valid for $host\n/);
3835
}
3836
}
3837
3838
$self->{host} = $host;
3839
$self->{port} = $port;
3840
3841
return $self;
3842
}
3843
3844
sub close {
3845
@_ == 1 || croak(q/Usage: $handle->close()/);
3846
my ($self) = @_;
3847
CORE::close($self->{fh})
3848
or croak(qq/Could not close socket: '$!'/);
3849
}
3850
3851
sub write {
3852
@_ == 2 || croak(q/Usage: $handle->write(buf)/);
3853
my ($self, $buf) = @_;
3854
3855
my $len = length $buf;
3856
my $off = 0;
3857
3858
local $SIG{PIPE} = 'IGNORE';
3859
3860
while () {
3861
$self->can_write
3862
or croak(q/Timed out while waiting for socket to become ready for writing/);
3863
my $r = syswrite($self->{fh}, $buf, $len, $off);
3864
if (defined $r) {
3865
$len -= $r;
3866
$off += $r;
3867
last unless $len > 0;
3868
}
3869
elsif ($! == EPIPE) {
3870
croak(qq/Socket closed by remote server: $!/);
3871
}
3872
elsif ($! != EINTR) {
3873
croak(qq/Could not write to socket: '$!'/);
3874
}
3875
}
3876
return $off;
3877
}
3878
3879
sub read {
3880
@_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
3881
my ($self, $len) = @_;
3882
3883
my $buf = '';
3884
my $got = length $self->{rbuf};
3885
3886
if ($got) {
3887
my $take = ($got < $len) ? $got : $len;
3888
$buf = substr($self->{rbuf}, 0, $take, '');
3889
$len -= $take;
3890
}
3891
3892
while ($len > 0) {
3893
$self->can_read
3894
or croak(q/Timed out while waiting for socket to become ready for reading/);
3895
my $r = sysread($self->{fh}, $buf, $len, length $buf);
3896
if (defined $r) {
3897
last unless $r;
3898
$len -= $r;
3899
}
3900
elsif ($! != EINTR) {
3901
croak(qq/Could not read from socket: '$!'/);
3902
}
3903
}
3904
if ($len) {
3905
croak(q/Unexpected end of stream/);
3906
}
3907
return $buf;
3908
}
3909
3910
sub readline {
3911
@_ == 1 || croak(q/Usage: $handle->readline()/);
3912
my ($self) = @_;
3913
3914
while () {
3915
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
3916
return $1;
3917
}
3918
$self->can_read
3919
or croak(q/Timed out while waiting for socket to become ready for reading/);
3920
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
3921
if (defined $r) {
3922
last unless $r;
3923
}
3924
elsif ($! != EINTR) {
3925
croak(qq/Could not read from socket: '$!'/);
3926
}
3927
}
3928
croak(q/Unexpected end of stream while looking for line/);
3929
}
3930
3931
sub read_header_lines {
3932
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
3933
my ($self, $headers) = @_;
3934
$headers ||= {};
3935
my $lines = 0;
3936
my $val;
3937
3938
while () {
3939
my $line = $self->readline;
3940
3941
if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
3942
my ($field_name) = lc $1;
3943
$val = \($headers->{$field_name} = $2);
3944
}
3945
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
3946
$val
3947
or croak(q/Unexpected header continuation line/);
3948
next unless length $1;
3949
$$val .= ' ' if length $$val;
3950
$$val .= $1;
3951
}
3952
elsif ($line =~ /\A \x0D?\x0A \z/x) {
3953
last;
3954
}
3955
else {
3956
croak(q/Malformed header line: / . $Printable->($line));
3957
}
3958
}
3959
return $headers;
3960
}
3961
3962
sub write_header_lines {
3963
(@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
3964
my($self, $headers) = @_;
3965
3966
my $buf = '';
3967
while (my ($k, $v) = each %$headers) {
3968
my $field_name = lc $k;
3969
$field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
3970
or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
3971
$field_name =~ s/\b(\w)/\u$1/g;
3972
$buf .= "$field_name: $v\x0D\x0A";
3973
}
3974
$buf .= "\x0D\x0A";
3975
return $self->write($buf);
3976
}
3977
3978
sub read_content_body {
3979
@_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
3980
my ($self, $cb, $response, $len) = @_;
3981
$len ||= $response->{headers}{'content-length'};
3982
3983
croak("No content-length in the returned response, and this "
3984
. "UA doesn't implement chunking") unless defined $len;
3985
3986
while ($len > 0) {
3987
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
3988
$cb->($self->read($read), $response);
3989
$len -= $read;
3990
}
3991
3992
return;
3993
}
3994
3995
sub write_content_body {
3996
@_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
3997
my ($self, $request) = @_;
3998
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
3999
4000
$len += $self->write($request->{content});
4001
4002
$len == $content_length
4003
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
4004
4005
return $len;
4006
}
4007
4008
sub read_response_header {
4009
@_ == 1 || croak(q/Usage: $handle->read_response_header()/);
4010
my ($self) = @_;
4011
4012
my $line = $self->readline;
4013
4014
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
4015
or croak(q/Malformed Status-Line: / . $Printable->($line));
4016
4017
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
4018
4019
return {
4020
status => $status,
4021
reason => $reason,
4022
headers => $self->read_header_lines,
4023
protocol => $protocol,
4024
};
4025
}
4026
4027
sub write_request_header {
4028
@_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
4029
my ($self, $method, $request_uri, $headers) = @_;
4030
4031
return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
4032
+ $self->write_header_lines($headers);
4033
}
4034
4035
sub _do_timeout {
4036
my ($self, $type, $timeout) = @_;
4037
$timeout = $self->{timeout}
4038
unless defined $timeout && $timeout >= 0;
4039
4040
my $fd = fileno $self->{fh};
4041
defined $fd && $fd >= 0
4042
or croak(q/select(2): 'Bad file descriptor'/);
4043
4044
my $initial = time;
4045
my $pending = $timeout;
4046
my $nfound;
4047
4048
vec(my $fdset = '', $fd, 1) = 1;
4049
4050
while () {
4051
$nfound = ($type eq 'read')
4052
? select($fdset, undef, undef, $pending)
4053
: select(undef, $fdset, undef, $pending) ;
4054
if ($nfound == -1) {
4055
$! == EINTR
4056
or croak(qq/select(2): '$!'/);
4057
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
4058
$nfound = 0;
4059
}
4060
last;
4061
}
4062
$! = 0;
4063
return $nfound;
4064
}
4065
4066
sub can_read {
4067
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
4068
my $self = shift;
4069
return $self->_do_timeout('read', @_)
4070
}
4071
4072
sub can_write {
4073
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
4074
my $self = shift;
4075
return $self->_do_timeout('write', @_)
4076
}
3761
} # HTTP::Micro
3762
3763
{
3764
package HTTP::Micro::Handle;
3765
3766
use strict;
3767
use warnings FATAL => 'all';
3768
use English qw(-no_match_vars);
3769
3770
use Carp qw(croak);
3771
use Errno qw(EINTR EPIPE);
3772
use IO::Socket qw(SOCK_STREAM);
3773
3774
sub BUFSIZE () { 32768 }
3775
3776
my $Printable = sub {
3777
local $_ = shift;
3778
s/\r/\\r/g;
3779
s/\n/\\n/g;
3780
s/\t/\\t/g;
3781
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
3782
$_;
3783
};
3784
3785
sub new {
3786
my ($class, %args) = @_;
3787
return bless {
3788
rbuf => '',
3789
timeout => 60,
3790
max_line_size => 16384,
3791
%args
3792
}, $class;
3793
}
3794
3795
my $ssl_verify_args = {
3796
check_cn => "when_only",
3797
wildcards_in_alt => "anywhere",
3798
wildcards_in_cn => "anywhere"
3799
};
3800
3801
sub connect {
3802
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
3803
my ($self, $scheme, $host, $port) = @_;
3804
3805
if ( $scheme eq 'https' ) {
3806
eval "require IO::Socket::SSL"
3807
unless exists $INC{'IO/Socket/SSL.pm'};
3808
croak(qq/IO::Socket::SSL must be installed for https support\n/)
3809
unless $INC{'IO/Socket/SSL.pm'};
3810
}
3811
elsif ( $scheme ne 'http' ) {
3812
croak(qq/Unsupported URL scheme '$scheme'\n/);
3813
}
3814
3815
$self->{fh} = IO::Socket::INET->new(
3816
PeerHost => $host,
3817
PeerPort => $port,
3818
Proto => 'tcp',
3819
Type => SOCK_STREAM,
3820
Timeout => $self->{timeout}
3821
) or croak(qq/Could not connect to '$host:$port': $@/);
3822
3823
binmode($self->{fh})
3824
or croak(qq/Could not binmode() socket: '$!'/);
3825
3826
if ( $scheme eq 'https') {
3827
IO::Socket::SSL->start_SSL($self->{fh});
3828
ref($self->{fh}) eq 'IO::Socket::SSL'
3829
or die(qq/SSL connection failed for $host\n/);
3830
if ( $self->{fh}->can("verify_hostname") ) {
3831
$self->{fh}->verify_hostname( $host, $ssl_verify_args );
3832
}
3833
else {
3834
my $fh = $self->{fh};
3835
_verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
3836
or die(qq/SSL certificate not valid for $host\n/);
3837
}
3838
}
3839
3840
$self->{host} = $host;
3841
$self->{port} = $port;
3842
3843
return $self;
3844
}
3845
3846
sub close {
3847
@_ == 1 || croak(q/Usage: $handle->close()/);
3848
my ($self) = @_;
3849
CORE::close($self->{fh})
3850
or croak(qq/Could not close socket: '$!'/);
3851
}
3852
3853
sub write {
3854
@_ == 2 || croak(q/Usage: $handle->write(buf)/);
3855
my ($self, $buf) = @_;
3856
3857
my $len = length $buf;
3858
my $off = 0;
3859
3860
local $SIG{PIPE} = 'IGNORE';
3861
3862
while () {
3863
$self->can_write
3864
or croak(q/Timed out while waiting for socket to become ready for writing/);
3865
my $r = syswrite($self->{fh}, $buf, $len, $off);
3866
if (defined $r) {
3867
$len -= $r;
3868
$off += $r;
3869
last unless $len > 0;
3870
}
3871
elsif ($! == EPIPE) {
3872
croak(qq/Socket closed by remote server: $!/);
3873
}
3874
elsif ($! != EINTR) {
3875
croak(qq/Could not write to socket: '$!'/);
3876
}
3877
}
3878
return $off;
3879
}
3880
3881
sub read {
3882
@_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
3883
my ($self, $len) = @_;
3884
3885
my $buf = '';
3886
my $got = length $self->{rbuf};
3887
3888
if ($got) {
3889
my $take = ($got < $len) ? $got : $len;
3890
$buf = substr($self->{rbuf}, 0, $take, '');
3891
$len -= $take;
3892
}
3893
3894
while ($len > 0) {
3895
$self->can_read
3896
or croak(q/Timed out while waiting for socket to become ready for reading/);
3897
my $r = sysread($self->{fh}, $buf, $len, length $buf);
3898
if (defined $r) {
3899
last unless $r;
3900
$len -= $r;
3901
}
3902
elsif ($! != EINTR) {
3903
croak(qq/Could not read from socket: '$!'/);
3904
}
3905
}
3906
if ($len) {
3907
croak(q/Unexpected end of stream/);
3908
}
3909
return $buf;
3910
}
3911
3912
sub readline {
3913
@_ == 1 || croak(q/Usage: $handle->readline()/);
3914
my ($self) = @_;
3915
3916
while () {
3917
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
3918
return $1;
3919
}
3920
$self->can_read
3921
or croak(q/Timed out while waiting for socket to become ready for reading/);
3922
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
3923
if (defined $r) {
3924
last unless $r;
3925
}
3926
elsif ($! != EINTR) {
3927
croak(qq/Could not read from socket: '$!'/);
3928
}
3929
}
3930
croak(q/Unexpected end of stream while looking for line/);
3931
}
3932
3933
sub read_header_lines {
3934
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
3935
my ($self, $headers) = @_;
3936
$headers ||= {};
3937
my $lines = 0;
3938
my $val;
3939
3940
while () {
3941
my $line = $self->readline;
3942
3943
if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
3944
my ($field_name) = lc $1;
3945
$val = \($headers->{$field_name} = $2);
3946
}
3947
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
3948
$val
3949
or croak(q/Unexpected header continuation line/);
3950
next unless length $1;
3951
$$val .= ' ' if length $$val;
3952
$$val .= $1;
3953
}
3954
elsif ($line =~ /\A \x0D?\x0A \z/x) {
3955
last;
3956
}
3957
else {
3958
croak(q/Malformed header line: / . $Printable->($line));
3959
}
3960
}
3961
return $headers;
3962
}
3963
3964
sub write_header_lines {
3965
(@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
3966
my($self, $headers) = @_;
3967
3968
my $buf = '';
3969
while (my ($k, $v) = each %$headers) {
3970
my $field_name = lc $k;
3971
$field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
3972
or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
3973
$field_name =~ s/\b(\w)/\u$1/g;
3974
$buf .= "$field_name: $v\x0D\x0A";
3975
}
3976
$buf .= "\x0D\x0A";
3977
return $self->write($buf);
3978
}
3979
3980
sub read_content_body {
3981
@_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
3982
my ($self, $cb, $response, $len) = @_;
3983
$len ||= $response->{headers}{'content-length'};
3984
3985
croak("No content-length in the returned response, and this "
3986
. "UA doesn't implement chunking") unless defined $len;
3987
3988
while ($len > 0) {
3989
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
3990
$cb->($self->read($read), $response);
3991
$len -= $read;
3992
}
3993
3994
return;
3995
}
3996
3997
sub write_content_body {
3998
@_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
3999
my ($self, $request) = @_;
4000
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
4001
4002
$len += $self->write($request->{content});
4003
4004
$len == $content_length
4005
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
4006
4007
return $len;
4008
}
4009
4010
sub read_response_header {
4011
@_ == 1 || croak(q/Usage: $handle->read_response_header()/);
4012
my ($self) = @_;
4013
4014
my $line = $self->readline;
4015
4016
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
4017
or croak(q/Malformed Status-Line: / . $Printable->($line));
4018
4019
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
4020
4021
return {
4022
status => $status,
4023
reason => $reason,
4024
headers => $self->read_header_lines,
4025
protocol => $protocol,
4026
};
4027
}
4028
4029
sub write_request_header {
4030
@_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
4031
my ($self, $method, $request_uri, $headers) = @_;
4032
4033
return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
4034
+ $self->write_header_lines($headers);
4035
}
4036
4037
sub _do_timeout {
4038
my ($self, $type, $timeout) = @_;
4039
$timeout = $self->{timeout}
4040
unless defined $timeout && $timeout >= 0;
4041
4042
my $fd = fileno $self->{fh};
4043
defined $fd && $fd >= 0
4044
or croak(q/select(2): 'Bad file descriptor'/);
4045
4046
my $initial = time;
4047
my $pending = $timeout;
4048
my $nfound;
4049
4050
vec(my $fdset = '', $fd, 1) = 1;
4051
4052
while () {
4053
$nfound = ($type eq 'read')
4054
? select($fdset, undef, undef, $pending)
4055
: select(undef, $fdset, undef, $pending) ;
4056
if ($nfound == -1) {
4057
$! == EINTR
4058
or croak(qq/select(2): '$!'/);
4059
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
4060
$nfound = 0;
4061
}
4062
last;
4063
}
4064
$! = 0;
4065
return $nfound;
4066
}
4067
4068
sub can_read {
4069
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
4070
my $self = shift;
4071
return $self->_do_timeout('read', @_)
4072
}
4073
4074
sub can_write {
4075
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
4076
my $self = shift;
4077
return $self->_do_timeout('write', @_)
4078
}
4079
} # HTTP::Micro::Handle
4077
4080
4078
4081
my $prog = <<'EOP';
4079
4082
BEGIN {
4094
4097
}
4095
4098
}
4096
4099
{
4100
use Carp qw(croak);
4097
4101
my %dispatcher = (
4098
4102
issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) },
4099
4103
subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) },
4249
4253
}
4250
4254
4251
4255
1;
4252
}
4253
4256
# ###########################################################################
4254
# End HTTPMicro package
4257
# End HTTP::Micro package
4255
4258
# ###########################################################################
4256
4259
4257
4260
# ###########################################################################
4285
4288
4286
4289
eval {
4287
4290
require Percona::Toolkit;
4288
require HTTPMicro;
4291
require HTTP::Micro;
4289
4292
};
4290
4293
4291
4294
{
4516
4519
my $url = $args{url};
4517
4520
my $instances = $args{instances};
4518
4521
4519
my $ua = $args{ua} || HTTPMicro->new( timeout => 3 );
4522
my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 );
4520
4523
4521
4524
my $response = $ua->request('GET', $url);
4522
4525
PTDEBUG && _d('Server response:', Dumper($response));
4630
4633
perl_version => \&get_perl_version,
4631
4634
perl_module_version => \&get_perl_module_version,
4632
4635
mysql_variable => \&get_mysql_variable,
4633
bin_version => \&get_bin_version,
4634
4636
);
4635
4637
4636
4638
sub valid_item {
4813
4815
return \%version_for;
4814
4816
}
4815
4817
4816
sub get_bin_version {
4817
my (%args) = @_;
4818
my $item = $args{item};
4819
my $cmd = $item->{item};
4820
return unless $cmd;
4821
4822
my $sanitized_command = File::Basename::basename($cmd);
4823
PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command);
4824
return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/;
4825
4826
my $output = `$sanitized_command --version 2>&1`;
4827
PTDEBUG && _d('output:', $output);
4828
4829
my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/;
4830
4831
PTDEBUG && _d('Version for', $sanitized_command, '=', $version);
4832
return $version;
4833
}
4834
4835
4818
sub _d {
4836
4819
my ($package, undef, $line) = caller 0;
4837
4820
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
Loggerhead is a web-based interface for Breezy
Version: 2.0.1