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