in reply to Re: Shared memory and asynchronous access
in thread Shared memory and asynchronous access

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";
    }
}

[download]

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;
}

[download]

Replies are listed 'Best First'.
Re^3: Shared memory and asynchronous access
by huck (Prior) on Apr 06, 2017 at 09:04 UTC

    Changing the while loop to 

    use POSIX ":sys_wait_h";
while ( kill(0, $pid) ) {
    my $addr = recv( $socket, my $time, 1024, 0 ) or select '','','',0
+.015;

    printf "\rProgress: %s", $time;
    my $res = waitpid($pid, WNOHANG);
    }

    [download]
    made the original not hang on 
    This is perl 5, version 20, subversion 1 (v5.20.1) built for MSWin32-x
+86-multi-thread-64int
(with 1 registered patch, see perl -V for more detail)

Copyright 1987-2014, Larry Wall

Binary build 2000 [298557] provided by ActiveState http://www.ActiveSt
+ate.com
Built Oct 15 2014 22:10:49

    [download]

[reply]
[d/l]
[select]

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

      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.
[reply]

        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.

[reply]

      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]
[reply]
[d/l]
[select]

        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.

[reply]
[d/l]
[select]

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

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

        [download]
[reply]
[d/l]
Re^3: Shared memory and asynchronous access
by vef445 (Novice) on Apr 06, 2017 at 11:07 UTC
    Thanks for the reply. IO::Socket::INET was actually one of the first packages I tried (and I tried a lot of them...), but my Mac would systematically deny opening a socket. Sure I could have configured it to go around that but I thought I could find another solution than a network protocol that can always be blocked by some firewall or similar program.
    Just to add a little bit of context since it doesn't seem to be clear in my first post, this program I'm writing is meant to be used by anyone without special configuration (if possible).
[reply]
      my Mac would systematically deny opening a socket.

      Even non-system ports, (those > 1024) and when used in conjunction with the loopback address (127.0.0.1)?

      (If so, you can add that as another reason (to the existing couple of hundred) why I'll never buy an Apple product.)

      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.
[reply]

        On the loopback address? yes
        On ports >1024?...I don't remember what I tried...

        I test and build my application on MacOS, Windows 10 (64 and 32), and Debian (64). MacOS is by far the OS where I meet the least problem to install and use the various Perl packages :)

[reply]
Re^3: Shared memory and asynchronous access
by Anonymous Monk on Apr 06, 2017 at 07:52 UTC

    mon2.pl in the main script is met to be monitored.pl

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

    [download]
[reply]
[d/l]
Re^3: Shared memory and asynchronous access
by Anonymous Monk on Apr 06, 2017 at 08:00 UTC

    The SIG CHLD line is not met for the Windows platform. It was a last minute change when testing on Unix.

    $SIG{CHLD} = 'IGNORE' if ( $^O ne 'MSWin32' );

    [download]
[reply]
[d/l]

      That didn't work. The following now works on Windows and Unix including Cygwin.

      my $pid;

if ( $^O eq 'MSWin32' ) {
    $pid = system 1, $^X, 'mon2.pl', $port;
}
else {
    $SIG{CHLD} = 'IGNORE';
    $pid = fork; die "Could not fork: $!\n" unless defined $pid;
    exec( $^X, 'mon2.pl', $port ) if ( $pid == 0 );
}

      [download]
[reply]
[d/l]

        The exec line is met to run monitored.pl, not mon2.pl.

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

        [download]

        Thank you, BrowserUk++.

[reply]
[d/l]

In Section Seekers of Perl Wisdom