girishatreya2005 has asked for the wisdom of the Perl Monks concerning the following question:

Hi Wise ones,

I have created a pipe to establish communication between a parent and multiple children it has forked.

In this scenario only the children would be doing the writes while the parent will just do the reads.

To serialize the writes to the pipe, I've used a semaphore. To do the reads from the pipe I've not specified any locking on the pipe.

But the reads/writes dont seem to be happening as planned. Please let me know what I've missed. I've included the sample code. 

######Semaphore implementation #####

use IPC::Semaphore
sub IPC_PRIVATE {0};
sub IPC_RMID    {10};
sub IPC_CREAT   {0001000};
sub GETVAL      {5};


sub semwait {
    my $sem=shift;
    semop($sem, pack("s3", 0, -1, 0)) || die "semw: $!\n";
}

sub semsign {
    my $sem=shift;
    semop($sem, pack("s3", 0, +1, 0)) || die "sems: $!\n";
}

my $sem=semget(&IPC_PRIVATE, 1, &IPC_CREAT | 0666) || die "semget: $!\
+n";
warn "semid= $sem\n";
semsign($sem);


####### Pipes implementation ########

use IO::Handle;
pipe(PARENT_READ, PARENT_WRITE);
PARENT_WRITE->autoflush(1);

#### In the child process #####

{
   semwait($sem);
   print PARENT_WRITE "PID : Pid of the process is $$ \n" ;
   print PARENT_WRITE "SIGNAL : Signal sent from the process \n";
   semsign($sem);

}

##### In the parent ##### 
{
  while ( $msg = <PARENT_READ> && $signal_received < $total_signals )
   {
     if($msg =~ /PID/)
     {
      chomp($msg);
      my @fields = split (/ /,$msg);
      print "Child with fields @fields has communicated to me \n";
     ##### This print statement is not printing anything either on the
+ console or even if I redirect it to a file 
     }
   } 
}

[download]

Replies are listed 'Best First'.
Re: Regulating write access to pipes using semaphores
by almut (Canon) on Jul 26, 2010 at 14:42 UTC
    But the reads/writes dont seem to be happening as planned.

    As the snippets of code you've posted are incomplete (and thus do not allow to reproduce the issue), it would help if you could describe in more detail what exactly is happening (and what you expect), and also what is setting the values of $signal_received and $total_signals.

[reply]
[d/l]
[select]
Re: Regulating write access to pipes using semaphores
by morgon (Priest) on Jul 26, 2010 at 15:13 UTC
    Post your full code please.

    It could be buffering issue, as while you turn off buffering for the childs to write, the read from the parent will still be buffered.

[reply]

      It was a mistake on my side . Semaphores are regulating the write access . I've included the sample code. Thanks for the replies wise ones. 

      #! /usr/bin/perl -w
use strict ;
use Socket;
use IO::Handle;
use IPC::Semaphore ;

pipe(PARENTREAD, PARENTWRITE);
PARENTWRITE->autoflush(1);

my $sem=semget(&IPC_PRIVATE, 1, &IPC_CREAT | 0666) || die "semget: $!\
+n";
warn "semid= $sem\n";
semsign($sem);

sub IPC_PRIVATE {0};
sub IPC_RMID    {10};
sub IPC_CREAT   {0001000};
sub GETVAL      {5};


sub semwait {
    my $sem=shift;
    semop($sem, pack("s3", 0, -1, 0)) || die "semw: $!\n";
}

sub semsign {
    my $sem=shift;
    semop($sem, pack("s3", 0, +1, 0)) || die "sems: $!\n";
}
 
 sub main ()
 {
    my $msg ; 
    print "I'm in the parent now \n";
    for (my $count = 1 ; $count < 25 ; $count++ )
    {
        my $child_pid  = forker();
        print "The child process had pid of $child_pid \n";
    }    
    my $count = 1 ;
    open (FH, '>>' , 'test.txt');
    
    while ($msg = <PARENTREAD> )
    {
        if ($msg =~ /PID/)
        {    
            $count++ ; 
            print "Increasing the count to $count \n";
            print FH "$msg";
            if($count == 24 )
            {
                last ;
            }
        }
    }
 }
 
 sub forker()
 {
    #print " Child is forking \n" ;
    my $child_pid ;
    my $panic_monitor_pid ; 
    if(!defined($child_pid = fork()))
    {
        print " Forking of child failed \n";
        die "Dying abruptly\n";
    }elsif($child_pid > 0)
    {
      print "In parent \n";
      return $child_pid ; 
    }else
    {
      #print "In child now \n The child had pid $$" ;
      $panic_monitor_pid = grandchild();
      #print " The grand child has pid of $panic_monitor_pid \n";
      exit ;
    }
}

 sub grandchild ()
{
    my $child_pid ;
    my $panic_monitor_pid ; 
    if(!defined($child_pid = fork()))
    {
        print " Forking of child failed \n";
        die "Dying abruptly\n";
    }elsif($child_pid > 0)
    {
      #print "In parent \n";
      return $child_pid ; 
    }else
    {
      semwait($sem); 
      print PARENTWRITE "In the grandchild \n";
      print PARENTWRITE "PID : The child had pid $$\n" ;
      semsign($sem);
      #$panic_monitor_pid = panic_monitor();
      #print " The grand child has pid of $panic_monitor_pid \n";
      exit ;
    }    
}

main();

      [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom