Well I'm actually trying to probe a number of servers using WMI, it's about 300 servers and occassionaly one will not respond causing the script to hang indefinetely.

For your alarm suggestion, I've tried trying to work with the alarm funtion but had no joy, for example the following doesn't work.

(using my $buf=<>; instead of the wmi stuff)

$SIG{'ALRM'}=\&time_out;

while(1) {

  eval {
    alarm(5);
    my $buf=<>;
    alarm(0);
  };

  print "next\n";

}

exit;

sub time_out {
    print "fed up waiting, next please\n";
    die "FED UP WAITING";
}
[download]

The script should wait for user input, and get 'fed up' after 5 seconds. Problem being the alarm never seems to get called.

also the actual `perldoc -f alarm` example doesn't seem to work either.

eval {
    local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
    alarm 2;
    `dir /s c:`;
    alarm 0;
};
[download]

Surely alarm should interrupt the timeconsuming `dir /s c:` (recursive dir) after 2 seconds?

Like I said before, PodMaster demonstrated that 5.8.4 has an alarm function, but it doesn't appear (to me?) capable of interupting IO, which is somewhat limiting in application.

As I also said, there are (usually) other ways of interupting things that take a long time. The problem is that what will work for one thing will not necessarially work for another, so you need to be specific about what it is your doing instead of keep posting the same hypothetical question.

For example, the psuedo problem you've posed could be tackled this way:

#! perl -slw
use strict;
use Term::ReadKey;

$| = 1;

sub ReadLine {
    my $timeout =  shift;
    my $start = time;
    ReadMode 1;
    my $buf;
    while( time < $start + $timeout ) {
        if( my $c = ReadKey 0.5 ) {
            printf $c;
            $buf .= $c;
            
            ReadMode( 0 ), return $buf if ord( $c ) == 13;
        }
    }
    ReadMode 0;
    return undef;
}
    

for my $n ( 1 .. 10 ) {
    if( my $buf = ReadLine( 10 ) ) {
        print "$n Got $buf";
    }
    else {
        print "$n timed out";
    }
    
}
__END__
[16:35:02.57] P:\test>alarmed.pl
Subroutine ReadLine redefined at P:\test\alarmed.pl line 7.
1 Got fred
2 Got bill
3 Got John
4 timed out
5 timed out
6 timed out
7 Got blech
8 Got one
9 Got two three
10 Got four
[download]

But that almost certainly won't solve your problem. I also previously referred you to this thread Timeouts/timers on Win32 system, which contains a couple of other possible solutions. One using threads and one using Win32::Process.

Which, if any of these solutions might work for your particular problem depends very much on what your real problem is, but keep asking "Why doesn't alarm work", won't make it work.

Well in fairness my original question wasn't why "won't alarm work", this thread has just gone that way so I've addressed the suggestions given.

It's hard to provide more detail than I already have...

The program I'm struggling in is rather big, here it is again but with the WMI server probing line included and sql queries changed for @array values to simplify.

use strict;
use Win32::OLE qw (in);

my @servers=('servera','serverb','serverc');

foreach(@servers) {

  my $server=$_;
  $server=~s/^\s+|\s+$//g;
  my $namespace="\\root\\cimv2";

  my $object=Win32::OLE->GetObject( "winmgmts:{impersonationLevel=impe
+rsonate,(security)}//".$server.$namespace );} or die "could not get o
+bject";

  # NOW GET DRIVE INFO THROUGH WMI
}
[download]

The script goes to each server in turn, tries to initiate a WMI connection and fails on one server at the my $object line, due to some issue with the server. Instead of timing out the script just hangs there... forever. Hence the need for a script to somehow prevent this happening.

I am not asking for a solution including alarm, I've already explored using alarm to some depth, however I'm very willing to explore it further when suggestions pop up, i.e. the Time::HiRes one. I did try Win32::Process with the idea that the child could signal its parent after a set amount of time (as a substitue to alarm) but I couldn;t get the parent to seccussfully recieve a signal from it's child process.

