strat has asked for the wisdom of the Perl Monks concerning the following question:

Dear monks,

I just installed Activestate Perl 5.8 Beta Built 802 under Win2k and played around a bit with threads. Due to the good tutorial at YAPC::Europe everything worked fine...

Then I got a bad idea; i remembered an old DOS program which waited for an input for n seconds, and if it didn't come within those n seconds, it continued with a standard value. I forgot its name, but maybe you know it. Well, might be possible doing so by using threads, I thought...

Here are some lines of code: 

#! /usr/bin/perl
use 5.008;
use strict;
use warnings;
use threads;
use threads::shared;
 
our $Input : shared = "";

sub getInput {
    print "Please enter some- or nothing: ";
    my $input = <STDIN>; chomp($input);
    $Input = $input if defined $input; # or whatever...
}

my $oldInput = $Input;

my $inputThread = threads->create('getInput');

sleep 5;
unless ($Input eq $oldInput) {
    $inputThread->join();
    print "Input was: $Input\n";
    sleep 2;
}
else {
    print "Continuing with 'abcd' as a standard value...\n";
    # WHAT CAN I DO HERE ?
    
}

[download]
Well, my problem is how to get rid off the blocked thread if the user doesn't enter anything... If I run $inputThread->join, the program will block forever. If I run $inputThread->detach() (or do nothing), I will at least be able to continue with my main program, but have got a blocked thread somewhere, and if a user enters anything later, it might give strange results because the shared Variable $Input suddenly has got another value.

Do you know how to solve this problem? (It is not a production problem, but I'm very interested if and how this can be done with threads; well, with fork it wouldn't be a big problem...)

Best regards,
perl -e "s>>*F>e=>y)\*martinF)stronat)=>print,print v8.8.8.32.11.32"

Replies are listed 'Best First'.
Re: "killing" perl5.8-threads
by strider corinth (Friar) on Nov 13, 2002 at 21:05 UTC
    Here's one way to do it: 
    use IO::Handle;

# do stuff

my $input_thread = threads->new( \&getInput );      # start the thread
+, wait for input

# do stuff if you feel like it

my $input = $input_thread->join || 'default input'; # wait for thread 
+to return

sub getInput {
    my $h = IO::Handle->new_from_fd( *STDIN, r );
    $h->blocking( 0 );    # don't wait for input to return from read()
+s

    my $time  = time(); 
    my $input = '';

    while( 1 ){
        $h->read( $input, 20, 0 );  # read 20 chars of info if it's av
+ailable
        chomp $input;  
        last if $input;             # return if we got input
        last if time() - $time > 5; # return if 5 seconds have passed
    }
}

    [download]

    I'll admit that this isn't the most threads-specific way to do it: it could also be implemented without threads. But it will allow you to do other things while data is being gathered, so I think it should work for you. If IO::Handle uses alarm, and I don't think it does, this will fail on Windows anyway.

    I have another idea that's slightly more thread-dependent, but I don't have time to think it through or test it. You could send a signal to the thread after five seconds, and then join() it. The thread would have a local $SIG{SOMETHING} to catch the signal you throw at it, and exit without finishing whatever it's doing. How to send a signal to a thread, though, is doubtless an OS-dependent thing. If it has a separate PID and you can find it, great. If not, you may need to send a harmless (or intentionally ignored) signal to the main process. And it may just be impossible. ;)
    --
    Love justice; desire mercy.
[reply]
[d/l]
Re: "killing" perl5.8-threads
by waswas-fng (Curate) on Nov 13, 2002 at 17:43 UTC
    Try using alarm: 
     eval {
        local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
        alarm $timeout;
        $nread = sysread SOCKET, $buffer, $size;
        alarm 0;
    };
    if ($@) {
        die unless $@ eq "alarm\n";   # propagate unexpected errors
        # timed out
    }
    else {
        # didn't
    }

    [download]

    -Waswas
[reply]
[d/l]
      Bah, missed the part about windows, If i remember right one of the ways to get around this was to use a SIG INT handeler and thread (or emulated fork) that kills (INT) the pid after x seconds. kinda an alarm like hack. If I can track down my code for this I will post it.

      -Waswas
[reply]
Re: "killing" perl5.8-threads
by nothingmuch (Priest) on Nov 13, 2002 at 19:28 UTC
    The function select (four argument) checks for input (and more), with a timeout specifiable. What you need to do is tell select to peek at STDIN. You specify it via creating a bit vector, with the file descriptor for a handle you want to check. fileno returns the file descriptor for a file handle. select will block, and if some input is available it'll work.

    Note that buffering may do funny stuff though... On my MacPerl "terminal" select will not detect input until a newline is entered, because select is not stdio aware. Which brings me to it's caveat: don't use it with stdio unless you're well aware of how the buffering works. You should usually use it with sysread (and syswrite when testing for output readiness). Provided that you haven't read on STDIN yet, this example should work (it may work if you already read, but i can't guarantee):
    my $rin = '';
vec($rin,fileno(STDIN),1) = 1;

my $rout;
my $val = "Default";
if (select($rout = $rin,undef,undef,5)){
    my $val = <STDIN>;
} else {
    print "Default used\n";
}

print "\n\nThe value: $val\n";

    [download]


    Update: I'm sorry, I didn't realize I didn't answer your question at all... =P
    In general, to stop blocking, you have to get something on the outside to tell you to stop. You need to allow the blocking thread to receive such a message, from someone else, telling it when to stop. The eval and alarm pairing is the most common for timeouts, and it has already been described. alarm gets the kernel to tell you when to stop. I think, however, that win32 has alarm prollums. Try Super Searching on alarm and windows... If I recall Win32::Events may be of aid aswell.

    -nuffin
    zz zZ Z Z #!perl
[reply]
[d/l]

Back to Seekers of Perl Wisdom