Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Timeouts/timers on Win32 system

by Dovkont (Novice)
on Dec 08, 2003 at 14:48 UTC ( #313091=perlquestion: print w/ replies, xml ) Need Help??
Dovkont has asked for the wisdom of the Perl Monks concerning the following question:

Greetings!

I have a need to implement the following:
A perl script works as server running certain application. It is connected via a socket to certain user interface, recieving a command, passing it on to the application and sending back the result. All this runs on Windows with ActivePerl.
Now, I want to make an automatic shutdown mechanism, that works on the condition of not recieving a user command for a set period of time. Then the script must run a function that shuts down the applications and takes care of auxiliary files. (As it is one when the quit command is being sent). The socket should remain active.

I have tried to find, but, apparently without success a way to do such a timer...

Thanks in advance,

Dovkont.

Comment on Timeouts/timers on Win32 system
Re: Timeouts/timers on Win32 system
by NetWallah (Abbot) on Dec 08, 2003 at 15:00 UTC
    Have you tried the alarm SECONDS function (In an eval block) - it's usage as a timeout timer is described in perlfunc.

    "We are enthusiastically pro-laugh, we are pro-choice as well. We respect each and every individualÂÂs right not to laugh. If you want to be miserable, go right ahead. Whatever makes you happy."
      Hello, just a fyi
      E:\>perldoc perlport|grep alarm alarm SECONDS alarm Not implemented. (Win32) E:\>perl -le"alarm 0" The Unsupported function alarm function is unimplemented at -e line 1.
      update: apparently, for perl 5.8.x this has changed, but perlport wasn't updated (i'll notify perl5-porters if perl-current is not up to date)
      E:\>perl local $SIG{ALRM} = sub { die "alarm!!!!" }; alarm 1; sleep 10; alarm 0; __END__ alarm!!!! at - line 1.

      MJD says "you can't just make shit up and expect the computer to know what you mean, retardo!"
      I run a Win32 PPM repository for perl 5.6.x and 5.8.x -- I take requests (README).
      ** The third rule of perl club is a statement of fact: pod is sexy.

Re: Timeouts/timers on Win32 system
by AcidHawk (Vicar) on Dec 08, 2003 at 15:03 UTC

    Could it be that you are looking for Win32::Process? With that you can launch your command and specify $ProcessObj->Wait($timeout) which

      Wait for the process to die. $timeout should be specified in milliseconds. To wait forever, specify the constant INFINITE.
    then to kill the process you could do something like $ProcessObj->Kill( $exitcode ) which
      Kill the associated process, have it terminate with exit code $ExitCode.
    Update:
    #! /usr/bin/perl use strict; use warnings; use Win32::Process; ###################################################################### +################## #MiscVariables my ($VERSION, $ProcessObj); ###################################################################### +################## $VERSION = "1.0.0"; Win32::Process::Create($ProcessObj, "$ENV{'SystemRoot'}/notepad.exe", "notepad test.txt", 0, # Don't inherit. NORMAL_PRIORITY_CLASS, ".") or die "Cannot Launch Anything\n"; if ($ProcessObj->Wait (10*1000)){ # execution of the process is successfully. $ProcessObj->Kill(0); print "Successful\n"; } else { # process has hung up for some reason print "The Process Hung - Killing it\n"; $ProcessObj->Kill(255); }

    Update2: I seem to have gone down the wrong track.. :(

    -----
    Of all the things I've lost in my life, its my mind I miss the most.
      Unfortunately, this is not the way - since I need not only to shut the program down, but to undertake a number of maintainance procedures, that are located in a sub of the server script. Also, the Win32::Process->Wait($timeout) is waiting for the process to shutdown, and if that does not occur for $timeout, then the process is being shut down. And that is absolutely not what is needed :(

      Also, alarm does not work on Windows, as far as I recall.
Re: Timeouts/timers on Win32 system
by Thelonius (Curate) on Dec 08, 2003 at 15:22 UTC
    The best way is to use the select system call (note there are two different select functions in Perl). It's a bit easier to use it via the IO::Select module. Something like this would work:
    if (IO::Select->new(SOCKETHANDLE)->can_read($timeout)) { do the socket read as normal } else { you timed out }
Re: Timeouts/timers on Win32 system
by Anonymous Monk on Dec 08, 2003 at 15:23 UTC
    use IO::Select; my $s = IO::Select->new($socket); while (not $done) { my @socks = $s->can_read($timeout); if (@socks) { read_socket(); whatever(); } else { close_process(); } }
      Tried it finally, and yes, it works perfectly. Thank you very much!!!
Re: Timeouts/timers on Win32 system
by BrowserUk (Pope) on Dec 08, 2003 at 20:14 UTC

    This isn't a fully worked solution, but it does demonstrate that it is reasonably easy to simulate the unix alarm function under Win32.

    #! perl -slw use strict; use threads; use threads::shared; my $alarmFlag : shared = 0; $SIG{__WARN__} = sub{ $alarmFlag = 1; }; sub myAlarm { my( $procID, $timeout ) = @_; async sub{ Win32::Sleep $timeout; warn 'Timeout'; }; } myAlarm( $$, 3000 ); while( not $alarmFlag ) { print 'Waiting for the alarm at ', scalar localtime; print 'Tum te, tum te, tum'; Win32::Sleep 1000; } print 'The alarm was raised', $/; $alarmFlag = 0; myAlarm( $$, 3000 ); while( not $alarmFlag ) { print 'Waiting for the alarm at ', scalar localtime; print 'Tum te, tum te, tum'; Win32::Sleep 1000; } print 'The alarm was raised', $/; __END__ P:\test>alarm Waiting for the alarm at Mon Dec 8 20:03:19 2003 Tum te, tum te, tum Waiting for the alarm at Mon Dec 8 20:03:20 2003 Tum te, tum te, tum Waiting for the alarm at Mon Dec 8 20:03:21 2003 Tum te, tum te, tum The alarm was raised Waiting for the alarm at Mon Dec 8 20:03:22 2003 Tum te, tum te, tum Waiting for the alarm at Mon Dec 8 20:03:23 2003 Tum te, tum te, tum Waiting for the alarm at Mon Dec 8 20:03:24 2003 Tum te, tum te, tum The alarm was raised

    This could be done a lot more effectively at the perl source level, and even made more sensible by a few pretty trivail patches to the perl sources. Changing the current default behaviour for most of the signals under Win32 which is set to die for pretty much anything other than a couple of exceptions -- which is just about the strangest choice of default behaviour possible as it make it impossible to code a more compatible workaround as you never get the opportunity to trap them? Strange choice.


    Examine what is said, not who speaks.
    "Efficiency is intelligent laziness." -David Dunham
    "Think for yourself!" - Abigail
    Hooray!
    Wanted!

      Thanks for the replies chaps.

      Bit busy at work atm on other projects will test these out in a couple of days and report.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://313091]
Approved by Thelonius
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (6)
As of 2014-07-31 22:22 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (254 votes), past polls