~drizzle-trunk/drizzle/development

# -*- cperl -*-

# Copyright (C) 2005-2006 MySQL AB

# 

# 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;