This is untested code. I don't have a bunch of servers against which to test.

The basic idea is that you detch a thread that makes the connection to the server. You arrange a shared flag to be clear before the WMI attempt is made and set after.

The main thread then waits for the flag to be set or timeout. If timeout occurs, then it just leaves the thread hanging. It will get cleaned up when the process exits. This is not particularly elegant, but iThreads lacks a defined API for killing a thread.

I do have a mechanism that will do this by using the Win32API TerminateThread() which seems to work okay in my limited testing, but it could leave Perl in a confused state. Better I think to let any nasties happen when the process is going to exit anyway.

#! perl -slw
use strict;
use threads qw[ async ];
use threads::shared;
use Win32::OLE qw (in);

my @servers = qw[ servera serverb serverc ];
my $namespace="\\root\\cimv2";

for my $server ( @servers ) {
    my $gotObject : shared = 0;
    my $gotInfo   : shared = 0;
    my %info      : shared;
    async {
        my $object=Win32::OLE->GetObject( 
            'winmgmts:{impersonationLevel=impersonate,(security)}//'
             . $server
             . $namespace
        ) or die "could not get object";
        
        $gotObject = 1;

        # NOW GET DRIVE INFO THROUGH WMI
        $info{ somekey } = 'somevalue';
        $info{ someotherkey } = 'someothervalue';
        
        ## Yada yada

        undef $object;

        ## Last thing before exiting thread.
        $gotInfo = 1;
    }->detach;
    
    my $timeout = 30;
    sleep 1 while $timeout-- and not $gotObject;
    unless( $timeout ) {
        print "Failed to make connection to $server";
        next;
    }
    sleep 1 until $gotInfo;
    
    print "Received from $server";
    print "$_ => $info{ $_ }" for sort keys %info;    
}
[download]

The next logical progression once your using threads would be to overlap the connections to all the servers and queue the results back to the main thread for final disposal. The reason I am not suggesting this is that some OLE objects are not designed for being called from multiple threads. Also, I have experienced some problems with using Win32::OLE from multiple concurrent threads.

Sorry it's not a tested solution. If it works, it would be most useful to those whom follow after you if you could post back a working copy of this test code with any corrections you have to make. Thanks.

---

Examine what is said, not who speaks.

"Efficiency is intelligent laziness." -David Dunham
"Think for yourself!" - Abigail
"Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon

How 'bout this?
I'm making the assumption that you can create a process out of ...->GetObject(.);
On my win2K box this creates the processes every 5 secs. you can kill them in the if stmt if necessary...

use Win32::Process;
...
...
my $pID;

foreach (servers) {
...
...
Win32::Process::Create ($pObj, Win32::OLE->GetObj..., ....);
$pID = $pObj->GetProcessID();
$pObj->Wait(5000) # 5 secs

// it's either been 5 secs or $pObj finished
if ($pID is there) {
    then it's been 5secs
    cleanup and restart your loop
} else {
   $pObj finished?
}
}
[download]

#!/usr/bin/perl
use strict;

my $ndx = 0;
my @servers = (1,2,3,4);
my $globalServerNum;
 
$SIG{'ALRM'} = \&time_out;
 
print "\n\n";
foreach $ndx  (@servers) {
     $globalServerNum = $ndx;
     eval {
         alarm(5);
         print "server $ndx please respond: ";
         my $answer = <STDIN>;
         my $timeleft = alarm(0);
         print "($timeleft) sec left\n";
    }
}
 
print "\nbye bye end-of-workday\n";
exit;
 
sub time_out {
      print "\nserver $globalServerNum timed out, go next\n";
     next;
     #die "FED UP WAITING";
}
[download]

That code just sists there for me doing nothing.

It displays

server 1 please respond:

indefinetely. =(

Incidently the die is required (for the purposes of the script). The eval and die actually work hand in hand, when an eval is called the program takes note the exit bracket in the eval statement. When if a die is called within an eval the program will not fall over, instead execution will continue from the final eval bracket previously remembered. Hence the alarm should trigger a die which causes immediate exit from the eval.