1# -*- cperl -*-
2# Copyright (c) 2004, 2011, Oracle and/or its affiliates.
3# Copyright (c) 2009-2011, Monty Program Ab
4#
5# This program is free software; you can redistribute it and/or
6# modify it under the terms of the GNU Library General Public
7# License as published by the Free Software Foundation; version 2
8# of the License.
9#
10# This program is distributed in the hope that it will be useful,
11# but WITHOUT ANY WARRANTY; without even the implied warranty of
12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13# Library General Public License for more details.
14#
15# You should have received a copy of the GNU General Public License
16# along with this program; if not, write to the Free Software
17# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1335  USA
18
19# This is a library file used by the Perl version of mysql-test-run,
20# and is part of the translation of the Bourne shell script with the
21# same name.
22
23use strict;
24
25use My::Platform;
26
27sub mtr_init_args ($);
28sub mtr_add_arg ($$@);
29sub mtr_args2str($@);
30sub mtr_path_exists(@);
31sub mtr_script_exists(@);
32sub mtr_file_exists(@);
33sub mtr_exe_exists(@);
34sub mtr_exe_maybe_exists(@);
35sub mtr_compress_file($);
36sub mtr_milli_sleep($);
37sub start_timer($);
38sub has_expired($);
39sub init_timers();
40sub mark_time_used($);
41sub mark_time_idle();
42sub add_total_times($);
43sub print_times_used($$);
44sub print_total_times($);
45
46our $opt_report_times;
47
48##############################################################################
49#
50#  Args
51#
52##############################################################################
53
54sub mtr_init_args ($) {
55  my $args = shift;
56  $$args = [];                            # Empty list
57}
58
59sub mtr_add_arg ($$@) {
60  my $args=   shift;
61  my $format= shift;
62  my @fargs = @_;
63
64  # Quote args if args contain space
65  $format= "\"$format\""
66    if (IS_WINDOWS and grep(/\s/, @fargs));
67
68  push(@$args, sprintf($format, @fargs));
69}
70
71sub mtr_args2str($@) {
72  my $exe=   shift or die;
73  return join(" ", native_path($exe), @_);
74}
75
76##############################################################################
77
78#
79# NOTE! More specific paths should be given before less specific.
80# For example /client/debug should be listed before /client
81#
82sub mtr_path_exists (@) {
83  foreach my $path ( @_ )
84  {
85    return $path if -e $path;
86  }
87  if ( @_ == 1 )
88  {
89    mtr_error("Could not find $_[0]");
90  }
91  else
92  {
93    mtr_error("Could not find any of " . join(" ", @_));
94  }
95}
96
97
98#
99# NOTE! More specific paths should be given before less specific.
100# For example /client/debug should be listed before /client
101#
102sub mtr_script_exists (@) {
103  foreach my $path ( @_ )
104  {
105    if(IS_WINDOWS)
106    {
107      return $path if -f $path;
108    }
109    else
110    {
111      return $path if -x $path;
112    }
113  }
114  if ( @_ == 1 )
115  {
116    mtr_error("Could not find $_[0]");
117  }
118  else
119  {
120    mtr_error("Could not find any of " . join(" ", @_));
121  }
122}
123
124
125#
126# NOTE! More specific paths should be given before less specific.
127# For example /client/debug should be listed before /client
128#
129sub mtr_file_exists (@) {
130  foreach my $path ( @_ )
131  {
132    return $path if -e $path;
133  }
134  return "";
135}
136
137
138#
139# NOTE! More specific paths should be given before less specific.
140# For example /client/debug should be listed before /client
141#
142sub mtr_exe_maybe_exists (@) {
143  my @path= @_;
144
145  map {$_.= ".exe"} @path if IS_WINDOWS;
146  foreach my $path ( @path )
147  {
148    if(IS_WINDOWS)
149    {
150      return $path if -f $path;
151    }
152    else
153    {
154      return $path if -x $path;
155    }
156  }
157  return "";
158}
159
160
161#
162# NOTE! More specific paths should be given before less specific.
163#
164sub mtr_pl_maybe_exists (@) {
165  my @path= @_;
166
167  map {$_.= ".pl"} @path if IS_WINDOWS;
168  foreach my $path ( @path )
169  {
170    if(IS_WINDOWS)
171    {
172      return $path if -f $path;
173    }
174    else
175    {
176      return $path if -x $path;
177    }
178  }
179  return "";
180}
181
182
183#
184# NOTE! More specific paths should be given before less specific.
185# For example /client/debug should be listed before /client
186#
187sub mtr_exe_exists (@) {
188  my @path= @_;
189  if (my $path= mtr_exe_maybe_exists(@path))
190  {
191    return $path;
192  }
193  # Could not find exe, show error
194  if ( @path == 1 )
195  {
196    mtr_error("Could not find $path[0]");
197  }
198  else
199  {
200    mtr_error("Could not find any of " . join(" ", @path));
201  }
202}
203
204#
205# Try to compress file using tools that might be available.
206# If zip/gzip is not available, just silently ignore.
207#
208
209sub mtr_compress_file ($) {
210  my ($filename)= @_;
211
212  mtr_error ("File to compress not found: $filename") unless -f $filename;
213
214  my $did_compress= 0;
215
216  if (IS_WINDOWS)
217  {
218    # Capture stderr
219    my $ziperr= `zip $filename.zip $filename 2>&1`;
220    if ($?) {
221      print "$ziperr\n" if $ziperr !~ /recognized as an internal or external/;
222    } else {
223      unlink($filename);
224      $did_compress=1;
225    }
226  }
227  else
228  {
229    my $gzres= system("gzip $filename");
230    $did_compress= ! $gzres;
231    if ($gzres && $gzres != -1) {
232      mtr_error ("Error: have gzip but it fails to compress core file");
233    }
234  }
235  mtr_print("Compressed file $filename") if $did_compress;
236}
237
238
239sub mtr_milli_sleep ($) {
240  die "usage: mtr_milli_sleep(milliseconds)" unless @_ == 1;
241  my ($millis)= @_;
242
243  select(undef, undef, undef, ($millis/1000));
244}
245
246sub mtr_wait_lock_file {
247  die "usage: mtr_wait_lock_file(path_to_file, keep_alive)" unless @_ == 2;
248  my ($file, $keep_alive)= @_;
249  my $waited= 0;
250  my $msg_counter= $keep_alive;
251
252  while ( -e $file)
253  {
254    if ($keep_alive && !$msg_counter)
255    {
256       print "\n-STOPPED- [pass] ".$keep_alive."\n";
257       $msg_counter= $keep_alive;
258    }
259    mtr_milli_sleep(1000);
260    $waited= 1;
261    $msg_counter--;
262  }
263  return ($waited);
264}
265
266sub uniq(@) {
267  my %seen = map { $_ => $_ } @_;
268  values %seen;
269}
270
271# Simple functions to start and check timers (have to be actively polled)
272# Timer can be "killed" by setting it to 0
273
274sub start_timer ($) { return time + $_[0]; }
275
276sub has_expired ($) { return $_[0] && time gt $_[0]; }
277
278# Below code is for time usage reporting
279
280use Time::HiRes qw(gettimeofday);
281
282my %time_used= (
283  'collect' => 0,
284  'restart' => 0,
285  'check'   => 0,
286  'ch-warn' => 0,
287  'test'    => 0,
288  'init'    => 0,
289  'admin'   => 0,
290);
291
292my %time_text= (
293 'collect' => "Collecting test cases",
294 'restart' => "Server stop/start",
295 'check'   => "Check-testcase",
296 'ch-warn' => "Check for warnings",
297 'test'    => "Test execution",
298 'init'    => "Initialization/cleanup",
299 'admin'   => "Test administration",
300);
301
302# Counts number of reports from workers
303
304my $time_totals= 0;
305
306my $last_timer_set;
307
308sub init_timers() {
309  $last_timer_set= gettimeofday();
310}
311
312sub mark_time_used($) {
313  my ($name)= @_;
314  return unless $opt_report_times;
315  die "Unknown timer $name" unless exists $time_used{$name};
316
317  my $curr_time= gettimeofday();
318  $time_used{$name}+= int (($curr_time - $last_timer_set) * 1000 + .5);
319  $last_timer_set= $curr_time;
320}
321
322sub mark_time_idle() {
323  $last_timer_set= gettimeofday() if $opt_report_times;
324}
325
326sub add_total_times($) {
327  my ($dummy, $num, @line)= split (" ", $_[0]);
328
329  $time_totals++;
330  foreach my $elem (@line) {
331    my ($name, $spent)= split (":", $elem);
332    $time_used{$name}+= $spent;
333  }
334}
335
336sub print_times_used($$) {
337  my ($server, $num)= @_;
338  return unless $opt_report_times;
339
340  my $output= "SPENT $num";
341  foreach my $name (keys %time_used) {
342    my $spent= $time_used{$name};
343    $output.= " $name:$spent";
344  }
345  print $server $output . "\n";
346}
347
348sub print_total_times($) {
349  # Don't print if we haven't received all worker data
350  return if $time_totals != $_[0];
351
352  foreach my $name (keys %time_used)
353  {
354    my $spent= $time_used{$name}/1000;
355    my $text= $time_text{$name};
356    print ("Spent $spent seconds on $text\n");
357  }
358}
359
360
3611;
362