Does my original hang under that version of Perl &| windows?

i didnt try yours till now cuz you used system, i wanted to see how the fork ran on win. Yours worked fine. Your $pid is positive rather than the negative one from the perlfork version and is a real pid that kill can watch ok. the $pid from perlfork is negative, an pseudo-pid, and it seems kill didnt think it was "done" till the waitpid call ran.

the $pid from perlfork is negative, an pseudo-pid, and it seems kill didnt think it was "done" till the waitpid call ran.

Okay. Thanks for the explanation. I was confused about what was going on there for a while.

---

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority". The enemy of (IT) success is complexity.

In the absence of evidence, opinion is indistinguishable from prejudice.

Thank you, huck++.

Just completed testing on WIndows, Linux, and Mac OS. We have a UDP solution that works on multiple platforms. Fortunately, Perl provides $^X, giving us the path to the perl executable.

use strict;
use warnings;

use Fcntl qw( F_GETFL F_SETFL O_NONBLOCK );
use IO::Socket::INET qw( SOL_SOCKET SO_REUSEADDR );

## POSIX.pm is a big module. This covers most platforms.
use constant { _WNOHANG => $^O eq 'solaris' ? 64 : 1 };

my $port = 54321;

my $socket = IO::Socket::INET->new(
    Proto     => 'udp',
    LocalPort => $port,
    LocalAddr => '127.0.0.1'
);

die "Unable to bind to 127.0.0.1:$port: $!\n" unless $socket;

setsockopt( $socket, SOL_SOCKET, SO_REUSEADDR, 1 );
stop_blocking( $socket );

$SIG{CHLD} = 'IGNORE'; my $pid = fork;
die "Could not fork: $!\n" unless ( defined $pid );

exec( $^X, 'monitored.pl', $port ) if ( $pid == 0 );

$| = 1;

while ( waitpid($pid, _WNOHANG) == 0 ) {
    my $addr = recv( $socket, my $time, 1024, 0 ) or select '','','',0
+.015;

    printf "\rProgress: %s", $time;
}

print "\nAll done.\n";

sub stop_blocking {
    my $socket = shift;

    if ($^O eq 'MSWin32') {
        my $flag = 1; ioctl($socket, 0x8004667e, \$flag);
    }
    else {
        my $flags;
        $flags = fcntl($socket, F_GETFL, 0)
            or die "Could not getfl: $!\n";
        $flags = fcntl($socket, F_SETFL, $flags | O_NONBLOCK)
            or die "Could not setfl: $!\n";
    }
}
[download]

Not changed from before, the monitored.pl script using IO::Socket::INET.

use strict;
use warnings;

use IO::Socket::INET qw( pack_sockaddr_in inet_aton );

my $port    = shift || 54321;
my $socket  = IO::Socket::INET->new( Proto => 'udp' );
my $runtime = rand 10;

$| = 1;

for my $num ( 0 .. $runtime * 100 ) {
    send ( $socket, sprintf("%.f%% ", $num / $runtime),
           0, pack_sockaddr_in($port, inet_aton('127.0.0.1'))
    ) or  die "send: $^E";

    select '', '', '', 0.015;
}
[download]

Yea posix is huge, if that works for you go for it!

Another interesting wrinkle is that if you dont supply a LocalPort => on the new it will pick a "random?" UNUSED port. You can then find what the port is via my $port=$socket->sockport ();. I cant find a reference to this right now, but this goes way back, possibly as part of the native socket calls.

so if you replace

 
my $port = 54321;

my $socket = IO::Socket::INET->new(
    Proto     => 'udp',
    LocalPort => $port,
    LocalAddr => '127.0.0.1'
);

die "Unable to bind to 127.0.0.1:$port: $!\n" unless $socket;
[download]

with

my $socket = IO::Socket::INET->new(
    Proto     => 'udp',
    LocalAddr => '127.0.0.1'
);

die "Unable to bind to 127.0.0.1: $!\n" unless $socket;

my $port=$socket->sockport (); 
print 'on:'.$port."\n";
[download]

you can still pass the port to the monitored.pl, it is less likely somebody can spoof udp "input" to you, and you can have more than one running at the same time.

Re: Another interesting wrinkle is that if you dont supply a LocalPort => on the new it will pick a "random?" UNUSED port. You can then find what the port is via my $port=$socket->sockport ();.

Thank you, huck++.

The if statement is helpful to update only when $time contains data. The cursor appears fixed now.

printf "\rProgress: %s", $time if $time;
[download]