VersionCheck: Update to newest spec and add get_bin_version()

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 = (

lib/VersionCheck.pm

@@ -28,10 +28,16 @@ use English qw(-no_match_vars);
 
 use constant PTDEBUG => $ENV{PTDEBUG} || 0;
 
-use Data::Dumper;
+use File::Basename ();
-$Data::Dumper::Indent    = 1;
+use Data::Dumper ();
-$Data::Dumper::Sortkeys  = 1;
+
-$Data::Dumper::Quotekeys = 0;
+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) = @_;
@@ -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;
-   }
+}
+
+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 $var          = $item->{item} . '::VERSION';
-   my $version = do { no strict; ${*{$var}}; }; 
+   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; }

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)",
+   name     => "perl_module_version",
-   response => "Data::Dumper;perl_variable\n",
+   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(