Perl Asyn

[Todd English]

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

Group,

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

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
this,

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
run
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{$name} = Async->new(sub{ long_running_computation
($name, $host) } );
}

# This doesn't work
#while ( (my $name, $proc) = each %proc_result)
#{
# $build_result{$name} = $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";
if($proc_result{$name}->ready)
{
my $error;
if($error = $proc_result{$name}->error)
{
#$build_result{$name} = $error;
$build_result{$name} = "Async indicates a failure error
occured: $error !";
}
else
{
$build_result{$name} = $proc_result{$name}->result;
}
push(@host_list_to_delete, $name);

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

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

sleep 10;
}

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

 

[btatnall]

# This doesn't work
# while ( (my $name, $proc) = each %proc_result)

Did you mean:

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

notice the location of my

 

[Todd English]

Did you mean:

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

notice the location of my

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.

-T

 

[DJ Stunks]

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.

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.

HTH,
-jp

 

[Todd English]

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
following:
<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{$counter} = Async->new( sub{
long_running_computation() } );
}

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

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

 

[Todd English]

Sample fot using the "force" option in the Async module.

-----------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 < 10; $counter++)
{
$proc_result{$counter} = Async->new( sub{
long_running_computation() } );
}

while( 0 < scalar(keys %proc_result) )
{
my @host_list_to_delete;
while( (my $name) = each %proc_result)
{
if($proc_result{$name}->ready)
{
my $error;
if($error = $proc_result{$name}->error)
{
$build_result{$name} = "Async indicates a failure error
occured: $error !";
}
else
{
$build_result{$name} = $proc_result{$name}->result;
}
push(@host_list_to_delete, $name);
}
}

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

sleep 10;
}


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

 

[Tad McClellan]

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

for (my $counter=0; $counter < 20; $counter++)

foreach my $counter ( 0 .. 19 )




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

 

[Todd English]

Tad,

Thank you for that constructive remark. I will not quote an entire post
in the future. I am not a Usenet wizard, but according to Google
perl.beginners is a highly active Usenet group
(http://groups.google.com/group/perl.beginners/about) so I am adding
them back into the thread.

Did you happen to have any insight into the Async issue?

-T

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

for (my $counter=0; $counter < 20; $counter++)

foreach my $counter ( 0 .. 19 )




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

 

[Tad McClellan]

Tad,

Thank you for that constructive remark. I will not quote an entire post
in the future.

But you will in the present?

I am not a Usenet wizard, but according to Google

Google is not Usenet.

perl.beginners is a highly active Usenet group

perl.beginners is not a Usenet newsgroup.

It is a mailing list (with a gateway to news that Google Groups
treats as if it was an actual newsgroup).

My news server will not accept posts to newsgroups that do not exist...

(http://groups.google.com/group/perl.beginners/about) so I am adding
them back into the thread.

.... so I took it back out (of this post).

(That has no effect on the rest of the thread.)

Did you happen to have any insight into the Async issue?

No, else I would have given one.

I don't have that module installed, and don't have the time to try it.

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

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

 

[Sisyphus]

..
..

The expected output would be 20 lines printed to the console saying the
following:
<some number> I have returned
What happens instead is that some of lines fail to print the "I have
returned" part of the message. ..
..
----------------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{$counter} = Async->new( sub{
long_running_computation() } );
}

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

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

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.

Cheers,
Rob

 

[DJ Stunks]

You don't have to be sorry, I only suggested that this could be the
reason you weren't getting any responses.

Also, I should mention that you'll wear out your welcome pretty quickly
if you don't post according to accepted norms - that is: don't top
post. instead snip appropriate remarks and relevant content and write
your responses below this information. that way someone can read from
top to bottom and understand what you're talking about.

Anyway, on to Perl.

Sample fot using the "force" option in the Async module.

-----------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 < 10; $counter++)
{
$proc_result{$counter} = Async->new( sub{
long_running_computation() } );
}

while( 0 < scalar(keys %proc_result) )
{
my @host_list_to_delete;
while( (my $name) = each %proc_result)
{
if($proc_result{$name}->ready)
{
my $error;
if($error = $proc_result{$name}->error)
{
$build_result{$name} = "Async indicates a failure error
occured: $error !";
}
else
{
$build_result{$name} = $proc_result{$name}->result;
}
push(@host_list_to_delete, $name);
}
}

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

sleep 10;
}


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

my hunch was that your problem occurred because you're deleting items
from the hash while iterating over it, but on second thought I'm not so
sure.

anyway, I changed up your script a bit (no more deleting) and it seems
to run ok for me. give it a try.

-jp

#!/usr/bin/perl

use strict;
use warnings;

use Async;
use List::MoreUtils qw{ any };

my @hosts = (
{ architecture => 'rhel3-ia32',
name => 'gray',
},
{ architecture => 'rhel4-ia32',
name => 'x.x.x.x',
},
{ architecture => 'sles9-ia32',
name => 'y.y.y.y',
},
{ architecture => 'sles10-ia32',
name => 'maroon',
},
{ architecture => 'rhel3-x64',
name => 'white',
},
{ architecture => 'sles9-ia64',
name => 'goldenrod',
},
{ architecture => 'rhel4-s390',
name => 'rh4as',
},
{ architecture => 'sles9-s390',
name => 'mambo',
},
{ architecture => 'sol10-x64',
name => 'brown',
},
{ architecture => 'sol10-sparc',
name => 'green',
},
);

