← Back to branch summary

~percona-toolkit-dev/percona-toolkit/changehandler-dont-hexify-text-cols

« back to all changes in this revision

Viewing changes to t/lib/VersionCheck.t

  • Committer: Daniel Nichter
  • Date: 2012-08-23 01:59:55 UTC
  • mfrom: (350.1.29 pingback-feature)
  • Revision ID: daniel@percona.com-20120823015955-5amltej7vn72sz9w
Merge lp:~percona-toolkit-dev/percona-toolkit/pingback-feature

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/lib/VersionCheck.t
 
1
#!/usr/bin/perl
 
2
 
 
3
BEGIN {
 
4
   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
 
5
      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
 
6
   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
 
7
};
 
8
 
 
9
use strict;
 
10
use warnings FATAL => 'all';
 
11
use English qw(-no_match_vars);
 
12
use Test::More;
 
13
use Data::Dumper;
 
14
 
 
15
use VersionCheck;
 
16
use DSNParser;
 
17
use Sandbox;
 
18
use PerconaTest;
 
19
 
 
20
my $dp  = new DSNParser(opts=>$dsn_opts);
 
21
my $sb  = new Sandbox(basedir => '/tmp', DSNParser => $dp);
 
22
my $dbh = $sb->get_dbh_for('master');
 
23
 
 
24
my $vc = VersionCheck->new();
 
25
 
 
26
sub test_v {
 
27
   my (%args) = @_;
 
28
 
 
29
   my $items = $vc->parse_server_response(
 
30
      response => $args{response},
 
31
   );
 
32
   is_deeply(
 
33
      $items,
 
34
      $args{items},
 
35
      "$args{name} items"
 
36
   );
 
37
 
 
38
   my $versions = $vc->get_versions(
 
39
      items => $items,
 
40
      dbh   => $dbh,
 
41
   );
 
42
   diag(Dumper($versions));
 
43
   is_deeply(
 
44
      $versions,
 
45
      $args{versions},
 
46
      "$args{name} versions"
 
47
   );
 
48
 
 
49
   # Perl 5.8 $^V/$PERL_VERSION is borked, make sure
 
50
   # the module is coping with it.
 
51
   if ( $items->{Perl} ) {
 
52
      like(
 
53
         $versions->{Perl},
 
54
         qr/\d+\.\d+.\d+/,
 
55
         "Perl version looks like a version"
 
56
      );
 
57
   }
 
58
 
 
59
   return;
 
60
}
 
61
 
 
62
test_v(
 
63
   name     => "Perl version",
 
64
   response => "Perl;perl_version\n",
 
65
   items    => {
 
66
      'Perl' => {
 
67
         item => 'Perl',
 
68
         type => 'perl_version',
 
69
         vars => [],
 
70
      },
 
71
   },
 
72
   versions => {
 
73
      'Perl' => sprintf('%vd', $PERL_VERSION),
 
74
   },
 
75
);
 
76
 
 
77
test_v(
 
78
   name     => "perl_module_version",
 
79
   response => "Data::Dumper;perl_module_version\n",
 
80
   items    => {
 
81
      'Data::Dumper' => {
 
82
         item => 'Data::Dumper',
 
83
         type => 'perl_module_version',
 
84
         vars => [],
 
85
      },
 
86
   },
 
87
   versions => {
 
88
      'Data::Dumper' => $Data::Dumper::VERSION,
 
89
   },
 
90
);
 
91
 
 
92
test_v(
 
93
   name     => "bin_version",
 
94
   response => "perl;bin_version\n",
 
95
   items    => {
 
96
      'perl' => {
 
97
         item => 'perl',
 
98
         type => 'bin_version',
 
99
         vars => [],
 
100
      },
 
101
   },
 
102
   versions => {
 
103
      'perl' => sprintf('%vd', $PERL_VERSION),
 
104
   },
 
105
);
 
106
 
 
107
use File::Spec;
 
108
{
 
109
   local $ENV{PATH} = "$ENV{PATH}:" . File::Spec->catfile($ENV{PERCONA_TOOLKIT_BRANCH}, "bin");
 
110
   test_v(
 
111
      name     => "bin_version",
 
112
      response => "pt-archiver;bin_version\n",
 
113
      items    => {
 
114
         'pt-archiver' => {
 
115
            item => 'pt-archiver',
 
116
            type => 'bin_version',
 
117
            vars => [],
 
118
         },
 
119
      },
 
120
      versions => {
 
121
         'pt-archiver' => $Sandbox::Percona::Toolkit::VERSION,
 
122
      },
 
123
   );
 
124
}
 
125
 
 
126
SKIP: {
 
127
   skip "Cannot cannot to sandbox master", 2 unless $dbh;
 
128
 
 
129
   my (undef, $mysql_version)
 
130
      = $dbh->selectrow_array("SHOW VARIABLES LIKE 'version'");
 
131
   my (undef, $mysql_distro)
 
132
      = $dbh->selectrow_array("SHOW VARIABLES LIKE 'version_comment'");
 
133
 
 
134
   test_v(
 
135
      name     => "mysql_variable",
 
136
      response => "MySQL;mysql_variable;version_comment,version\n",
 
137
      items    => {
 
138
         'MySQL' => {
 
139
            item => 'MySQL',
 
140
            type => 'mysql_variable',
 
141
            vars => [qw(version_comment version)],
 
142
         },
 
143
      },
 
144
      versions => {
 
145
         'MySQL' => "$mysql_distro $mysql_version",
 
146
      },
 
147
   );
 
148
}
 
149
 
 
150
# I can't think of a way to make these 2 OS tests more specific
 
151
# since the test env doesn't know what OS its running on.  We
 
152
# at least know that an OS should have these two things: a word
 
153
# and version with at least major and minor numbers.
 
154
my $os = $vc->get_os_version;
 
155
diag($os);
 
156
 
 
157
like(
 
158
   $os,
 
159
   qr/^\w+/,
 
160
   "OS has some kind of name"
 
161
);
 
162
 
 
163
like(
 
164
   $os,
 
165
   qr/\d+\.\d+/,
 
166
   "OS has some kind of version"
 
167
);
 
168
 
 
169
# get_os() runs a lot of shell cmds that include newlines,
 
170
# but the client's response can't have newlines in the versions
 
171
# becuase newlines separate items.
 
172
ok(
 
173
   $os !~ m/\n$/,
 
174
   "Newline stripped from OS"
 
175
);
 
176
 
 
177
 
 
178
# #############################################################################
 
179
# Validate items
 
180
# #############################################################################
 
181
   
 
182
my $versions = $vc->get_versions(
 
183
   items => {
 
184
      'Foo' => {
 
185
         item => 'Foo',
 
186
         type => 'perl_variable',
 
187
         vars => [],
 
188
      },
 
189
   },
 
190
);
 
191
 
 
192
is_deeply(
 
193
   $versions,
 
194
   {},
 
195
   "perl_variable is not a valid type"
 
196
);
 
197
 
 
198
# #############################################################################
 
199
# Done.
 
200
# #############################################################################
 
201
ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox")
 
202
   if $dbh;
 
203
done_testing;
 
204
exit;