Perl Asyn

Do you have a question? Post it now! No Registration Necessary.  Now with pictures!

Threaded View
<cross posting to these two groups as posting to comp.lang.perl.modules
has failed to result in a response>


I work for a company as security developer and have recently been asked
to streamline our build process. The build process is driven by a
single machine which connects to all the build hosts and builds our

The driver was written in Perl and does all of this sequentially. I
found the Async Perl package from Google (perl+async) and tried to use
it to optimize our process so that building would only take as long as
the slowest platform.

Here is where things get interesting. I implemented everything, and
started seeing that the proc result was blank for allot of our build
results. I'm very new to Perl (as in this is my 4th day using it) so I
broke out a simple program to reproduce the results. Originally, for
the long computation, I was sleeping (as per the example) and the
example worked just fine. I figured it must be my problem and spent a
couple more days learning Perl. I just happened to run the test program
once more today and noticed that one platform didn't respond. So,
instead of sleeping I did something a little more random (as far as
when the function will return) and boom, it happens all the time now.

I would be very willing to help explore this problem, test patches or
even the async fix code (which I tried, unsuccessfully), but I will
need a little direction to do this. Perhaps I am using the package
incorrectly and someone could point out my mistake?

Any help would be appreciated. Thank you for taking the time to read

Todd English

-----------Sample Code------------

#!/usr/bin/perl -w

use Async;

