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