/release/src/router/mysql/mysql-test/lib/v1/mtr_timer.pl
Perl | 159 lines | 88 code | 30 blank | 41 comment | 6 complexity | b4e9dc056922f7b8f8f042a70984d15c MD5 | raw file
- # -*- cperl -*-
- # Copyright (c) 2005, 2006 MySQL AB, 2008 Sun Microsystems, Inc.
- # Use is subject to license terms.
- #
- # This program is free software; you can redistribute it and/or modify
- # it under the terms of the GNU General Public License as published by
- # the Free Software Foundation; version 2 of the License.
- #
- # This program is distributed in the hope that it will be useful,
- # but WITHOUT ANY WARRANTY; without even the implied warranty of
- # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- # GNU General Public License for more details.
- #
- # You should have received a copy of the GNU General Public License
- # along with this program; if not, write to the Free Software
- # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
- # This is a library file used by the Perl version of mysql-test-run,
- # and is part of the translation of the Bourne shell script with the
- # same name.
- use Errno;
- use strict;
- sub mtr_init_timers ();
- sub mtr_timer_start($$$);
- sub mtr_timer_stop($$);
- sub mtr_timer_stop_all($);
- ##############################################################################
- #
- # Initiate the structure shared by all timers
- #
- ##############################################################################
- sub mtr_init_timers () {
- my $timers = { timers => {}, pids => {}};
- return $timers;
- }
- ##############################################################################
- #
- # Start, stop and poll a timer
- #
- # As alarm() isn't portable to Windows, we use separate processes to
- # implement timers.
- #
- ##############################################################################
- sub mtr_timer_start($$$) {
- my ($timers,$name,$duration)= @_;
- if ( exists $timers->{'timers'}->{$name} )
- {
- # We have an old running timer, kill it
- mtr_warning("There is an old timer running");
- mtr_timer_stop($timers,$name);
- }
- FORK:
- {
- my $tpid= fork();
- if ( ! defined $tpid )
- {
- if ( $! == $!{EAGAIN} ) # See "perldoc Errno"
- {
- mtr_warning("Got EAGAIN from fork(), sleep 1 second and redo");
- sleep(1);
- redo FORK;
- }
- else
- {
- mtr_error("can't fork timer, error: $!");
- }
- }
- if ( $tpid )
- {
- # Parent, record the information
- mtr_verbose("Starting timer for '$name',",
- "duration: $duration, pid: $tpid");
- $timers->{'timers'}->{$name}->{'pid'}= $tpid;
- $timers->{'timers'}->{$name}->{'duration'}= $duration;
- $timers->{'pids'}->{$tpid}= $name;
- }
- else
- {
- # Child, install signal handlers and sleep for "duration"
- # Don't do the ^C cleanup in the timeout child processes!
- # There is actually a race here, if we get ^C after fork(), but before
- # clearing the signal handler.
- $SIG{INT}= 'DEFAULT';
- $SIG{TERM}= sub {
- mtr_verbose("timer $$ woke up, exiting!");
- exit(0);
- };
- $0= "mtr_timer(timers,$name,$duration)";
- sleep($duration);
- mtr_verbose("timer $$ expired after $duration seconds");
- exit(0);
- }
- }
- }
- sub mtr_timer_stop ($$) {
- my ($timers,$name)= @_;
- if ( exists $timers->{'timers'}->{$name} )
- {
- my $tpid= $timers->{'timers'}->{$name}->{'pid'};
- mtr_verbose("Stopping timer for '$name' with pid $tpid");
- # FIXME as Cygwin reuses pids fast, maybe check that is
- # the expected process somehow?!
- kill(15, $tpid);
- # As the timers are so simple programs, we trust them to terminate,
- # and use blocking wait for it. We wait just to avoid a zombie.
- waitpid($tpid,0);
- delete $timers->{'timers'}->{$name}; # Remove the timer information
- delete $timers->{'pids'}->{$tpid}; # and PID reference
- return 1;
- }
- mtr_error("Asked to stop timer '$name' not started");
- }
- sub mtr_timer_stop_all ($) {
- my $timers= shift;
- foreach my $name ( keys %{$timers->{'timers'}} )
- {
- mtr_timer_stop($timers, $name);
- }
- return 1;
- }
- sub mtr_timer_timeout ($$) {
- my ($timers,$pid)= @_;
- return "" unless exists $timers->{'pids'}->{$pid};
- # Got a timeout(the process with $pid is recorded as being a timer)
- # return the name of the timer
- return $timers->{'pids'}->{$pid};
- }
- 1;