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

Hi Monks, I have a rather annoying problem. I have an array that has a list of iso images that needs burning. I have a machine with 3xCDRW in it. I need to start all 3 CDRW simultaneously, toast the first 3 discs, then toast the reaminig discs in the array. Here is my code.please excuse my code, I am not an esteemed parallel programmer
#!/bin/perl -w
use Fcntl qw/F_SETFL O_NONBLOCK O_ASYNC/;
my @fhs;

$SIG{IO} = sub {
  foreach my $fh (@fhs) {
     while (<$fh>) {
        print ("I got $_ from $fh");
     }
  }
};

$SIG{CHLD} = 'DEFAULT';

print ("Saved discs:<br/>\n");
my @sortdiscs = sort(@discs);
my ($cut,$total,$pcntCut);

sub burnEm {
   my ($disc,$writer)=@_;
   my ($pid, $fh);
   print (" $disc is being BURNED\n");
   my @cdrecCmd=(["cdrecord", "-dummy", "-immed", "-eject", "-v", "gra
+cetime=2", "-tao", "dev=$writer", "$distroDirs{$distro}/$disc"]);
  foreach my $cmd (@cdrecCmd) {
     $pid = open($fh,'-|', "@$cmd") or die "Sorry could not fork cdrec
+ord program";
     fcntl $fh, F_SETFL, O_NONBLOCK|O_ASYNC;
     push (@fhs, $fh);
  }
}


while ( @sortdiscs ) {
   print ("\n\tSortDiscs Array:@sortdiscs:\n");
   ($discA,$discB,$discC,@remainingDiscs) = @sortdiscs;
   if (defined $discA) {
      burnEm($discA,"cdrw0");
      if ( defined $discB ) {
         burnEm($discB,"cdrw1");
         if ( defined $discC ) {
            burnEm($discC,"cdrw2");
         }
      }
   }
   @sortdiscs = @remainingDiscs;
}

[download]
Now the fundamental problems are:
1) I have hacked around with this code somewhat and I just can't get it to work.

2) The first 3 CD's don't complete toasting before the child processes starts cutting the next 3. I need to wait for each one to complete before starting the next set.

Nothingmuch helped me quite a bit already, and this is some of his/her code, but I am a bit stumped as to why it will not work as I expect it. I essentially know the reason, but I cannot get there.
Any, and I mean ANY help will be appreciated.
Thanks
Hamish

Replies are listed 'Best First'.
Re: forking and ipc
by pizza_milkshake (Monk) on May 02, 2004 at 22:45 UTC
    i'm not a real wizard, but i managed to scrape this together. it seems to do the generic task of running pieces of data (isos) through resources (burners) and waiting for a resource to finish before continuing.

    hope this helps. 

    #!perl -l

use strict;
use warnings;

# make WNOHANG available
use POSIX ":sys_wait_h";

our %jobs;                      # track pid -> resource
our @resource = qw{a b c};      # concurrent resources
my @data = qw{5 4 3 2 1 0};     # data to run through a resource

$SIG{"CHLD"} = sub {
        my $chld;
        $chld = waitpid(-1, WNOHANG) until $chld;
        return unless $chld > 0;
        print "$$ sees $chld is done";
        print "resource " . $jobs{$chld} . " is free again!";
        push @resource, $jobs{$chld};
        delete $jobs{$chld};
        alarm 0;        # send SIGALRM so sleep() wakes up
};

sub runcmd {
        my ($resource, $data) = @_;
        my @cmd = ("sleep", $data);     # define command
        print ">>> $$ runcmd($resource, $data) start";
        system @cmd;                    # run command
        print "<<< $$ runcmd($resource, $data) end";
}

print "main pid: $$";

while (@data) {
        my ($data, $resource, $chld) = shift @data;
        print "sleep ... resource(@resource), data(@data)";
        sleep until @resource;
        print "done sleeping! resource(@resource), data(@data)";
        $resource = shift @resource;
        if (($chld = fork()) > 0) {
                # parent code
                $jobs{$chld} = $resource;
        } else {
                # child code
                runcmd($resource, $data);
                exit;           # end chld, trigger $SIG{CHLD}
        }

}

sleep until keys %jobs == 0;    # wait for all jobs

print "all done!";

    [download]

    perl -e'$_="nwdd\x7F^n\x7Flm{{llql0}qs\x14";s/./chr(ord$&^30)/ge;print'

[reply]
[d/l]
      i just realized upon reviewing your description that you want to run a round of burns, then reload all drives at the same time, then do another round, etc. to achieve this, replace the main loop with this: 
      my $chld;
while (@data) {
        while (@resource) {
                last unless @data;
                my $resource = shift @resource;
                my $data = shift @data;
                if (($chld = fork()) > 0) {
                        # parent code
                        $jobs{$chld} = $resource;
                } else {
                        # child code
                        runcmd($resource, $data);
                        exit;           # end chld, trigger $SIG{CHLD}
                }
        }
        sleep until @resource == $num_resources;
        print "ONE ROUND DONE";
        last unless @data;
        print "RELOAD THEN PRESS ENTER: ";
        <>;
}

      [download]

      perl -e'$_="nwdd\x7F^n\x7Flm{{llql0}qs\x14";s/./chr(ord$&^30)/ge;print'

[reply]
[d/l]
Re: forking and ipc
by revdiablo (Prior) on May 03, 2004 at 17:34 UTC

    Perhaps I'm not fully understanding the question, but it seems like the solution you have, and the ones already given by pizza_milkshake, are overcomplicating things a bit. Here's how I'd code this thing:

    use strict;
use warnings;

my @isolist = qw(one two three four five); # should contain ISO names

while (my @workunit = splice @isolist, 0, 3) {
    my @pids;
    for (0 .. $#workunit) {
        push @pids, burncd($workunit[$_], $_);
    }
    waitpid $_, 0 for @pids;

    print "Work unit finished.\n";

    if (@isolist) {
        # perhaps a prompt here to put in new blanks
        print "Starting next round...\n";
        sleep 3;
    }
}

sub burncd {
    my ($isoname, $target) = @_;

    my $pid = fork;

    die "Cannot fork: $!" unless defined $pid;
    return $pid if $pid;

    print "Burning $isoname to cdrw$target\n";

    # burn the cd. randomized sleep just for testing.
    sleep int rand(5) + 5;

    exit;
}

    [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom