percona-toolkit/t/lib/VersionCheck.t

#!/usr/bin/perl

BEGIN {
   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
};

use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use Test::More;
use Data::Dumper;

use VersionCheck;
use DSNParser;
use Sandbox;
use PerconaTest;
use Percona::Toolkit;

my $dp  = new DSNParser(opts=>$dsn_opts);
my $sb  = new Sandbox(basedir => '/tmp', DSNParser => $dp);
my $master_dbh = $sb->get_dbh_for('master');
my $slave1_dbh = $sb->get_dbh_for('slave1');

my $vc = VersionCheck->new();

sub test_v {
   my (%args) = @_;

   my $items = $vc->parse_server_response(
      response => $args{response},
   );
   is_deeply(
      $items,
      $args{items},
      "$args{name} items"
   );

   my $versions = $vc->get_versions(
      items     => $items,
      instances => [
         {
            id   => "0xDEADBEEF",
            name => "master",
            dbh  => $master_dbh,
         },
         {
            id   => "0x8BADF00D",
            name => "slave1",
            dbh  => $slave1_dbh,
         },
      ],
   );
   diag(Dumper($versions));
   is_deeply(
      $versions,
      $args{versions},
      "$args{name} versions"
   );

   # Perl 5.8 $^V/$PERL_VERSION is borked, make sure
   # the module is coping with it.
   if ( $items->{Perl} ) {
      like(
         $versions->{Perl},
         qr/\d+\.\d+.\d+/,
         "Perl version looks like a version"
      );
   }

   return;
}

test_v(
   name     => "Perl version",
   response => "Perl;perl_version\n",
   items    => {
      'Perl' => {
         item => 'Perl',
         type => 'perl_version',
         vars => [],
      },
   },
   versions => {
      'Perl' => sprintf('%vd', $PERL_VERSION),
   },
);

test_v(
   name     => "perl_module_version",
   response => "Data::Dumper;perl_module_version\n",
   items    => {
      'Data::Dumper' => {
         item => 'Data::Dumper',
         type => 'perl_module_version',
         vars => [],
      },
   },
   versions => {
      'Data::Dumper' => $Data::Dumper::VERSION,
   },
);

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' => $Percona::Toolkit::VERSION,
      },
   );
}

SKIP: {
   skip "Cannot cannot to sandbox master", 2 unless $master_dbh;

   my (undef, $mysql_version)
      = $master_dbh->selectrow_array("SHOW VARIABLES LIKE 'version'");
   my (undef, $mysql_distro)
      = $master_dbh->selectrow_array("SHOW VARIABLES LIKE 'version_comment'");

   test_v(
      name     => "mysql_variable",
      response => "MySQL;mysql_variable;version_comment,version\n",
      items    => {
         'MySQL' => {
            item => 'MySQL',
            type => 'mysql_variable',
            vars => [qw(version_comment version)],
         },
      },
      versions => {
         'MySQL' => {
            "0xDEADBEEF" => "$mysql_distro $mysql_version",
            "0x8BADF00D" => "$mysql_distro $mysql_version"
         },
      },
   );
}

# I can't think of a way to make these 2 OS tests more specific
# 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_version;
diag($os);

like(
   $os,
   qr/^\w+/,
   "OS has some kind of name"
);

like(
   $os,
   qr/\d+\.\d+/,
   "OS has some kind of version"
);

# get_os() runs a lot of shell cmds that include newlines,
# but the client's response can't have newlines in the versions
# becuase newlines separate items.
ok(
   $os !~ m/\n$/,
   "Newline stripped from OS"
);

# #############################################################################
# Validate items
# #############################################################################
   
my $versions = $vc->get_versions(
   items => {
      'Foo' => {
         item => 'Foo',
         type => 'perl_variable',
         vars => [],
      },
   },
);

is_deeply(
   $versions,
   {},
   "perl_variable is not a valid type"
);

# #############################################################################
# Done.
# #############################################################################
ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox")
   if $master_dbh;
done_testing;
exit;