<!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 (@_ &gt; 1);<br>
  $count ++;<br>
  my $code = (@_ &gt; 0) ? $_[0] : $_;<br>
  my $result;<br>
  while ($count) {<br>
    $result = eval { &amp;$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 =&gt; 'all');<br>
use Retry;<br>
<br>
our $global = 0;<br>
<br>
my $x = retry {<br>
  $global++;<br>
  die "\$global &lt; 3" if ($global &lt; 3);<br>
  $global;<br>
}, 5;<br>
<br>
print $x.$/;<br>
<br>
</tt></font>
</body>
</html>