#!/usr/bin/perl
# this is the init script
use warnings;
use strict;
use IPC::SysV qw(IPC_STAT IPC_PRIVATE IPC_CREAT IPC_EXCL S_IRUSR S_IWUSR IPC_RMID S_IRWXU);
use IPC::Msg;

# see "perldoc perlfunc /shmget" and "perldoc perlipc /SysV"
# big difference from c is attach and detach is automatic in Perl
# it attaches to read or write, then detaches

my $IPC_KEY = 1234;
my $msg = new IPC::Msg($IPC_KEY, S_IRWXU | IPC_CREAT);

my $go = 1;
$SIG{INT} = sub{ $go = 0; 
                &close_m();   #close up the shared mem
	        exit;
		};

my $segment_hbytes = 0x640;   # hex bytes, a multiple of 4k
 my ($segment_id, $segment_size) = &init_m($segment_hbytes);
print "shmid-> $segment_id\tsize-> $segment_size\n";

# put the shmid on the message queue
# 1 message for each client to connect
# since each read shifts one off
my $msgout = $segment_id;

my $numclients = 3;

for(1..$numclients){
 $msg->snd(1, $msgout, 0 );
}

#check it ( will reduce the number of msgs available
#my $msgin = '';
#$msg->rcv($msgin, 8 ,0); # 8 bytes for a Perl integer
#print "msgin->$msgin\n";

#$msg->rcv($msgin, 8 ,0); # 8 bytes for a Perl integer
#print "msgin1->$msgin\n";

my $i = 'a';
while($go){ 
          &write_m($i); 
          $i++; 
	  select(undef,undef,undef,.1);
          last if ! $go;
	}

exit;

#################################################################
sub init_m(){
 
 my $segment_hbytes = shift;
 
# Allocate a shared memory segment. 
  my $segment_id = shmget (IPC_PRIVATE, $segment_hbytes,
		       IPC_CREAT | IPC_EXCL | S_IRUSR | S_IWUSR);

# Verify the segment's size.
  my $shmbuffer = '';
  shmctl ($segment_id, IPC_STAT, $shmbuffer);
  my @mdata = unpack("i*",$shmbuffer); 
return($segment_id, $mdata[9] );
}


sub write_m() {    
   # Write a string to the shared memory segment.
   my $message = shift;
   shmwrite($segment_id, $message, 0, $segment_size) || die "$!";
   return 0;
  }


sub close_m(){
 # Deallocate the shared memory segment.
  shmctl ($segment_id, IPC_RMID, 0);
  $msg->remove;
  return 0;
}
__END__