ALRMing behavior on Win32

[particle]

i'm trying to jump out of an eval block if it takes too long to execute, so i've been searching for a way to signal an alarm on Win32.

the typical way to accomplish this is by using the perl alarm function. here's a simple example from section 5.6 of 'advanced perl programming:'

$SIG{ALRM} = \&timed_out;
eval {
    alarm (10);
    $buf = <>;
    alarm(0);           # Cancel the pending alarm if user responds.
};
if ($@ =~ /GOT TIRED OF WAITING/) {
    print "Timed out. Proceeding with default\n";
    ....
}

sub timed_out {
    die "GOT TIRED OF WAITING";
}

this is all well an good for *NIX systems, but Win32 doesn't implement alarm. (see Alarm Implemented in Win32? for details.) curiously, Win32 does implement SIGALARM. consider:

C:\>perl -e "print join ' ', keys %SIG"
STOP NUM05 NUM06 ALRM NUM07 NUM24 NUM16 NUM17 NUM18 NUM19 ILL CHLD SEG
+V PIPE CLD
 ABRT CONT INT QUIT KILL BREAK TERM NUM01 FPE NUM10 NUM12

yep, $SIG{ALRM} is a valid key in %SIG. but is it really?

i don't know enough about signals to be able to use a magic number or password to signal an ALRM. i don't know if it is even possible on Win32. if not, is there some other way for me to break out of an eval block before an operation has completed?

~Particle

[ehdonhon]

I'm making an assumption here that you can actually implement signal handlers in Win32, but I don't know if that is true or not. I don't have too much experience programming code dedicated to that platform. :(

If the system does not have its own alarm(), you could probably write something similar by forking off a timing process that waits a specified amount of time and then sends a signal to the running process. If execution completes before the alarm is sent, the timing process could simply be killed off.

Hopefully, you will find a better solution and let us all know what it is. :)

[Anonymous Monk]

use Term::ReadKey to accomplish what you're attempting to, as for in general, there is no way to alarm your way out of eval.

[particle]

as per the win32-perlfaq5: (i missed this section of it earlier)

Why doesn't signal handling work on Windows?

Signals are unsupported by the Win32 API. The C Runtime provides crude support for signals, but there are serious caveats, such as inability to die() or exit() from a signal handler. Perl itself does not guarantee that signal handlers will not interrupt critical operations such as memory allocation, which means signal invocation may throw perl internals into disarray. For these reasons, signals are unsupported at this time.

win32 does handle signals, sort of. here's a small example, for anyone who's brave enough to disregard the above statement:

#!/usr/local/bin/perl -w
use strict;
$|++;

# hit CTRL-C to produce INT
$SIG{INT} = sub { print "i can handle INT... $_[0]\n" };
print "hello!\n";
sleep(5);
eval
{
    local $SIG{INT} = sub { print "INT, too... $_[0]\n" };
    print "hello again!\n";
    sleep(5);
};
$@ && print "oot! $@";

__END__
# when i press CTRL-C during the sleep() statements, i get:
C:\>perl test_diehandler.pl
hello!
i can handle INT... INT
hello again!
INT, too... INT

but i'm not that brave (or stupid.) let me run through my options (or lack of them):

* i can't use POSIX; because the signal objects / methods aren't implemented on Win32 (this is obvious if you look at the beginning of the POSIX module's sigaction.t test.)
* i don't have a c compiler, so i can't write my own alarm function. besides, i always try to find a 100% Pure Perl solution to my problems.
* i can implement a forking solution, though it's a bit complex. since i don't have signals available, i'll have to use an OS specific module, Win32::Event.


below is an example of using Win32::Event to mimic alarm functionality. i'm faking a (possibly slow) external process with sleep. i set up a Win32::event object, and fork. the parent waits $timeout seconds for the event to be set, and kills the child if it times out. all fork and Win32::IPC::wait() errors are handled.

#!/usr/local/bin/perl -w
use strict;
$|++;
use Win32::Event;
sub DBUG() {0}
my $time = shift||2;    # mimic external process execution time (in se
+conds)
my $timeout = shift||3; # time to wait for process (in seconds)
my $event = Win32::Event->new() 
    or die "ERROR: cannot create new Win32::Event! $!";
$SIG{CHLD} = 'IGNORE'; # ignore dead children until they go away
FORK: 
{
    if( my $code_pid = fork() )
    {                   # PARENT, control max execution time
        print "---timing control loop, entering...\n";
        my $val = $event->wait($timeout * 1_000); # convert time to ms
+ (not M$)
        if($val == 0)    # test system event
        {               #   event timeout
            DBUG && print "  -event timeout...\n";
            print "  -killing child...\n";
            kill 1, $code_pid; # kill, force return code 1
        }
        elsif($val == 1)
        {               #   event set
            DBUG && print "  -event set...\n";
        }
        elsif($val == -1)
        {               #   abandoned mutex
            DBUG && print "  -mommy?...\n";
        }
        else
        {               #   error occured
            DBUG && print "  -event strangeness...\n";
        }
        print "---timing control loop, exiting...\n";
    }                   # PARENT, end
    elsif( defined $code_pid )
    {                   # CHILD, execute process, set event when compl
+ete
        print "  ---child process, entering...\n";
        sleep($time);   # fake execution of slow process
        print "  ---child process, exiting successfully...\n";
        $event->set();  # tell PARENT i'm done!
        exit 0;
    }                   # CHILD, end
    elsif( $! =~ /No more process/ )
    {                   # recoverable fork error, redo
        sleep 2;
        redo FORK;
    }
    else
    {                   # unrecoverable fork error, die
        die "ERROR: can't fork! $!";
    }
}
print "end of program\n";

to do: make this code cross-platform. it shouldn't be too difficult, but i'm not up for it right now.

~Particle