Dear Monks,

The original code I posted mixed both unbuffered and buffered I/O. With this version, I'm only using unbuffered I/O and hopefully the file does not get clobbered during the processing. The file should allways end with '999999' without a line feed. Your comments are welcome...Ed 

#!/usr/bin/perl
use warnings;
use strict;
use Time::HiRes qw( gettimeofday usleep );
use Fcntl qw( :DEFAULT :flock );            ## Part of core perl

    my $file = "/dev/shm/FlexBase/__env.index";
#    my $file = "/__env.index";
#    my $file = "/flexvault/__env.index";

    our $PREFORK = 0; our $children = 0; our @CHILDREN = (); our $list
+ = "";
for $PREFORK ( 1..6 )
{    open( my $indexdb,">", $file ) or die "Not open1: $!"; close $ind
+exdb;
    $SIG{CHLD} = 'IGNORE';
    $children = 0; @CHILDREN = (); $list = "";
    my $stime = gettimeofday;
    for ( 1 .. $PREFORK )
    {    my $pid = fork;
        if ( $pid )
        {    # parent
            $CHILDREN[$children] = $pid; $children++;
            if ( $list ) { $list .= ", $pid"; }
            else { $list = $pid; }
        }
        elsif ( defined $pid )
        {    # child
            sysopen( $indexdb, $file, O_RDWR | O_SYNC | O_NONBLOCK ) o
+r die "Not open2: $!";
            my $i = 0;
            while( 1 )
            {    &write_mem($indexdb, $i);
                $i++; if ( $i >= 1_000_000 ) { last; }
            }
            close $indexdb;
            exit;
        }
        else { die "Can't fork: $!"; }
    }
    print "$PREFORK children started by $$: $list\n";
    while ( 1 )
    {    usleep 15000; my $child = 0;
        for my $no ( 0..$#CHILDREN )
        {    my $pid = $CHILDREN[$no] + 0;
            if ( kill 0 => $pid ) { $child++; }
        }
        if ( $child == 0 ) { last; }
    }
    my $Total = $PREFORK * 1_000_000;
    $stime = gettimeofday - $stime; my $rpm = int( $Total / $stime );
    print "   $Total   $stime   $rpm/second   \`cat $file\` = ";
    system("cat $file"); print "\n";
}
    unlink $file;
    exit;

sub write_mem()
{    # Write a string to the shared file. 
    my $indexdb = shift; my $message = shift;
    if ( flock( $indexdb, LOCK_EX ) )
    {    my $ret = sysseek( $indexdb, 0, 0); # move to beginning of fi
+le
        if ( ! defined $ret ) {    die "$$ O04. $message sysseek faile
+d: $!\n"; }
        $ret = syswrite ( $indexdb, $message, length($message), 0 );
        if ( $ret != length($message) ) { die "$$ O05. $message|$ret s
+yswrite failed! $!\n"; }
        flock( $indexdb, LOCK_UN );
    }
    else { print "$$ O07. flock failed! $!"; }
    return 0;
}

1;

__END__

[download]

Regards...Ed

"Well done is better than well said." - Benjamin Franklin

In reply to Re: SysV shared memory (Look-Alike) -- pure perl by flexvault
in thread SysV shared memory (Look-Alike) -- pure perl by flexvault

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.