<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
</head>
<body bgcolor="#ffffff" text="#000000">
<font size="+1"><tt>Hi folks,<br>
<br>
This morning I cam across an interesting a problem I was having with
die'ing socket handles. <br>
<br>
ie: this was the original code:<br>
<br>
my $result = get_xxx(yyy);<br>
<br>
where get_xxx was a wrapper to eventually a socket call - but the
socket would sometimes fail. Now since I wanted simply to retry the
get_xxx(), a number of solutions are possible:<br>
<br>
- rewrite each get_xxx with retry code<br>
- re-implement each get_xxx (where the xxx is some specific function)
to implement retries<br>
- write a "super wrapper" which implemented the retries.<br>
- something else...<br>
<br>
Eventually I decided to write a source filter - here is the syntax I
ended up with:<br>
<br>
my $result = retry { get_xxx(yyy) };<br>
<br>
with an optional argument for the number of retries.<br>
<br>
I didn't find anything equivalent on CPAN - particularly its simplicity
and genericity - so I thought I might post it here to see what others
think. It includes an example too.<br>
<br>
regards,<br>
Mathew Robertson<br>
<br>
<br>
<br>
###################################<br>
package Retry;<br>
<br>
use strict;<br>
use warnings;<br>
use Exporter 'import';<br>
use Filter::Simple;<br>
our @EXPORT_OK = 'retry';<br>
<br>
our $DEBUG = 0;<br>
our $RETRIES = 0;<br>
<br>
sub retry {<br>
my $count = $RETRIES;<br>
$count = $_[1] if (@_ > 1);<br>
$count ++;<br>
my $code = (@_ > 0) ? $_[0] : $_;<br>
my $result;<br>
while ($count) {<br>
$result = eval { &$code(); };<br>
last unless ($@);<br>
print STDERR "...retrying... $/" if $DEBUG;<br>
$count --;<br>
}<br>
die $@ if $@;<br>
return $result;<br>
}<br>
<br>
my $p = __PACKAGE__;<br>
<br>
FILTER {<br>
if (s/retry\s+{(.*?)}\s*,\s*(\d+)/${p}::retry( sub { $1 }, $2 )/s){<br>
print "TWO ARG $/" if $DEBUG;<br>
} elsif (s/retry\s+{(.*?)}/${p}::retry( sub { $1 } )/s) {<br>
print "ONE ARG $/" if $DEBUG;<br>
}<br>
};<br>
<br>
1;<br>
<br>
#######</tt></font><font size="+1"><tt>############################<br>
#!/usr/bin/perl<br>
<br>
use strict;<br>
use warnings (FATAL => 'all');<br>
use Retry;<br>
<br>
our $global = 0;<br>
<br>
my $x = retry {<br>
$global++;<br>
die "\$global < 3" if ($global < 3);<br>
$global;<br>
}, 5;<br>
<br>
print $x.$/;<br>
<br>
</tt></font>
</body>
</html>