object & fork 
Author Message
 object & fork

Hi Group,
I need your help with an object that forks and looses parameters.
The purpose is to execute commands in a multithredded way.
Here is my script:

As first the module:
###################################################################
package myProcess;

sub new{
        my $class = shift;
        my $self = {};
        $self = {'result' => '?'};
        bless($self, $class);
        };

sub start{

        $SIG{'CHLD'} = sub{wait;};
        $self->{'pid'} = fork();
        if(!defined $self->{'pid'}){
                print "Can't fork: $!\n";
                exit(0);
        }elsif($self->{'pid'}){
                return($self->{'pid'});
        }else{
                $self->{'result'} = `$cmd`;
                exit(0);
                };
        };

sub result{
        my $self = shift;
        my $r = $self->{'result'};
        return($r);
        };

sub cleanup{
        my $self = shift;
        my $r = $self->{'pid'};
        kill('SIGTERM',$self->{'pid'});
        delete $self->{'pid'};
        return($r);
        };

1;
#################################################################

Now the script to test it:
##################################################################
!/usr/bin/perl -w

if($0 =~ /^(.+\/).+$/){$path = $1;}else{$path = `pwd`;};

use myProcess;

$cmd = 'pwd';

$p = myProcess -> new();
$pid = $p->start($cmd);
$res = $p->result();
$delpid = $p->cleanup();

print "Object Reference: $p\n";
print "Child created: $pid\n";
print "Result:\n$res\n";
print "Child killed: $delpid\n";
##############################################################

And this is the output:
##############################################################
Object Reference: myProcess=HASH(0x80f37f0)
Child created: 478
Result:
?
Child killed: 478
##############################################################

As you can see, the assignment of the process-id works (in myProcess.pm
start-method), also the assignment of the '?' as result is working ( in
myProcess.pm new-method) but the assignment of the command output
doesn't work at all (in myProcess.pm start-method). I also checke the
hash reference ($self) in all methods, and it's really the same.
What's wrong here?

Thanks for help
Steffen Bachmann



Sun, 22 Feb 2004 19:01:41 GMT  
 object & fork
You misunderstand fork().  fork() makes a new process which is a
*copy* of the old process.  No memory is shared between the two processes.

Consider this:

        my $VAR = 0;
        my $pid = fork;
        if ($pid == 0) {
          # child

          $VAR = 1;
          exit;

        } else {
          # parent

          while ($VAR == 0) {
            sleep 1;
          }
          print "Child finished.\n";
          exit;

        }

Try this.  It never finishes.  The child sets $VAR to 1, but that is
the child's private copy of $VAR.  The parent has a different $VAR,
which is always 0.

Your program has the same problem. After fork(), there are *two*
$self->{result} variables, one in the parent and one in the child.
The child sets its $self->{result} and then exits, and its memory is
destroyed.  The parent's $self->{result} is always '?'.

To communicate between two processes after fork(), you need to use an
interprocess communication mechanism.  For example, you may use a
'shared memory segment', which is managed by the shmget, smhctl,
shmread, and shmwrite functions, or you can get the IPC::Shareable
module from CPAN, which provides a simpler interface.  

Another thing you can do is have the two processes communicate with a
file.  Have the child process deposit its result into a file; the
parent can see when the file appears, and pick up the result.

Quote:
>As you can see, the assignment of the process-id works (in myProcess.pm
>start-method), also the assignment of the '?' as result is working ( in
>myProcess.pm new-method) but the assignment of the command output
>doesn't work at all (in myProcess.pm start-method). I also checke the
>hash reference ($self) in all methods, and it's really the same.

It's not the same.  Two data objects in different prcesses are *never*
the same.  

rd
($p{$_})&6];$p{$_}=/ ^$P/ix?$P:close$_}keys%p}p;p;p;p;p;map{$p{$_}=~/^[P.]/&&
close$_}%p;wait until$?;map{/^r/&&<$_>}%p;$_=$d[$q];sleep rand(2)if/\S/;print



Sun, 22 Feb 2004 18:31:10 GMT  
 object & fork


Quote:
>You misunderstand fork().  fork() makes a new process which is a
>*copy* of the old process.  No memory is shared between the two processes.

Unless you're on a modern operating system on modern hardware, in which
case the two cleverly conspire to give you an extremely convincing
*illusion* that no memory is shared between the processes.  :-)

  - Logan
--
"Our grandkids love that we get Roadrunner and digital cable."
(Adverti{*filter*}t for Time Warner cable TV and internet access, July 2001)



Mon, 23 Feb 2004 01:34:33 GMT  
 object & fork

Quote:



>>You misunderstand fork().  fork() makes a new process which is a
>>*copy* of the old process.  No memory is shared between the two processes.

>Unless you're on a modern operating system on modern hardware, in which
>case the two cleverly conspire to give you an extremely convincing
>*illusion* that no memory is shared between the processes.  :-)

Even on old hardware that's true.  THere's no difference between the
illusion and the reality.
rd
($p{$_})&6];$p{$_}=/ ^$P/ix?$P:close$_}keys%p}p;p;p;p;p;map{$p{$_}=~/^[P.]/&&
close$_}%p;wait until$?;map{/^r/&&<$_>}%p;$_=$d[$q];sleep rand(2)if/\S/;print


Mon, 23 Feb 2004 01:52:24 GMT  
 object & fork

Quote:

> You misunderstand fork().  fork() makes a new process which is a
> *copy* of the old process.  No memory is shared between the two processes.

> Consider this:

>         my $VAR = 0;
>         my $pid = fork;
>         if ($pid == 0) {
>           # child

>           $VAR = 1;
>           exit;

>         } else {
>           # parent

>           while ($VAR == 0) {
>             sleep 1;
>           }
>           print "Child finished.\n";
>           exit;

>         }

> Try this.  It never finishes.  The child sets $VAR to 1, but that is
> the child's private copy of $VAR.  The parent has a different $VAR,
> which is always 0.

> Your program has the same problem. After fork(), there are *two*
> $self->{result} variables, one in the parent and one in the child.
> The child sets its $self->{result} and then exits, and its memory is
> destroyed.  The parent's $self->{result} is always '?'.

> To communicate between two processes after fork(), you need to use an
> interprocess communication mechanism.  For example, you may use a
> 'shared memory segment', which is managed by the shmget, smhctl,
> shmread, and shmwrite functions, or you can get the IPC::Shareable
> module from CPAN, which provides a simpler interface.

> Another thing you can do is have the two processes communicate with a
> file.  Have the child process deposit its result into a file; the
> parent can see when the file appears, and pick up the result.

> >As you can see, the assignment of the process-id works (in myProcess.pm
> >start-method), also the assignment of the '?' as result is working ( in
> >myProcess.pm new-method) but the assignment of the command output
> >doesn't work at all (in myProcess.pm start-method). I also checke the
> >hash reference ($self) in all methods, and it's really the same.

> It's not the same.  Two data objects in different prcesses are *never*
> the same.

> --

rd
> ($p{$_})&6];$p{$_}=/ ^$P/ix?$P:close$_}keys%p}p;p;p;p;p;map{$p{$_}=~/^[P.]/&&
> close$_}%p;wait until$?;map{/^r/&&<$_>}%p;$_=$d[$q];sleep rand(2)if/\S/;print

Thanks for help, I'm using open() to establish the interprocess
communication and
it's working fine:

package myProcess;

sub new{
        my $class = shift;
        my $self = {};
        $self->{'result'} = '?';
        bless($self, $class);
        };

sub start{

        $SIG{'CHLD'} = sub{wait;};
        $self->{'pid'} = open("PIPE_$self","$cmd |") || "Can't fork:
$!\n";
        return($self->{'pid'});
        };

sub result{
        my $self = shift;
        my $pipe ='PIPE_'.$self;
        my $r = '';
        while(<$pipe>){$r = $r.$_;};
        $self->{'result'} = $r;
        return($self->{'result'});
        };

sub cleanup{
        my $self = shift;
        my $r = $self->{'pid'};
        close("PIPE_$self");
        kill('SIGTERM',$self->{'pid'});
        delete $self->{'pid'};
        return($r);
        };

1;



Wed, 25 Feb 2004 12:08:47 GMT  
 object & fork
[snip]

Quote:
> Thanks for help, I'm using open() to establish the interprocess
> communication and
> it's working fine:

> package myProcess;

> sub new{
>         my $class = shift;
>         my $self = {};
>         $self->{'result'} = '?';
>         bless($self, $class);
>         };

There's no reason to store anything into $self->{result}, since it never
gets used before we call method result.

Quote:

> sub start{

>         $SIG{'CHLD'} = sub{wait;};
>         $self->{'pid'} = open("PIPE_$self","$cmd |") || "Can't fork:
> $!\n";
>         return($self->{'pid'});
>         };

Eww, yuck!  Using string filehandles is *so* perl4, though the way you
use a stringified object reference to create a unique filehandle name is
kinda cool.

If you have perl 5.6, then code it like this:
        sub start {

                my $pid = open(my ($fh), "-|", $cmd);
                die "Can't fork: $!" if !$pid;

        }

If you only have perl 5.005, then something like the following works:

        sub start {

                my $pid = open(local (*fh), "-|", $cmd);
                die "Can't fork: $!" if !$pid;

        }

Actually, the above *might* even work under perl4.  I'm not sure,
though.

Quote:

> sub result{
>         my $self = shift;
>         my $pipe ='PIPE_'.$self;
>         my $r = '';
>         while(<$pipe>){$r = $r.$_;};
>         $self->{'result'} = $r;
>         return($self->{'result'});
>         };

There's a reason we have $/, so we can slurp in a bunch of data:
        sub result {
                my $self = shift;
                my $fh = $self->{fh};
                return $self->{result} if exists $self->{result};
                $self->{result} = do { local $/; <$fh> };
                if( waitpid $self->{pid}, 0 ) {
                        my ($sig, $ret) = ($?%256, $?/256);
                        my $cmd = $self->{cmd};
                        die "$cmd died from signal $sig" if $sig;
                        die "$cmd exited with code $ret" if $ret;
                } else {
                        warn "waitpid: $!";
                }
                close $fh;
                delete $self->{qw(pid fh)};
                return $self->{result};
        }

Note that I *don't* have a $SIG{CHLD} thing in start().  I don't need it
because I have waitpid in result().

Quote:

> sub cleanup{
>         my $self = shift;
>         my $r = $self->{'pid'};
>         close("PIPE_$self");
>         kill('SIGTERM',$self->{'pid'});
>         delete $self->{'pid'};
>         return($r);
>         };

Some changes, including a name change:

        sub DESTROY {
                my $self = shift;
                return if !keys %$self;
                close $self->{fh};
                my $pid = $self->{pid};
                my $cmd = $self->{cmd};
                %$self = ();
                return if !$pid;
                kill TERM => $pid;
                if( waitpid $pid, 0 ) {
                        my ($sig, $ret) = ($?%256, $?/256);
                        die "$cmd died from signal $sig" if $sig;
                        die "$cmd exited with code $ret" if $ret;
                } else {
                        warn "waitpid: $!";
                }
        }

Due to the name change, you don't *have* to call the cleanup function
explicitly, you can just undef each variable which has a reference to
the object.  However, due to test on the second line, there's no harm if
you call DESTROY yourself.

Quote:

> 1;

Well, this is one line of your code which doesn't have to change :)

--
"I think not," said Descartes, and promptly disappeared.



Thu, 26 Feb 2004 13:01:18 GMT  
 
 [ 6 post ] 

 Relevant Pages 

1. File handles, forks, objects and scope

2. howto fork() an object

3. More than one fork-ing object to read from and write to

4. Updating Tk Objects After Forking Process

5. Please help me choose which to use! exec(), system(), fork(), setsid(), fork &&

6. Need example of pipe & fork (probable FAQ)

7. Question about Forking & Win32

8. problem with fork & kill from parent proces

9. forks & locking DBMs

10. long story - fork & multiprocessing problem

11. Fork & Waitpid

12. Fork & %SIG problem

 

 
Powered by phpBB® Forum Software