in reply to Shared memory and asynchronous access

Personally, if it is important to keep the two parts of your application as separate processes, I'd use udp (which should work on any platform) for the IPC.

The monitoring script would have something like this:

#! perl -slw
use strict;
use Time::HiRes qw[ time sleep ];
use IO::Socket;

$|++;

my $port = 54321;
socket( SOCKET, PF_INET, SOCK_DGRAM, getprotobyname('udp') ) or die "s
+ocket: $!";
setsockopt( SOCKET, SOL_SOCKET, SO_REUSEADDR, 1 );
bind( SOCKET, sockaddr_in( $port, inet_aton( 'localhost' ) ) ) or die 
+$^E;
my $true = 1; ioctl( SOCKET, 0x8004667e, \$true );

my $pid = system 1, "/perl64/bin/perl.exe", "monitored.pl",$port;

my $time;
while( kill 0, $pid ) {
    my $addr = recv( SOCKET, $time, 1024, 0 ) or select '','','',0.001
+;
    printf "\rProgress:%s\t", $time;
}

print "All done.";

[download]

And the monitored script only needs minimal code, that will have little or no effect on its performance if it is being run stand alone:

#! perl -slw
use strict; ## monitored.pl
use IO::Socket;

$|++;

my $port = shift;
socket( SOCKET, PF_INET, SOCK_DGRAM, getprotobyname('udp') ) or die "s
+ocket: $!";


my $runtime = rand( 120 );
for my $milli ( 0 ..  $runtime * 1000 ) {
    select '','','', 0.001;
    send( SOCKET, sprintf( "\r%.f%%\t", $milli / ($runtime*10) ), 0, s
+ockaddr_in( $port, inet_aton( 'localhost' ) ) ) or  die "send: $^E";
}

[download]

Simple, reliable and minimally invasive.

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.

Replies are listed 'Best First'.
Re^2: Shared memory and asynchronous access
by Anonymous Monk on Apr 06, 2017 at 07:49 UTC

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

      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]

        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]
      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]

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

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

      [download]
[reply]
[d/l]

      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]
Re^2: Shared memory and asynchronous access
by huck (Prior) on Apr 06, 2017 at 05:39 UTC

    When i first saw this i wondered what select was doing in there, with empty texts for RBITS,WBITS,EBITS even. Then i realized it was just a sub-second sleep. is that correct?

    Second i wondered what empty text strings would do to select. Didnt try it, but http://perldoc.perl.org/functions/select.html suggests this select(undef, undef, undef, 0.001); instead.

[reply]
[d/l]
      Then i realized it was just a sub-second sleep. is that correct?

      Yes.

      http://perldoc.perl.org/functions/select.html suggests this select(undef, undef, undef, 0.001); instead.

      Indeed. The empty strings version is just less typing; and appears to have no measurable affect on the functionality.

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

In Section Seekers of Perl Wisdom