for my $hashref (@hosts) {
$hashref->{process} = Async->new(
sub { long_running_computation($hashref->{name}) }
);
}

sleep 10 while ( any { not $_->{process}->ready() } @hosts);

print "\n";
for my $hashref (@hosts) {
printf "Host %-10s ", "$hashref->{name}:";

if( my $error = $hashref->{process}->error() ) {
print "Failure: '$error'";
}
else {
print $hashref->{process}->result();
}

print "\n";
}

sub long_running_computation {
my ($host_name) = @_;

#print "Process for host $host_name spawned...\n";
sleep 10 + rand 35;
#print "Process for host $host_name returning...\n";

return "$host_name result";
}

__END__

 

[anno4000]

.
.

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

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

I think it's a bug in Async.pm 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.

Anno

 

[Todd English]

Thank you for the reply.

my hunch was that your problem occurred because you're deleting items
from the hash while iterating over it, but on second thought I'm not so
sure.

I originally thought this as well, and had tried a couple of variants
to the code I posted where I didn't mess with the proc hash until all
procs had reported their return. But this didn't make any difference
and upon further reflection I didn't think this was the case.

anyway, I changed up your script a bit (no more deleting) and it seems
to run ok for me. give it a try.

I tried your example code 10 times on three different machines and I
don't see any difference between your output and mine. For example I
just ra the example and received:
Host gray:
Host x.x.x.x: x.x.x.x result
Host y.y.y.y: y.y.y.y result
Host maroon:
Host white:
Host goldenrod:
Host rh4as:
Host mambo:
Host brown:
Host green: green result

I'm wondering if this is environmental. Are you on a windows machine,
or a UNIX like machine? What version of perl are you using?

Thanks for the help,
Todd English

 

[Todd English]

I think it's a bug in Async.pm 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.

Anno

Anno,

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 Async.pm 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,
-T

 

[Todd English]

But you will in the present?

Sorry Tad, I misunderstood you.

Google is not Usenet.

Very astute observation. I use Google to post because it is convenient.
However both my work and home isp's news servers list perl.beginners as
a valid group. I readily accept that yours doesn't and you couldn't
post your TOFU comments to a nonexistent group.

No, else I would have given one.

I don't have that module installed, and don't have the time to try it.

Well, thank you for taking the time to give me some Usenet etiquette
advice.

-T

 

[DJ Stunks]

Thank you for the reply.

Please don't snip attributions. That is, don't snip the part that says
what I wrote. Otherwise, who are you thanking?

I originally thought this as well, and had tried a couple of variants
to the code I posted where I didn't mess with the proc hash until all
procs had reported their return. But this didn't make any difference
and upon further reflection I didn't think this was the case.


I tried your example code 10 times on three different machines and I
don't see any difference between your output and mine. For example I
just ra the example and received:
Host gray:
Host x.x.x.x: x.x.x.x result
Host y.y.y.y: y.y.y.y result
Host maroon:
Host white:
Host goldenrod:
Host rh4as:
Host mambo:
Host brown:
Host green: green result

This is the results from the _exact_ script I posted, or did you modify
it somehow?

Did you uncomment those diagnostic prints in
long_running_computation()? Did you see all your processes spawned,
and all of them eventually return?

I'm wondering if this is environmental. Are you on a windows machine,
or a UNIX like machine? What version of perl are you using?

That was on win32: Perl v5.8.7; Async v0.10.

-jp

PS - by the way, upon further reflection I decided I would change:

sleep 10 while any{ not $_->{process}->ready() } @hosts;

to

sleep 10 while notall{ $_->{process}->ready() } @hosts;

but that's a style issue (and one less keystrokes to boot) ~

 

[Keith Keller]

["Followup-To:" header set to comp.lang.perl.misc.]

[> Tad McClellan wrote:]

Please don't snip attributions!

Very astute observation. I use Google to post because it is convenient.
However both my work and home isp's news servers list perl.beginners as
a valid group. I readily accept that yours doesn't and you couldn't
post your TOFU comments to a nonexistent group.

Did you read the rest of Tad's comments about perl.beginners? It's
a mailing list gated to usenet, not a real newsgroup. Often posts
to those pseudogroups get sent to the bitbucket, either by your
own newsserver or by the mailing list in question. If you look at the
real archive (at http://www.nntp.perl.org/group/perl.beginners/) you'll
see your posts are not there. (Why Google groups misleadingly shows
them is beyond me.) If you want an answer from there, subscribe to the
mailing list.

It seems like you're making progress with your problem here, so if
you haven't read the Posting Guidelines, drop perl.beginners, and good
luck resolving the issue.

--keith

 

[anno4000]

Anno,

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

I must admit that reading the perl in Async.pm 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 thought so, but more tests have shown I was wrong.

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

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

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

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.

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.

Anno

 

[xhoster]

Thank you for the reply.


I originally thought this as well, and had tried a couple of variants
to the code I posted where I didn't mess with the proc hash until all
procs had reported their return. But this didn't make any difference
and upon further reflection I didn't think this was the case.

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.

Xho

 

[anno4000]

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.

Oh, of course! Thats explains the erratic behavior.

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

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

Anno