[Melbourne-pm] retry()

Mathew Robertson mathew.robertson at netratings.com.au
Thu Dec 13 17:44:41 PST 2007


Hi folks,

This morning I cam across an interesting a problem I was having with
die'ing socket handles.

ie: this was the original code:

  my $result = get_xxx(yyy);

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:

- rewrite each get_xxx with retry code
- re-implement each get_xxx (where the xxx is some specific function) to
implement retries
- write a "super wrapper" which implemented the retries.
- something else...

Eventually I decided to write a source filter - here is the syntax I
ended up with:

  my $result = retry { get_xxx(yyy) };

with an optional argument for the number of retries.

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.

regards,
Mathew Robertson



###################################
package Retry;

use strict;
use warnings;
use Exporter 'import';
use Filter::Simple;
our @EXPORT_OK = 'retry';

our $DEBUG = 0;
our $RETRIES = 0;

sub retry {
  my $count = $RETRIES;
  $count = $_[1] if (@_ > 1);
  $count ++;
  my $code = (@_ > 0) ? $_[0] : $_;
  my $result;
  while ($count) {
    $result = eval { &$code(); };
    last unless ($@);
    print STDERR "...retrying... $/" if $DEBUG;
    $count --;
  }
  die $@ if $@;
  return $result;
}

my $p = __PACKAGE__;

FILTER {
  if (s/retry\s+{(.*?)}\s*,\s*(\d+)/${p}::retry( sub { $1 }, $2 )/s){
    print "TWO ARG $/" if $DEBUG;
  } elsif (s/retry\s+{(.*?)}/${p}::retry( sub { $1 } )/s) {
    print "ONE ARG $/" if $DEBUG;
  }
};

1;

###################################
#!/usr/bin/perl

use strict;
use warnings (FATAL => 'all');
use Retry;

our $global = 0;

my $x = retry {
  $global++;
  die "\$global < 3" if ($global < 3);
  $global;
}, 5;

print $x.$/;

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://mail.pm.org/pipermail/melbourne-pm/attachments/20071214/076def55/attachment.html 


More information about the Melbourne-pm mailing list