« back to all changes in this revision
Viewing changes to bin/pt-table-checksum
- 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-table-checksum
14
14
BEGIN {
15
15
$INC{$_} = __FILE__ for map { (my $pkg = "$_.pm") =~ s!::!/!g; $pkg } (qw(
16
16
Percona::Toolkit
17
HTTPMicro
17
HTTP::Micro
18
18
VersionCheck
19
19
DSNParser
20
20
OptionParser
110
110
# ###########################################################################
111
111
112
112
# ###########################################################################
113
# HTTPMicro package
113
# HTTP::Micro package
114
114
# This package is a copy without comments from the original. The original
115
115
# with comments and its test file can be found in the Bazaar repository at,
116
# lib/HTTPMicro.pm
117
# t/lib/HTTPMicro.t
116
# lib/HTTP/Micro.pm
117
# t/lib/HTTP/Micro.t
118
118
# See https://launchpad.net/percona-toolkit for more information.
119
119
# ###########################################################################
120
120
{
121
122
package HTTPMicro;
123
BEGIN {
124
$HTTPMicro::VERSION = '0.001';
125
}
121
package HTTP::Micro;
122
123
our $VERSION = '0.01';
124
126
125
use strict;
127
use warnings;
128
126
use warnings FATAL => 'all';
127
use English qw(-no_match_vars);
129
128
use Carp ();
130
129
131
132
130
my @attributes;
133
131
BEGIN {
134
132
@attributes = qw(agent timeout);
199
197
headers => {},
200
198
};
201
199
202
my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout});
200
my $handle = HTTP::Micro::Handle->new(timeout => $self->{timeout});
203
201
204
202
$handle->connect($scheme, $host, $port);
205
203
264
262
return ($scheme, $host, $port, $path_query);
265
263
}
266
264
267
package
268
HTTPMicro::Handle; # hide from PAUSE/indexers
269
use strict;
270
use warnings;
271
272
use Carp qw[croak];
273
use Errno qw[EINTR EPIPE];
274
use IO::Socket qw[SOCK_STREAM];
275
276
sub BUFSIZE () { 32768 }
277
278
my $Printable = sub {
279
local $_ = shift;
280
s/\r/\\r/g;
281
s/\n/\\n/g;
282
s/\t/\\t/g;
283
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
284
$_;
285
};
286
287
sub new {
288
my ($class, %args) = @_;
289
return bless {
290
rbuf => '',
291
timeout => 60,
292
max_line_size => 16384,
293
%args
294
}, $class;
295
}
296
297
my $ssl_verify_args = {
298
check_cn => "when_only",
299
wildcards_in_alt => "anywhere",
300
wildcards_in_cn => "anywhere"
301
};
302
303
sub connect {
304
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
305
my ($self, $scheme, $host, $port) = @_;
306
307
if ( $scheme eq 'https' ) {
308
eval "require IO::Socket::SSL"
309
unless exists $INC{'IO/Socket/SSL.pm'};
310
croak(qq/IO::Socket::SSL must be installed for https support\n/)
311
unless $INC{'IO/Socket/SSL.pm'};
312
}
313
elsif ( $scheme ne 'http' ) {
314
croak(qq/Unsupported URL scheme '$scheme'\n/);
315
}
316
317
$self->{fh} = 'IO::Socket::INET'->new(
318
PeerHost => $host,
319
PeerPort => $port,
320
Proto => 'tcp',
321
Type => SOCK_STREAM,
322
Timeout => $self->{timeout}
323
) or croak(qq/Could not connect to '$host:$port': $@/);
324
325
binmode($self->{fh})
326
or croak(qq/Could not binmode() socket: '$!'/);
327
328
if ( $scheme eq 'https') {
329
IO::Socket::SSL->start_SSL($self->{fh});
330
ref($self->{fh}) eq 'IO::Socket::SSL'
331
or die(qq/SSL connection failed for $host\n/);
332
if ( $self->{fh}->can("verify_hostname") ) {
333
$self->{fh}->verify_hostname( $host, $ssl_verify_args );
334
}
335
else {
336
my $fh = $self->{fh};
337
_verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
338
or die(qq/SSL certificate not valid for $host\n/);
339
}
340
}
341
342
$self->{host} = $host;
343
$self->{port} = $port;
344
345
return $self;
346
}
347
348
sub close {
349
@_ == 1 || croak(q/Usage: $handle->close()/);
350
my ($self) = @_;
351
CORE::close($self->{fh})
352
or croak(qq/Could not close socket: '$!'/);
353
}
354
355
sub write {
356
@_ == 2 || croak(q/Usage: $handle->write(buf)/);
357
my ($self, $buf) = @_;
358
359
my $len = length $buf;
360
my $off = 0;
361
362
local $SIG{PIPE} = 'IGNORE';
363
364
while () {
365
$self->can_write
366
or croak(q/Timed out while waiting for socket to become ready for writing/);
367
my $r = syswrite($self->{fh}, $buf, $len, $off);
368
if (defined $r) {
369
$len -= $r;
370
$off += $r;
371
last unless $len > 0;
372
}
373
elsif ($! == EPIPE) {
374
croak(qq/Socket closed by remote server: $!/);
375
}
376
elsif ($! != EINTR) {
377
croak(qq/Could not write to socket: '$!'/);
378
}
379
}
380
return $off;
381
}
382
383
sub read {
384
@_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
385
my ($self, $len) = @_;
386
387
my $buf = '';
388
my $got = length $self->{rbuf};
389
390
if ($got) {
391
my $take = ($got < $len) ? $got : $len;
392
$buf = substr($self->{rbuf}, 0, $take, '');
393
$len -= $take;
394
}
395
396
while ($len > 0) {
397
$self->can_read
398
or croak(q/Timed out while waiting for socket to become ready for reading/);
399
my $r = sysread($self->{fh}, $buf, $len, length $buf);
400
if (defined $r) {
401
last unless $r;
402
$len -= $r;
403
}
404
elsif ($! != EINTR) {
405
croak(qq/Could not read from socket: '$!'/);
406
}
407
}
408
if ($len) {
409
croak(q/Unexpected end of stream/);
410
}
411
return $buf;
412
}
413
414
sub readline {
415
@_ == 1 || croak(q/Usage: $handle->readline()/);
416
my ($self) = @_;
417
418
while () {
419
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
420
return $1;
421
}
422
$self->can_read
423
or croak(q/Timed out while waiting for socket to become ready for reading/);
424
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
425
if (defined $r) {
426
last unless $r;
427
}
428
elsif ($! != EINTR) {
429
croak(qq/Could not read from socket: '$!'/);
430
}
431
}
432
croak(q/Unexpected end of stream while looking for line/);
433
}
434
435
sub read_header_lines {
436
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
437
my ($self, $headers) = @_;
438
$headers ||= {};
439
my $lines = 0;
440
my $val;
441
442
while () {
443
my $line = $self->readline;
444
445
if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
446
my ($field_name) = lc $1;
447
$val = \($headers->{$field_name} = $2);
448
}
449
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
450
$val
451
or croak(q/Unexpected header continuation line/);
452
next unless length $1;
453
$$val .= ' ' if length $$val;
454
$$val .= $1;
455
}
456
elsif ($line =~ /\A \x0D?\x0A \z/x) {
457
last;
458
}
459
else {
460
croak(q/Malformed header line: / . $Printable->($line));
461
}
462
}
463
return $headers;
464
}
465
466
sub write_header_lines {
467
(@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
468
my($self, $headers) = @_;
469
470
my $buf = '';
471
while (my ($k, $v) = each %$headers) {
472
my $field_name = lc $k;
473
$field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
474
or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
475
$field_name =~ s/\b(\w)/\u$1/g;
476
$buf .= "$field_name: $v\x0D\x0A";
477
}
478
$buf .= "\x0D\x0A";
479
return $self->write($buf);
480
}
481
482
sub read_content_body {
483
@_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
484
my ($self, $cb, $response, $len) = @_;
485
$len ||= $response->{headers}{'content-length'};
486
487
croak("No content-length in the returned response, and this "
488
. "UA doesn't implement chunking") unless defined $len;
489
490
while ($len > 0) {
491
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
492
$cb->($self->read($read), $response);
493
$len -= $read;
494
}
495
496
return;
497
}
498
499
sub write_content_body {
500
@_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
501
my ($self, $request) = @_;
502
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
503
504
$len += $self->write($request->{content});
505
506
$len == $content_length
507
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
508
509
return $len;
510
}
511
512
sub read_response_header {
513
@_ == 1 || croak(q/Usage: $handle->read_response_header()/);
514
my ($self) = @_;
515
516
my $line = $self->readline;
517
518
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
519
or croak(q/Malformed Status-Line: / . $Printable->($line));
520
521
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
522
523
return {
524
status => $status,
525
reason => $reason,
526
headers => $self->read_header_lines,
527
protocol => $protocol,
528
};
529
}
530
531
sub write_request_header {
532
@_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
533
my ($self, $method, $request_uri, $headers) = @_;
534
535
return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
536
+ $self->write_header_lines($headers);
537
}
538
539
sub _do_timeout {
540
my ($self, $type, $timeout) = @_;
541
$timeout = $self->{timeout}
542
unless defined $timeout && $timeout >= 0;
543
544
my $fd = fileno $self->{fh};
545
defined $fd && $fd >= 0
546
or croak(q/select(2): 'Bad file descriptor'/);
547
548
my $initial = time;
549
my $pending = $timeout;
550
my $nfound;
551
552
vec(my $fdset = '', $fd, 1) = 1;
553
554
while () {
555
$nfound = ($type eq 'read')
556
? select($fdset, undef, undef, $pending)
557
: select(undef, $fdset, undef, $pending) ;
558
if ($nfound == -1) {
559
$! == EINTR
560
or croak(qq/select(2): '$!'/);
561
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
562
$nfound = 0;
563
}
564
last;
565
}
566
$! = 0;
567
return $nfound;
568
}
569
570
sub can_read {
571
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
572
my $self = shift;
573
return $self->_do_timeout('read', @_)
574
}
575
576
sub can_write {
577
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
578
my $self = shift;
579
return $self->_do_timeout('write', @_)
580
}
265
} # HTTP::Micro
266
267
{
268
package HTTP::Micro::Handle;
269
270
use strict;
271
use warnings FATAL => 'all';
272
use English qw(-no_match_vars);
273
274
use Carp qw(croak);
275
use Errno qw(EINTR EPIPE);
276
use IO::Socket qw(SOCK_STREAM);
277
278
sub BUFSIZE () { 32768 }
279
280
my $Printable = sub {
281
local $_ = shift;
282
s/\r/\\r/g;
283
s/\n/\\n/g;
284
s/\t/\\t/g;
285
s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
286
$_;
287
};
288
289
sub new {
290
my ($class, %args) = @_;
291
return bless {
292
rbuf => '',
293
timeout => 60,
294
max_line_size => 16384,
295
%args
296
}, $class;
297
}
298
299
my $ssl_verify_args = {
300
check_cn => "when_only",
301
wildcards_in_alt => "anywhere",
302
wildcards_in_cn => "anywhere"
303
};
304
305
sub connect {
306
@_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/);
307
my ($self, $scheme, $host, $port) = @_;
308
309
if ( $scheme eq 'https' ) {
310
eval "require IO::Socket::SSL"
311
unless exists $INC{'IO/Socket/SSL.pm'};
312
croak(qq/IO::Socket::SSL must be installed for https support\n/)
313
unless $INC{'IO/Socket/SSL.pm'};
314
}
315
elsif ( $scheme ne 'http' ) {
316
croak(qq/Unsupported URL scheme '$scheme'\n/);
317
}
318
319
$self->{fh} = IO::Socket::INET->new(
320
PeerHost => $host,
321
PeerPort => $port,
322
Proto => 'tcp',
323
Type => SOCK_STREAM,
324
Timeout => $self->{timeout}
325
) or croak(qq/Could not connect to '$host:$port': $@/);
326
327
binmode($self->{fh})
328
or croak(qq/Could not binmode() socket: '$!'/);
329
330
if ( $scheme eq 'https') {
331
IO::Socket::SSL->start_SSL($self->{fh});
332
ref($self->{fh}) eq 'IO::Socket::SSL'
333
or die(qq/SSL connection failed for $host\n/);
334
if ( $self->{fh}->can("verify_hostname") ) {
335
$self->{fh}->verify_hostname( $host, $ssl_verify_args );
336
}
337
else {
338
my $fh = $self->{fh};
339
_verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args)
340
or die(qq/SSL certificate not valid for $host\n/);
341
}
342
}
343
344
$self->{host} = $host;
345
$self->{port} = $port;
346
347
return $self;
348
}
349
350
sub close {
351
@_ == 1 || croak(q/Usage: $handle->close()/);
352
my ($self) = @_;
353
CORE::close($self->{fh})
354
or croak(qq/Could not close socket: '$!'/);
355
}
356
357
sub write {
358
@_ == 2 || croak(q/Usage: $handle->write(buf)/);
359
my ($self, $buf) = @_;
360
361
my $len = length $buf;
362
my $off = 0;
363
364
local $SIG{PIPE} = 'IGNORE';
365
366
while () {
367
$self->can_write
368
or croak(q/Timed out while waiting for socket to become ready for writing/);
369
my $r = syswrite($self->{fh}, $buf, $len, $off);
370
if (defined $r) {
371
$len -= $r;
372
$off += $r;
373
last unless $len > 0;
374
}
375
elsif ($! == EPIPE) {
376
croak(qq/Socket closed by remote server: $!/);
377
}
378
elsif ($! != EINTR) {
379
croak(qq/Could not write to socket: '$!'/);
380
}
381
}
382
return $off;
383
}
384
385
sub read {
386
@_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/);
387
my ($self, $len) = @_;
388
389
my $buf = '';
390
my $got = length $self->{rbuf};
391
392
if ($got) {
393
my $take = ($got < $len) ? $got : $len;
394
$buf = substr($self->{rbuf}, 0, $take, '');
395
$len -= $take;
396
}
397
398
while ($len > 0) {
399
$self->can_read
400
or croak(q/Timed out while waiting for socket to become ready for reading/);
401
my $r = sysread($self->{fh}, $buf, $len, length $buf);
402
if (defined $r) {
403
last unless $r;
404
$len -= $r;
405
}
406
elsif ($! != EINTR) {
407
croak(qq/Could not read from socket: '$!'/);
408
}
409
}
410
if ($len) {
411
croak(q/Unexpected end of stream/);
412
}
413
return $buf;
414
}
415
416
sub readline {
417
@_ == 1 || croak(q/Usage: $handle->readline()/);
418
my ($self) = @_;
419
420
while () {
421
if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
422
return $1;
423
}
424
$self->can_read
425
or croak(q/Timed out while waiting for socket to become ready for reading/);
426
my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
427
if (defined $r) {
428
last unless $r;
429
}
430
elsif ($! != EINTR) {
431
croak(qq/Could not read from socket: '$!'/);
432
}
433
}
434
croak(q/Unexpected end of stream while looking for line/);
435
}
436
437
sub read_header_lines {
438
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/);
439
my ($self, $headers) = @_;
440
$headers ||= {};
441
my $lines = 0;
442
my $val;
443
444
while () {
445
my $line = $self->readline;
446
447
if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
448
my ($field_name) = lc $1;
449
$val = \($headers->{$field_name} = $2);
450
}
451
elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
452
$val
453
or croak(q/Unexpected header continuation line/);
454
next unless length $1;
455
$$val .= ' ' if length $$val;
456
$$val .= $1;
457
}
458
elsif ($line =~ /\A \x0D?\x0A \z/x) {
459
last;
460
}
461
else {
462
croak(q/Malformed header line: / . $Printable->($line));
463
}
464
}
465
return $headers;
466
}
467
468
sub write_header_lines {
469
(@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/);
470
my($self, $headers) = @_;
471
472
my $buf = '';
473
while (my ($k, $v) = each %$headers) {
474
my $field_name = lc $k;
475
$field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x
476
or croak(q/Invalid HTTP header field name: / . $Printable->($field_name));
477
$field_name =~ s/\b(\w)/\u$1/g;
478
$buf .= "$field_name: $v\x0D\x0A";
479
}
480
$buf .= "\x0D\x0A";
481
return $self->write($buf);
482
}
483
484
sub read_content_body {
485
@_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/);
486
my ($self, $cb, $response, $len) = @_;
487
$len ||= $response->{headers}{'content-length'};
488
489
croak("No content-length in the returned response, and this "
490
. "UA doesn't implement chunking") unless defined $len;
491
492
while ($len > 0) {
493
my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
494
$cb->($self->read($read), $response);
495
$len -= $read;
496
}
497
498
return;
499
}
500
501
sub write_content_body {
502
@_ == 2 || croak(q/Usage: $handle->write_content_body(request)/);
503
my ($self, $request) = @_;
504
my ($len, $content_length) = (0, $request->{headers}{'content-length'});
505
506
$len += $self->write($request->{content});
507
508
$len == $content_length
509
or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/);
510
511
return $len;
512
}
513
514
sub read_response_header {
515
@_ == 1 || croak(q/Usage: $handle->read_response_header()/);
516
my ($self) = @_;
517
518
my $line = $self->readline;
519
520
$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x
521
or croak(q/Malformed Status-Line: / . $Printable->($line));
522
523
my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
524
525
return {
526
status => $status,
527
reason => $reason,
528
headers => $self->read_header_lines,
529
protocol => $protocol,
530
};
531
}
532
533
sub write_request_header {
534
@_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/);
535
my ($self, $method, $request_uri, $headers) = @_;
536
537
return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
538
+ $self->write_header_lines($headers);
539
}
540
541
sub _do_timeout {
542
my ($self, $type, $timeout) = @_;
543
$timeout = $self->{timeout}
544
unless defined $timeout && $timeout >= 0;
545
546
my $fd = fileno $self->{fh};
547
defined $fd && $fd >= 0
548
or croak(q/select(2): 'Bad file descriptor'/);
549
550
my $initial = time;
551
my $pending = $timeout;
552
my $nfound;
553
554
vec(my $fdset = '', $fd, 1) = 1;
555
556
while () {
557
$nfound = ($type eq 'read')
558
? select($fdset, undef, undef, $pending)
559
: select(undef, $fdset, undef, $pending) ;
560
if ($nfound == -1) {
561
$! == EINTR
562
or croak(qq/select(2): '$!'/);
563
redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
564
$nfound = 0;
565
}
566
last;
567
}
568
$! = 0;
569
return $nfound;
570
}
571
572
sub can_read {
573
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/);
574
my $self = shift;
575
return $self->_do_timeout('read', @_)
576
}
577
578
sub can_write {
579
@_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/);
580
my $self = shift;
581
return $self->_do_timeout('write', @_)
582
}
583
} # HTTP::Micro::Handle
581
584
582
585
my $prog = <<'EOP';
583
586
BEGIN {
598
601
}
599
602
}
600
603
{
604
use Carp qw(croak);
601
605
my %dispatcher = (
602
606
issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) },
603
607
subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) },
753
757
}
754
758
755
759
1;
756
}
757
760
# ###########################################################################
758
# End HTTPMicro package
761
# End HTTP::Micro package
759
762
# ###########################################################################
760
763
761
764
# ###########################################################################
789
792
790
793
eval {
791
794
require Percona::Toolkit;
792
require HTTPMicro;
795
require HTTP::Micro;
793
796
};
794
797
795
798
{
1020
1023
my $url = $args{url};
1021
1024
my $instances = $args{instances};
1022
1025
1023
my $ua = $args{ua} || HTTPMicro->new( timeout => 3 );
1026
my $ua = $args{ua} || HTTP::Micro->new( timeout => 3 );
1024
1027
1025
1028
my $response = $ua->request('GET', $url);
1026
1029
PTDEBUG && _d('Server response:', Dumper($response));
1134
1137
perl_version => \&get_perl_version,
1135
1138
perl_module_version => \&get_perl_module_version,
1136
1139
mysql_variable => \&get_mysql_variable,
1137
bin_version => \&get_bin_version,
1138
1140
);
1139
1141
1140
1142
sub valid_item {
1317
1319
return \%version_for;
1318
1320
}
1319
1321
1320
sub get_bin_version {
1321
my (%args) = @_;
1322
my $item = $args{item};
1323
my $cmd = $item->{item};
1324
return unless $cmd;
1325
1326
my $sanitized_command = File::Basename::basename($cmd);
1327
PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command);
1328
return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/;
1329
1330
my $output = `$sanitized_command --version 2>&1`;
1331
PTDEBUG && _d('output:', $output);
1332
1333
my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/;
1334
1335
PTDEBUG && _d('Version for', $sanitized_command, '=', $version);
1336
return $version;
1337
}
1338
1339
1322
sub _d {
1340
1323
my ($package, undef, $line) = caller 0;
1341
1324
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
Loggerhead is a web-based interface for Breezy
Version: 2.0.1