sub long_running_computation {
     # This function simulates a computation that takes a long time to
     my ($name, $host) = @_;
     system qq{find ./ -type f 2>&1 >/dev/null};
# if we sleep instead of do something more unpredictable, then works
most of the time
#     sleep 10;
     return "$name $host has Failed";

my %host =
    'rhel3-ia32' =>     'gray',
    'rhel4-ia32' =>    'x.x.x.x',
    'sles9-ia32' =>    'y.y.y.y',
    'sles10-ia32' =>    'maroon',
    'rhel3-x64' =>    'white',
    'rhel4-x64' =>    'ivory',
    'sles9-x64' =>    'skyblue',
    'sles10-x64' =>    'orange',
    'rhel3-ia64' =>    'chartreuse',
    'rhel4-ia64' =>    'cyan',
    'sles9-ia64' =>    'goldenrod',
    'rhel4-s390' =>     'rh4as',
    'sles9-s390' =>      'mambo',
    'sol10-x64' =>    'brown',
    'sol10-sparc' =>    'green',
    'sol8-sparc'  =>    'blue',
    'sol7-sparc' =>    'red',
    'sol9-sparc' =>    'black',
    'hpux-parisc' =>    'purple',
    'hpux11-ia64' =>    'yellow'

my %proc_result;
my %build_result;

while (my ($name, $host) = each %host)
    $proc_result = Async->new(sub{ long_running_computation
($name, $host) } );

# This doesn't work
#while ( (my $name, $proc) = each %proc_result)
#    $build_result = $proc->result('1');

#neither does this
while( 0 < scalar(keys %proc_result) )
    my @host_list_to_delete;
    while( ($name) = each %proc_result)
        print "checking if $name is ready\n";
            my $error;
            if($error = $proc_result->error)
#$build_result = $error;
                $build_result = "Async indicates a failure error
occured: $error !";
                $build_result = $proc_result->result;
            push(@host_list_to_delete, $name);

            undef $proc_result; #not sure why this is here, but
is was in the sample docs

    foreach my $item (@host_list_to_delete)
        delete ( $proc_result );

    sleep 10;

print "done with long running computation\n";
while (my($host_name, $result) = each %build_result)
    printf "%s\t%s\n", $host, $result;

Re: Perl Asyn

Todd  English wrote:
Quoted text here. Click to load it

Did you mean:

while ( my ($name, $proc) = each %proc_result )

notice the location of my

Re: Perl Asyn wrote:
Quoted text here. Click to load it

Doh, typo on my part. That was what I meant and that was what I tested
(it doesn't work either). Thank you for the reply though, you are the
only person thus far to do so. Any other comments or ideas? I've
written to Mark-Jason Dominus (the author) several times and have not
heard back from him.

Anything would be helpful.


Re: Perl Asyn

Todd  English wrote:
Quoted text here. Click to load it

Could you boil all this down into one _short_ but _complete_ script
which exhbits the problem you're describing?  I, and I'm sure others as
well due to your lack of responses, can't be bothered to wade through
134 lines of code and problem description to try and figure out what it
is you're trying to do and what's not working as you intended it.

Be absolutely sure that whatever you post compiles and runs clean with
both use warnings and use strict in effect.


Perl Async .10

It was suggested that my initial post was too verbose for the Perl
newsgroups. I have rewritten my original example and have posted it
bellow. This code uses the "force" feature of async to help with code
compactness. I will post an additional example without the flag, but it
will be a bit longer.

The expected output would be 20 lines printed to the console saying the
<some number>      I have returned
What happens instead is that some of lines fail to print the "I have
returned" part of the message.

Sorry for the initial verbose posting.

Todd English

----------------sample code------------------
#!/usr/bin/perl -w

use strict;
use Async;

sub long_running_computation {
     system qq{find ./ -type f 2>&1 >/dev/null};
     return "I have returned";

my %proc_result;
my %build_result;

for (my $counter=0; $counter < 20; $counter++)
    $proc_result = Async->new( sub{
long_running_computation() } );

while ( my ($name, $proc) = each %proc_result)
    $build_result = $proc->result('1');

while (my($host_name, $result) = each %build_result)
    printf "%s\t%s\n", $host_name, $result;

DJ Stunks wrote:
Quoted text here. Click to load it

Re: Perl Async .10

[ removed non-existent perl.beginners newsgroup.
  Followups set.

Quoted text here. Click to load it

   foreach my $counter ( 0 .. 19 )

[ snip TOFU. Please do not quote an entire post. ]

    Tad McClellan                          SGML consulting                   Perl programming
    Fort Worth, Texas

Re: Perl Async .10

Quoted text here. Click to load it

Is the problem dependent upon that system() command, or do you get the same
problem even if you replace the system call with something else ?

I replaced the system call with sleep(2) as I didn't want to mess around
with system(). I get 20 lines of "<some number>    I have returned".

That's on Win32 (2000), perl 5.8.8, Async-0.10.


Re: Perl Async .10

Quoted text here. Click to load it

He said as much.  Sleep instead of find shows return values for
all processes.

I think it's a bug in that has to do with buffering.
Async uses a buffer of size 8192.  If you make the output string
longer than that (printing only a bit of it), all processes will
return values.  If it is much shorter, (half that size or so) gaps
will start to appear.


Re: Perl Async .10

Quoted text here. Click to load it


I'm not sure I follow you. As a test I returned really really long
messages and I also tried changing the buffer size to in the perl
module to 10. In either case, I still see the same behavior.

I must admit that reading the perl in is a little more
advanced than my few days of using perl will allow me to comprehend.
But if I am reading this correctly, the buffer you are talking about is
the child's return data buffer. I put some debug print commands into
that area of the Async module; specifically I printed out the return
value of sysread and value of buf. It turns out the sysread is
returning 0 for many of the calls. I'm now wondering if there is a
problem with the system call getting interrupted and the child ready
loop isn't handling it correctly. I'll look into that tonight.

Thanks for the advice,

Re: Perl Async .10

Quoted text here. Click to load it

I had rather unambiguous results on a Mac, where I saw empty results
(gaps) like you're getting with a message size of up to 4096 but never
with a size of 4097 or more.  Reducing the buffer size in
does not change the behavior as you noted.  If the problem is indeed
buffering it must be a different buffer.

I can't reproduce this behavior on the Linux system I'm sitting at now.
Instead I'm seeing "gaps" with message sizes much larger than 4096.

Quoted text here. Click to load it

I thought so, but more tests have shown I was wrong.

Quoted text here. Click to load it

sysread()?  My version (0.10) of Async uses read(), which goes against
the recommendation in "perldoc -f select":

    WARNING: One should not attempt to mix buffered I/O (like
    "read" or <FH>) with "select", except as permitted by POSIX,
    and even then only on POSIX systems.  You have to use "sysread"

However, changing read() to sysread() doesn't seem to make a difference

Quoted text here. Click to load it

That looks like a possibility.  Putting this

    $_ = sub { my $sig = shift; warn "signal $sig" } for values %SIG;

in the main program after the loop with "Async->new" (so the children's
%SIG is unaffected) shows a number of uncaught SIGCHLDs.  I haven't
followed this further.  See "perldoc perlvar" for %SIG.


Re: Perl Async .10

Quoted text here. Click to load it

My original post on this topic apparently never showed up.  The problem
seems to come from the "kill 9,..." in Async's sub DESTROY.  An Async child
will inherit a copy of the objects to all of its older siblings from the
parent.  When the child exits, it will kill all of it's older siblings.
Thus the program only works correctly if the children terminate in the same
order that they began, so that a younger child never has an extent older
sibling to kill out of order.

I have no idea why the kill is there, and getting rid of it makes the
problem go away.


-------------------- http://NewsReader.Com/ --------------------
Usenet Newsgroup Service                        $9.95/Month 30GB

Re: Perl Async .10

Quoted text here. Click to load it

Oh, of course!  Thats explains the erratic behavior.

Quoted text here. Click to load it

If at all, only the main process should do it.


Re: Perl Async .10

Quoted text here. Click to load it

I'm sorry that I didn't get a chance to reply to this sooner. I really
appreciate all of the help I received from this group. Thank you.

I would like to submit a patch to the author of the async module and
was hoping some of you might give it a quick once over to make sure my
changes are sane. I also thought that it wouldn't be a bad idea to post
a patch for the next newb who finds this problem just in case the
modules maintainer (Mark Jason Dominus) doesn't fix the problem (I
still haven't heard back from him).

Thank you again for all of your help,
Todd English
-----------------Begin Diff--------------------
--- ../../Async-0.10/    2000-01-26 22:50:28.000000000 +0000
+++ ./    2006-10-06 11:40:21.000000000 +0000
@@ -25,6 +25,7 @@
     bless $self => $pack;
   } else {            # child
+    select((select($w), $|=1)[0]);
     close $r;
     my $result = $task->();
     print $w $result;
@@ -32,7 +33,7 @@

-# return true iff async process is complete
+# return true if async process is complete
 # with true `$force' argmuent, wait until process is complete before
 sub ready {
   my ($self, $force) = @_;
@@ -43,7 +44,7 @@
   vec($fdset, $self->, 1) = 1;
   while (select($fdset, undef, undef, $timeout)) {
     my $buf;
-    my $nr = read $self->, $buf, 8192;
+    my $nr = sysread $self->, $buf, 8192;
     if ($nr) {
       $self-> .= $buf;
     } elsif (defined $nr) {        # EOF
@@ -61,7 +62,11 @@
 # Return error message if an error occurred
 # Return false if no error occurred
 sub error {
-  $_[0];
+  my $ret = $_[0];
+  if($ret){
+      $self->async_close();
+  }
+  return $ret;

 # Return resulting data if async process is complete
@@ -69,21 +74,28 @@
 # a true $force argument waits for the process to complete before
 sub result {
   my ($self, $force) = @_;
+  my $ret;
   if ($self->) {
-    $self->;
+    $ret = $self->;
   } elsif ($force) {
     $self->ready('force completion');
-    $self->;
-  } else {
-    return;
+    $ret = $self->;
+  if($ret){
+      $self->async_close();
+  }
+  return $ret;

-sub DESTROY {
-  my ($self) = @_;
-  my $pid = $self->;
-  kill 9 => $pid;    # I don't care.
-  waitpid($pid, 0);
+sub async_close {
+    my ($self) = @_;
+    if( defined( $self-> ) && $self-> != getppid() ) {
+        $pid = $self->;
+        kill 9 => $pid;
+        waitpid( $pid, 0 );
+    } else {
+        wait();
+    }

 package AsyncTimeout;
@@ -123,9 +135,18 @@

 sub result {
   require Storable;
+  my $ret;
   my $self = shift;
   my $rc = $self->SUPER::result(@_);
-  return defined $rc ? Storable::thaw($rc) : $rc;
+  if( defined $rc ){
+      $ret =  Storable::thaw($rc);
+  }
+  else{
+      $ret = $rc;
+  }
+  $self->async_close();
+  return $ret;

Site Timeline