Iteration problem on a tied array

[tommyboy]

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];
}

[jackdied]

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).

-jackdied

[Anonymous Monk]

thanks for the suggestion, missed the obvious on my part, but it still doesn't work.

[fokat]

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...