diff --git a/lib/Sandbox.pm b/lib/Sandbox.pm index 5fb3e004..89d0b8c6 100644 --- a/lib/Sandbox.pm +++ b/lib/Sandbox.pm @@ -39,6 +39,8 @@ $Data::Dumper::Quotekeys = 0; use constant PTDEBUG => $ENV{PTDEBUG} || 0; use constant PTDEVDEBUG => $ENV{PTDEVDEBUG} || 0; +$Sandbox::Percona::Toolkit::VERSION = "2.1.3"; + my $trunk = $ENV{PERCONA_TOOLKIT_BRANCH}; my %port_for = ( diff --git a/lib/VersionCheck.pm b/lib/VersionCheck.pm index ad0f059c..ad719a33 100644 --- a/lib/VersionCheck.pm +++ b/lib/VersionCheck.pm @@ -28,10 +28,16 @@ use English qw(-no_match_vars); use constant PTDEBUG => $ENV{PTDEBUG} || 0; -use Data::Dumper; -$Data::Dumper::Indent = 1; -$Data::Dumper::Sortkeys = 1; -$Data::Dumper::Quotekeys = 0; +use File::Basename (); +use Data::Dumper (); + +sub Dumper { + local $Data::Dumper::Indent = 1; + local $Data::Dumper::Sortkeys = 1; + local $Data::Dumper::Quotekeys = 0; + + Data::Dumper::Dumper(@_); +} sub new { my ($class, %args) = @_; @@ -75,7 +81,7 @@ sub get_versions { my %versions; foreach my $item ( values %$items ) { next unless $self->valid_item($item); - + eval { my $func = 'get_' . $item->{type}; my $version = $self->$func( @@ -100,12 +106,12 @@ sub valid_item { return 1; } -sub get_os { +sub get_os_version { my ($self) = @_; chomp(my $platform = `uname -s`); PTDEBUG && _d('platform:', $platform); - return unless $platform; + return $OSNAME unless $platform; chomp(my $lsb_release = `which lsb_release 2>/dev/null | awk '{print \$1}'` || ''); @@ -166,24 +172,26 @@ sub get_os { return $release; } -sub get_perl_variable { +sub get_perl_version { my ($self, %args) = @_; my $item = $args{item}; return unless $item; - # Can't just stringify $PERL_VERSION because on 5.8 it doesn't work. - # So %vd coerces the version into a string on 5.8+. - if ( $item->{item} eq 'Perl' ) { - my $version = sprintf '%vd', $PERL_VERSION; - PTDEBUG && _d('Perl version', $version); - return $version; - } + my $version = sprintf '%vd', $PERL_VERSION; + PTDEBUG && _d('Perl version', $version); + return $version; +} +sub get_perl_module_version { + my ($self, %args) = @_; + my $item = $args{item}; + return unless $item; + # If there's a var, then its an explicit Perl variable name to get, # else the item name is an implicity Perl module name to which we - # append ::VERSION to get the module's version. - my $var = $item->{vars}->[0] || ($item->{item} . '::VERSION'); - my $version = do { no strict; ${*{$var}}; }; + # append ::VERSION to get the module's version. + my $var = $item->{item} . '::VERSION'; + my $version = _get_scalar($var); PTDEBUG && _d('Perl version for', $var, '=', "$version"); # Explicitly stringify this else $PERL_VERSION will return @@ -191,6 +199,11 @@ sub get_perl_variable { return $version ? "$version" : $version; } +sub _get_scalar { + no strict; + return ${*{shift()}}; +} + sub get_mysql_variable { my $self = shift; return $self->_get_from_mysql( @@ -232,6 +245,23 @@ sub _get_from_mysql { return join(' ', @versions); } +sub get_bin_version { + my ($self, %args) = @_; + my $item = $args{item}; + my $cmd = $item->{item}; + return unless $cmd; + + my $sanitized_command = File::Basename::basename($cmd); + return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; + + my $output = `$sanitized_command --version 2>&1`; + + my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; + + PTDEBUG && _d('Version for', $sanitized_command, '=', $version); + return $version; +} + sub _d { my ($package, undef, $line) = caller 0; @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } diff --git a/t/lib/VersionCheck.t b/t/lib/VersionCheck.t index 6d472857..8d113f9e 100644 --- a/t/lib/VersionCheck.t +++ b/t/lib/VersionCheck.t @@ -51,7 +51,7 @@ sub test_v { if ( $items->{Perl} ) { like( $versions->{Perl}, - q/\d+\.\d+.\d+/, + qr/\d+\.\d+.\d+/, "Perl version looks like a version" ); } @@ -61,11 +61,11 @@ sub test_v { test_v( name => "Perl version", - response => "Perl;perl_variable;PERL_VERSION\n", + response => "Perl;perl_version;PERL_VERSION\n", items => { 'Perl' => { item => 'Perl', - type => 'perl_variable', + type => 'perl_version', vars => [qw(PERL_VERSION)], }, }, @@ -75,12 +75,12 @@ test_v( ); test_v( - name => "perl_variable (no args)", - response => "Data::Dumper;perl_variable\n", + name => "perl_module_version", + response => "Data::Dumper;perl_module_version\n", items => { 'Data::Dumper' => { item => 'Data::Dumper', - type => 'perl_variable', + type => 'perl_module_version', vars => [], }, }, @@ -89,6 +89,40 @@ test_v( }, ); +test_v( + name => "bin_version", + response => "perl;bin_version\n", + items => { + 'perl' => { + item => 'perl', + type => 'bin_version', + vars => [], + }, + }, + versions => { + 'perl' => sprintf('%vd', $PERL_VERSION), + }, +); + +use File::Spec; +{ + local $ENV{PATH} = "$ENV{PATH}:" . File::Spec->catfile($ENV{PERCONA_TOOLKIT_BRANCH}, "bin"); + test_v( + name => "bin_version", + response => "pt-archiver;bin_version\n", + items => { + 'pt-archiver' => { + item => 'pt-archiver', + type => 'bin_version', + vars => [], + }, + }, + versions => { + 'pt-archiver' => $Sandbox::Percona::Toolkit::VERSION, + }, + ); +} + SKIP: { skip "Cannot cannot to sandbox master", 2 unless $dbh; @@ -117,7 +151,7 @@ SKIP: { # since the test env doesn't know what OS its running on. We # at least know that an OS should have these two things: a word # and version with at least major and minor numbers. -my $os = $vc->get_os; +my $os = $vc->get_os_version; diag($os); like(