1# -*- cperl -*- 2# Copyright (c) 2005, 2006 MySQL AB, 2008 Sun Microsystems, Inc. 3# Use is subject to license terms. 4# 5# This program is free software; you can redistribute it and/or modify 6# it under the terms of the GNU General Public License as published by 7# the Free Software Foundation; version 2 of the License. 8# 9# This program is distributed in the hope that it will be useful, 10# but WITHOUT ANY WARRANTY; without even the implied warranty of 11# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12# GNU General Public License for more details. 13# 14# You should have received a copy of the GNU General Public License 15# along with this program; if not, write to the Free Software 16# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA 17 18# This is a library file used by the Perl version of mysql-test-run, 19# and is part of the translation of the Bourne shell script with the 20# same name. 21 22use Errno; 23use strict; 24 25sub mtr_init_timers (); 26sub mtr_timer_start($$$); 27sub mtr_timer_stop($$); 28sub mtr_timer_stop_all($); 29 30 31############################################################################## 32# 33# Initiate the structure shared by all timers 34# 35############################################################################## 36 37sub mtr_init_timers () { 38 my $timers = { timers => {}, pids => {}}; 39 return $timers; 40} 41 42 43############################################################################## 44# 45# Start, stop and poll a timer 46# 47# As alarm() isn't portable to Windows, we use separate processes to 48# implement timers. 49# 50############################################################################## 51 52sub mtr_timer_start($$$) { 53 my ($timers,$name,$duration)= @_; 54 55 if ( exists $timers->{'timers'}->{$name} ) 56 { 57 # We have an old running timer, kill it 58 mtr_warning("There is an old timer running"); 59 mtr_timer_stop($timers,$name); 60 } 61 62 FORK: 63 { 64 my $tpid= fork(); 65 66 if ( ! defined $tpid ) 67 { 68 if ( $! == $!{EAGAIN} ) # See "perldoc Errno" 69 { 70 mtr_warning("Got EAGAIN from fork(), sleep 1 second and redo"); 71 sleep(1); 72 redo FORK; 73 } 74 else 75 { 76 mtr_error("can't fork timer, error: $!"); 77 } 78 } 79 80 if ( $tpid ) 81 { 82 # Parent, record the information 83 mtr_verbose("Starting timer for '$name',", 84 "duration: $duration, pid: $tpid"); 85 $timers->{'timers'}->{$name}->{'pid'}= $tpid; 86 $timers->{'timers'}->{$name}->{'duration'}= $duration; 87 $timers->{'pids'}->{$tpid}= $name; 88 } 89 else 90 { 91 # Child, install signal handlers and sleep for "duration" 92 93 # Don't do the ^C cleanup in the timeout child processes! 94 # There is actually a race here, if we get ^C after fork(), but before 95 # clearing the signal handler. 96 $SIG{INT}= 'DEFAULT'; 97 98 $SIG{TERM}= sub { 99 mtr_verbose("timer $$ woke up, exiting!"); 100 exit(0); 101 }; 102 103 $0= "mtr_timer(timers,$name,$duration)"; 104 sleep($duration); 105 mtr_verbose("timer $$ expired after $duration seconds"); 106 exit(0); 107 } 108 } 109} 110 111 112sub mtr_timer_stop ($$) { 113 my ($timers,$name)= @_; 114 115 if ( exists $timers->{'timers'}->{$name} ) 116 { 117 my $tpid= $timers->{'timers'}->{$name}->{'pid'}; 118 mtr_verbose("Stopping timer for '$name' with pid $tpid"); 119 120 # FIXME as Cygwin reuses pids fast, maybe check that is 121 # the expected process somehow?! 122 kill(15, $tpid); 123 124 # As the timers are so simple programs, we trust them to terminate, 125 # and use blocking wait for it. We wait just to avoid a zombie. 126 waitpid($tpid,0); 127 128 delete $timers->{'timers'}->{$name}; # Remove the timer information 129 delete $timers->{'pids'}->{$tpid}; # and PID reference 130 131 return 1; 132 } 133 134 mtr_error("Asked to stop timer '$name' not started"); 135} 136 137 138sub mtr_timer_stop_all ($) { 139 my $timers= shift; 140 141 foreach my $name ( keys %{$timers->{'timers'}} ) 142 { 143 mtr_timer_stop($timers, $name); 144 } 145 return 1; 146} 147 148 149sub mtr_timer_timeout ($$) { 150 my ($timers,$pid)= @_; 151 152 return "" unless exists $timers->{'pids'}->{$pid}; 153 154 # Got a timeout(the process with $pid is recorded as being a timer) 155 # return the name of the timer 156 return $timers->{'pids'}->{$pid}; 157} 158 1591; 160