perl & IPC

From

Andrew Degtiariov ()

To

All ()

Date

2003-06-06T13:56:04Z

Area

RU.UNIX.PROG

From: Andrew Degtiariov <ad@astral-on.net>

Обьясните, пожалуйста, где я жестоко лопухнулся. Почему нижеприведеный
скрипт работает так странно (в скрипте 4 раза вызывается /bin/ls):
ad@ad:/usr/home/ad>perl test.pl |wc -w
   18939
ad@ad:/usr/home/ad>ls | wc -w
     107
ad@ad:/usr/home/ad>

18939/107=177; Отчего такое происходит? Иногда запуск приводит к
спонтанному ребуту станции (естественно, запуск не из под root'а)

Скрипт:
------- cut ------
#!/usr/bin/perl


use POSIX qw(:sys_wait_h);

$kids_limit = 2;
$kids = {};

write_to_separate_procces(undef, "/bin/ls");
write_to_separate_procces(undef, "/bin/ls");
write_to_separate_procces(undef, "/bin/ls");
write_to_separate_procces(undef, "/bin/ls");

sub write_to_separate_procces($$) {
    my $data_ref    = $_[0];
    my $program     = $_[1];

    if ($kids_limit <= scalar(keys %$kids)) {
        $pid = wait;
        delete $$kids{$pid};
    }
    
    local $SIG{CHLD} = sub { 
                             while(1) {
                                $pid = waitpid( -1, WNOHANG );
                                next if $pid == -1 && $! == EINTR();
                                last if $pid <= 0;
                                delete $$kids{$pid};
                                last;
                             }
                           };
    if ($pid = fork) {
        # parent
        $$kids{$pid} = 0;
        return;
    } 
    
    pipe(README, WRITEME);
    if ($pid = fork) {
        # parent
        close(WRITEME);
    } else {
        die "cannot fork: $!" unless defined $pid;
        close(README);
        #close  STDOUT ; close STDIN;
        
        # child
        $pid = open (TO_COMMAND, "|-");
        
        if ($pid) { close WRITEME; exit; } # parent
         
        $pid = open (FROM_COMMAND, "-|");
        if ($pid) { # parent
            while ($str = <FROM_COMMAND>) { print WRITEME $str; }
            close WRITEME; exit;
        }
        close WRITEME; # kid
        if (defined($data_ref)) {
            exec($program) or die "Couldn't run $program : $!\n";
            exit;
        }
        
        # else
        unless (open TO_COMMAND, "|$program") {
            die "Couldn't run $program : $!\n";
        }
        
        unless (ref $data_ref) { print TO_COMMAND $data_ref; } # scalar
        elsif (ref $data_ref eq 'SCALAR') { print TO_COMMAND $$data_ref; } 
        elsif (ref $data_ref eq 'ARRAY') {
            foreach $str (@$data_ref) { print TO_COMMAND $str; }
        }
        close TO_COMMAND;
        exit;
    }

    while (<README>) { $string .= $_; }
    close(README);

    print $string;
}

- --- end cut ---

-- 
Andrew Degtiariov 
AD5898-RIPE
--- ifmail v.2.15dev5
 * Origin: Astral-Kiev (2:5020/400)