The following is based on BrowserUk's++ demonstration.
I tried a cross-platform solution and tested on Windows, Linux, and Mac OS. To make this interesting, am using IO::Socket::INET.
On the Windows platform, the time resolution in Perl is 0.015 milliseconds. Meaning, 0.001 ends up taking 0.015 time. Therefore, am passing 0.015 to select to have Unix sleep just as long.
use strict; use warnings; use IO::Socket::INET qw( SOL_SOCKET SO_REUSEADDR ); use Fcntl qw( F_GETFL F_SETFL O_NONBLOCK ); 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, 'mon2.pl', $port ) if ( $pid == 0 ); $| = 1; while ( kill(0, $pid) ) { 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"; } }
The monitored.pl script.
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; }
In reply to Re^2: Shared memory and asynchronous access
by Anonymous Monk
in thread Shared memory and asynchronous access
by vef445
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |