Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"

Iteration problem on a tied array

by tommyboy (Initiate)
on Oct 17, 2001 at 18:33 UTC ( #119411=perlquestion: print w/replies, xml ) Need Help??

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

I am having trouble getting iteration to work over a tied array. The array in question is tied via some methods to provide the pids of all child proccesses of the current proccess. The Nanny package implements the array by parsing output from the ps command.So this isn't very portable, yet I have tried it and it works on solaris 2.6+ and redhat 7 (except iteration which just doesn't work). Example code and the package that implements the tie follows. Anybody know what I am doing wrong? Thanks---
#!/usr/bin/perl #Package Nanny provides methods to tie an array. #The methods fill a tied array with the pids of the #non zombie children of the current proccess in real time. #I can't seem to get iteration to work. #example code: Make a few eternally looping kids, get pids. tie my @kids, 'Nanny'; if($pid = fork) { push @pids,$pid; if($pid = fork) { push @pids,$pid; if($pid = fork) { push @pids,$pid; } else{while(1){}} } else{while(1){}} } else{ exit; } if ($pid){ print "supposed number:". @pids. " real time number:".scalar @kids + ."pids @kids"; } #this does not work # for(1..@kids){ # waitpid($kids[$_],0); # } #and this doesn't either # foreach(@kids){ # waitpid($_,0); # } # #and not this either #foreach(@kids){ # print $_; # } #Nanny package: package Nanny; use Tie::Array; use strict; our @ISA = ('Tie::StdArray'); sub TIEARRAY{ my ($self) = shift; my @real_pids; bless \@real_pids, $self; return \@real_pids; } sub FETCHSIZE { my ($self) = shift; my $masterpid = $$; my @real_pids; open(PS,"ps -e -o ppid -o pid -o tty -o comm | "); my $l; while(<PS>){ $l++; next if $l == 1; my @procs = split(' ',$_); next if (defined($procs[3]) && $procs[3] eq 'ps'); if ($procs[0] == $masterpid && $procs[2] =~ /\?/) { waitpid($procs[1],0); next; } if ($masterpid == $procs[0]){ push @real_pids,$procs[1]; } } close PS; return scalar @real_pids ; } sub FETCH { my ($self,$idx) = shift; unless(defined $idx){ $idx = 0; } my $masterpid = $$; my @real_pids; open(PS,"ps -e -o ppid -o pid -o tty -o comm | "); my $l; while(<PS>){ $l++; next if $l == 1; my @procs = split(' ',$_); next if (defined($procs[3]) && $procs[3] eq 'ps'); if ($procs[0] == $masterpid && $procs[2] =~ /\?/) { waitpid($procs[1],0); next; } if ($masterpid == $procs[0]){ push @real_pids,$procs[1]; } } close PS; return $real_pids[$idx]; }

Replies are listed 'Best First'.
Re: Iteration problem on a tied array
by jackdied (Monk) on Oct 17, 2001 at 18:56 UTC
    First guess,

    in FETCH try

    sub FETCH { my ($self, $idx) = @_;
    I don't know about anyone else, but I rely heavily on print statements to debug code ('ghetto debugging') especially in perl (C compile times can make this painful).


      thanks for the suggestion, missed the obvious on my part, but it still doesn't work.
Re: Iteration problem on a tied array
by fokat (Deacon) on Oct 18, 2001 at 00:31 UTC
    In your code, if the ps command returns the processes in different order, you might duplicate or miss childs. Do a sort { $a <=> $b } ... to insure that the array is in a consistent order after different calls.

    Note that if a child terminates between calls to FETCH, you're bound to miss / loss childs while traversing the array.

    Perhaps a better way to approach this problem would be catching SIG_CHLD and providing a custom fork() method that kept track of how many children and when they die. This would avoid doing a ps for each element of the array, each time you iterate over it.

    Finally, if you're on a multiuser system, please place a sleep(1) or something like that in the infinite loop of the child. You're burning CPU time for every children you spawn in your test.

    Good luck and hope this helps...

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://119411]
Approved by root
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (3)
As of 2022-06-30 13:42 GMT
Find Nodes?
    Voting Booth?
    My most frequent journeys are powered by:

    Results (98 votes). Check out past polls.