Perl AnyEvent callback on latency sub, how run it async? - perl

I start to learn AnyEvent and have some trobles with it.
I totally misunderstood how its possible to get asynchronous profit, fe :
#!/usr/bin/env perl
package LatencySub;
use strict;
use warnings;
use AnyEvent;
# sub for emulate latency - is it right way?
sub do_delay{
my ($name, $delay) = (#_);
my $cv = AE::cv;
my $timer = AE::timer $delay, 0, sub { $cv->send() };
$cv->recv;
return $name.' proceed, delay is '.$delay;
};
package main;
use 5.12.0;
use warnings;
use Smart::Comments;
use AnyEvent;
my #list = (
{ name => 'first', delay => 1 },
{ name => 'second', delay => 1 },
{ name => 'third', delay => 2 }
);
sub process_cb {
my ( $name, $delay, $cb ) = #_;
my $result = LatencySub::do_delay( $name, $delay );
$cb->($result);
}
my %result;
my $cv = AE::cv;
# outer loop
$cv->begin (sub { shift->send (\%result) });
my $before_time = AE::time;
### foreach start...
foreach my $entity (#list) {
$cv->begin;
process_cb (
$entity->{'name'},
$entity->{'delay'},
sub {
$result{$entity->{'name'}} = shift;
$cv->end;
}
);
}
### foreach end...
$cv->end;
my $time_all = AE::time - $before_time;
### $time_all
### %result
At output I got:
### foreach start...
### foreach end...
### $time_all: '4.02105116844177'
### %result: {
### first => 'first proceed, delay is 1',
### second => 'second proceed, delay is 1',
### third => 'third proceed, delay is 2'
### }
All delay sum (1+1+2) eq $time_all - 4 seconds.
So, no profit at all.
Why is it and how I can (and is it possible?) create "right" callback?

Don't use condvars except to block your top-level program while waiting for events to complete. Using condvars makes it very difficult to reuse code; any function that has a condvar internally can never be safely used in a program that has another function that has a condvar in it. (This is not true if you never call recv and only use cb. But still... it's dangerous and not for those that don't know what they're doing.)
My rule: if the filename ends .pm, no condvars!
If you want to run multiple things in parallel and run some more code once all the results are available, try Event::Join:
sub delay($$) {
AnyEvent->timer( after => $_[0], cb => $_[1] );
}
my $join = Event::Join->new(
on_completion => sub { say "Everything is done" }
events => [qw/t1 t2 t3/],
);
delay 1, $join->event_sender_for('t1');
delay 2, $join->event_sender_for('t2');
delay 3, $join->event_sender_for('t3');
Then, after 3 seconds, you'll see "everything is done". Event::Join is like begin and end on condvars, but can never block your program. So it's easy to reuse code that uses it. Also, events are named, so you can collect results as a hash instead of just calling a callback when other callbacks are called.

The call $cv->recv will block until ->send is called, so do_delay() takes $delay secs to return.
Here is an example of spawning three threads and waiting for all of them to complete:
use strict;
use warnings;
use AnyEvent;
sub make_delay {
my ($name, $delay, $cv) = (#_);
$cv->begin;
return AE::timer $delay, 0, sub { warn "done with $name\n"; $cv->end };
}
my $cv = AE::cv;
my #timers = (make_delay("t1", 3, $cv),
make_delay("t2", 5, $cv),
make_delay("t3", 4, $cv)
);
$cv->recv;

Related

alarm does not seem to fire if I set $SIG{ALRM}

I'm trying to implement an alarm in my Perl backend process so that it will terminate if it gets stuck for too long. I tried to implement the code given on the alarm documentation page on Perldoc (this is verbatim from the documentation other than the line that calls my program's key subroutine instead of the sample line in the documentation):
eval {
local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
alarm $timeout;
&FaithTree::Backend::commandLine({ 'skipWidgets' => $skipWidgets, 'commandLineId' => $commandLineId, 'force' => $force });
alarm 0;
};
if ($#) {
die unless $# eq "alarm\n"; # propagate unexpected errors
# timed out
}
else {
# didn't
}
Given this code, nothing happens when the alarm should have timed out. On the other hand, if I remove the custom definition for $SIG{ALRM} (which, again, came straight from the Perl documentation) the alarm does fire, just without the custom handler.
I'm wondering if the fact that I'm using Thread::Queue is playing a role in the alarm failing, but that doesn't explain why it works so long as I skip redefining $SIG{ALRM}.
Here's a minimal, runnable version with subroutine that is intentionally an infinite loop for testing:
eval {
$SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
alarm 1;
&FaithTree::Test::Backend::commandLine({ 'skipWidgets' => $skipWidgets, 'commandLineId' => $commandLineId, 'force' => $force });
alarm 0;
};
if ($#) {
die unless $# eq "alarm\n"; # propagate unexpected errors
# timed out
}
else {
exit;
}
package FaithTree::Test::Backend;
use File::Tail;
use threads;
use threads::shared;
use Thread::Queue;
sub commandLine {
our $N //= 4;
my $Q = new Thread::Queue;
my #kids = map threads->create( \&FaithTree::Test::Backend::fetchChild, $Q ), 1 .. $N;
my #feeds = ( "1","2","3","4" );
foreach my $feed (#feeds) {
$Q->enqueue( $feed );
}
$Q->enqueue( ( undef ) x $N );
$_->join for #kids;
}
sub fetchChild {
print "Test";
# Access queue.
my $Q = shift;
#What is my thread id?
my $tid = threads->tid();
my ($num, $num2);
for ( ; ; ){
if ($num2 == 10000) {
say STDERR $tid . ': ' . $num;
$num2 = 0;
}
$num++;
$num2++;
}
return 1;
}
If you comment out the $SIG{ALRM} line, it will terminate when the alarm is set to time out. If you leave it in place, it will never terminate.
Signals and threads don't mix well. You might want to rethink your use of signals. For example, you could move all the thread stuff to a child process.
Signal handlers are only called between Perl ops. The main thread is in a call to XS sub thread->join, and the signal handler will be called once join returns.
Most blocking system calls can be interrupted (returning error EINTR), so it might be possible to write a signal-aware version of join. Except I seem to remember pthread functions not being interruptible, so maybe not.
In this particular case, you could have the threads signal the main thread when they are over using a system that allows the main thread to block until the a signal occurs or a timeout has occured. cond_signal/cond_timedwait is such a system.
use Sub::ScopeFinalizer qw( scope_finalizer );
use Time::HiRes qw( time );
my $lock :shared;
my $threads_remaining = $N;
my $Q = new Thread::Queue;
my #threads;
{
lock $lock;
for (1..$N) {
++$threads_remaining;
push #threads, async {
my $guard = scope_finalizer {
lock $lock;
--$threads_remaining;
cond_signal($lock);
};
worker($Q);
}
}
}
my $max_end_time = time + 1;
# ...
{
lock $lock;
while ($threads_remaining) {
if (!cond_timedwait($lock, $max_end_time)) {
# ... Handle timeout ...
}
}
}
$_->join for #threads;

How to do asynchronous www-mechanize using anyevent

I've been doing a fair amount of research on the topic and while there are some questions out there that relate, I'm really having a hard time understanding how to properly do async programming using AnyEvent and www-mechanize. I'm trying to stick with mechanize because it has a clean interface and has functions built-in that I'm expecting to do: (like get all images of a site etc). If there is no reliable/good way to do what I want, then I'll start looking at AnyEvent::HTTP but I figure I'd ask first before moving in that direction.
I'm a newbie to AnyEvent programming but have done a fair amount of perl and javascript / jquery async calls with callbacks before. These make a lot of sense to me but it's just not clicking for me with AnyEvent + Mech.
Here is the code I'm working on that pulls URLs from an upstream queue. give the URL, I want to one get that says pulls in all the images on a page, and then async. grabs all the images.
So pseudo-code would look something like this:
grab url from queue
get page
get all img url links
do many async calls on the img urls (store the imgs for example in a backend)
I've read, I cannot (after researching errors) block in an AnyEvent callback. How do I structure my program to do the async calls without blocking?
AE events can only be processed when AE-aware functions block, so I'm using LWP::Protocol::AnyEvent::http. It replaces the normal HTTP backend for LWP (Net:HTTP) with AnyEvent::HTTP, which is AE-aware.
The worker gets created like:
my Worker->new(upstream_job_url => "tcp://127.0.0.1:5555', run_on_create => 1);
Async part is sub _recv_msg which calls _proc_msg.
I already have an AnyEvent loop watching the ZeroMQ socket as per the ZeroMQ perl binding docs...
Any help much appreciated!
Code:
package Worker;
use 5.12.0;
use Moose;
use AnyEvent;
use LWP::Protocol::AnyEvent::http;
use ZMQ::LibZMQ3;
use ZMQ::Constants qw/ZMQ_PUSH ZMQ_PULL ZMQ_POLLIN ZMQ_FD/;
use JSON;
use WWW::Mechanize;
use Carp;
use Coro;
has 'max_children' => (
is => 'rw',
isa => 'Int',
required => 1,
default => sub { 0 }
);
has 'upstream_job_url' => (
is => 'rw',
isa => 'URI',
required => 1,
);
has ['uri','sink_url'] => (
is => 'rw',
isa => 'URI',
required => 0,
);
has 'run_on_create' => (
is => 'rw',
isa => 'Bool',
required => 1,
default => sub { 1 }
);
has '_receiver' => (
is => 'rw',
isa => 'ZMQ::LibZMQ3::Socket',
required => 0
);
sub BUILD {
my $self = shift;
$self->start if $self->run_on_create;
}
sub start
{
my $self = shift;
$self->_init_zmq();
my $fh = zmq_getsockopt( $self->_receiver, ZMQ_FD );
my $w; $w = AnyEvent->io( fh => $fh, poll => "r", cb => sub { $self->_recv_msg } );
AnyEvent->condvar->recv;
}
sub _init_zmq
{
my $self = shift;
my $c = zmq_init() or die "zmq_init: $!\n";
my $recv = zmq_socket($c, ZMQ_PULL) or die "zmq_socket: $!\n";
if( zmq_connect($recv, $self->upstream_job_url) != 0 ) {
croak "zmq_connect: $!\n";
}
$self->_receiver($recv);
}
sub _recv_msg
{
my $self = shift;
while(my $message = zmq_msg_data(zmq_recvmsg($self->_receiver)) ) {
my $msg = JSON::from_json($message, {utf8 => 1});
$self->uri(URI->new($msg->{url}));
$self->_proc_msg;
}
}
sub _proc_msg
{
my $self = shift;
my $c = async {
my $ua = WWW::Mechanize->new;
$ua->protocols_allowed(['http']);
print "$$ processing " . $self->uri->as_string . "... ";
$ua->get($self->uri->as_string);
if ($ua->success()) {
say $ua->status . " OK";
} else {
say $ua->status . " NOT OK";
}
};
$c->join;
}
1;
As you can see, I was trying Coro in the _proc_msg, I've tried just doing mech calls but get an error
AnyEvent::CondVar: recursive blocking wait attempted at lib/Worker.pm line 91.
Because $mech is still blocking in the callback. I'm not sure how to do the mech calls in my callback properly.
At ikegami's request, i've added the driver program that sends the urls. For test purposes, I have it just reading a RSS feed, and sending the links to the workers to attempt to process. I was curious just about basic structure of anyevent with the callbacks but I'm more than happy just to get help on the program in general. Here is the driver code:
#!/usr/local/bin/perl
use strict;
use warnings;
use v5.12.0;
use lib './lib';
use Config::General;
use Getopt::Long;
use Carp;
use AnyEvent;
use AnyEvent::Feed;
use Parallel::ForkManager;
use ZMQ::LibZMQ3;
use ZMQ::Constants qw(ZMQ_PUSH ZMQ_PULL);
use Worker;
# Debug
use Data::Dumper;
$Data::Dumper::Deparse = 1;
my $config_file = "feeds.cfg";
GetOptions(
"--config|c" => \$config_file,
"--help|h" => sub { usage(); exit(0); }
);
sub usage()
{
say "TODO";
}
$SIG{INT} = sub { croak; }; $SIG{TERM} = sub { croak; };
$SIG{CHLD} = 'IGNORE';
my $conf = Config::General->new($config_file) or croak "Couldn't open config file '$config_file' $!\n";
my %config = $conf->getall();
my #readers = ();
my #feeds = load_feeds(\%config);
my $mgr = Parallel::ForkManager->new( $config{'max_download_children'} ) or croak "Can't create fork manager: $!\n";
my $context = zmq_init() or croak "zmq_init: $!\n";
my $sender = zmq_socket($context, ZMQ_PUSH) or die "zmq_socket: $!\n";
foreach my $feed_cfg (#feeds) {
my $reader = AnyEvent::Feed->new(url => delete $feed_cfg->{url}, %$feed_cfg);
push(#readers, $reader); # save, don't go out of scope
}
# Fork Downloader children. These processes will look for incoming data
# in the img_queue and download the images, storing them in nosql
for ( 1 .. $config{'max_download_children'} ) {
my $pid = $mgr->start;
if (!$pid) {
# Child
my $worker = Worker->new({
upstream_job_url => URI->new('tcp://127.0.0.1:5555')
});
$mgr->finish;
say "$$ exiting.";
exit(0);
} else {
# Parent
say "[forked child $pid] my pid is $$";
}
}
if (zmq_bind($sender, 'tcp://127.0.0.1:5555') < 0) {
croak "zmq_bind: $!\n";
}
# Event loop
AnyEvent->condvar->recv;
sub load_feeds
{
my $conf = shift;
my #feeds = ();
foreach my $feed ( keys %{$conf->{'feeds'}} ) {
my $feed_ref = $conf->{'feeds'};
$feed_ref->{$feed}->{'name'} = $feed;
$feed_ref->{$feed}->{'on_fetch'} = \&fetch_feed_cb;
push(#feeds, $feed_ref->{$feed});
}
return #feeds;
}
sub fetch_feed_cb
{
my ($feed_reader, $new_entries, $feed, $error) = #_;
if (defined $error) {
say "Error fetching feed: $error";
return;
}
say "$$ checking for new feeds";
for (#$new_entries) {
my ($hash, $entry) = #$_;
say "$$ sending " . $entry->link;
zmq_send($sender, JSON::to_json( { url => $entry->link }, { pretty => 1, utf8 => 1 } ));
}
}
Here is a sample run:
[forked child 40790] my pid is 40789
[forked child 40791] my pid is 40789
[forked child 40792] my pid is 40789
40789 checking for new feeds
40789 sending http://feedproxy.google.com/~r/PerlNews/~3/f5nNM3zYBt0/
40789 sending http://feedproxy.google.com/~r/PerlNews/~3/Ay9V5pIpFBA/
40789 sending http://feedproxy.google.com/~r/PerlNews/~3/5XCVvt75ppU/
40789 sending http://feedproxy.google.com/~r/PerlNews/~3/mWprjBD3UhM/
40789 sending http://feedproxy.google.com/~r/PerlNews/~3/NngMs9pCQew/
40789 sending http://feedproxy.google.com/~r/PerlNews/~3/wiUsvafLGFU/
40789 sending http://feedproxy.google.com/~r/PerlNews/~3/QMp6gnZpFcA/
40789 sending http://feedproxy.google.com/~r/PerlNews/~3/kqUb_rpU5dE/
40789 sending http://feedproxy.google.com/~r/PerlNews/~3/tHItKqKhGXg/
40789 sending http://feedproxy.google.com/~r/PerlNews/~3/7LleQbVnPmE/
FATAL: $Coro::IDLE blocked itself - did you try to block inside an event loop callback? Caught at lib/Worker.pm line 99.
FATAL: $Coro::IDLE blocked itself - did you try to block inside an event loop callback? Caught at lib/Worker.pm line 99.
FATAL: $Coro::IDLE blocked itself - did you try to block inside an event loop callback? Caught at lib/Worker.pm line 99.
40791 processing http://feedproxy.google.com/~r/PerlNews/~3/Ay9V5pIpFBA/...
40790 processing http://feedproxy.google.com/~r/PerlNews/~3/f5nNM3zYBt0/...
40792 processing http://feedproxy.google.com/~r/PerlNews/~3/5XCVvt75ppU/... ^C at /usr/local/perls/perl5162/lib/perl5/site_perl/darwin-thread-multi-2level/AnyEvent/Loop.pm line 231.
If I don't explicitly do a 'use Coro;' in Worker.pm, the coro FATAL errors don't show. I don't know how async was working before without further runtime errors.
Sample config file (feeds.cfg):
max_download_children = 3
<feeds>
<feed1>
url="http://feeds.feedburner.com/PerlNews?format=xml"
interval=60
</feed1>
</feeds>
So I spent a little more time with this today. So the error of my ways doing a $c->join. I shouldn't do that since I can't block in the callback. Coro will schedule the async block and it will be done when it's done. The only thing I need to make sure to do is to somehow know when all the asyncs are done which I think I can figure out. Now the tricky part is trying to figure out this little piece of mystery:
sub _recv_msg
{
my $self = shift;
while(my $message = zmq_msg_data(zmq_recvmsg($self->_receiver)) ) {
my $msg = JSON::from_json($message, {utf8 => 1});
$self->uri(URI->new($msg->{url}));
$self->_proc_msg;
}
}
This while loop causes my async { } threads in _proc_msg to NOT RUN. Remove the while loop and just handle the first msg and the coros run. Leave the while loop in place and they never will get run. Strange to me, haven't figured out why yet.
Further updates:
zmq_msg_recv was blocking. Also, zmq_send in the parent can block. Have to use ZMQ_NOBLOCK.
I split the worker and main into separate programs entirely.
you could use https://metacpan.org/pod/AnyEvent::HTTP::LWP::UserAgent for async calls.
use AnyEvent::HTTP::LWP::UserAgent;
use AnyEvent;
my $ua = AnyEvent::HTTP::LWP::UserAgent->new;
my #urls = (...);
my $cv = AE::cv;
$cv->begin;
foreach my $url (#urls) {
$cv->begin;
$ua->get_async($url)->cb(sub {
my $r = shift->recv;
print "url $url, content " . $r->content . "\n";
$cv->end;
});
}
$cv->end;
$cv->recv;

Limiting processes with Parallel::ForkManager

I am trying to use Parallel::ForkManager to control some child processes. I would like to limit the number of processes running concurrently to 10. In total I need to run 20.
I know I could set the process limit at 10 in the first line at the object declaration, but I am also using the $pm object to run child processes that do something different (the current function is much more memory intensive so needs to be limited).
The code I have currently does not work, the run on finish call is never made, so the remaining 10 children never get forked. I don't understand why this is the case- I'd have thought the child would still call the finish code on exit,and decrement the count, but the "if" statement seems to stop this. Could someone explain why this is the case?
Thanks for any help!
# Parallel declarations
my $pm = Parallel::ForkManager->new(30);
$pm->run_on_finish(sub {
my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $data_str_ref) = #_;
--$active_jobs;
})
my $total_jobs = 0;
my $active_jobs = 0;
while( $total_jobs < 20) {
sleep 300 and next if $active_jobs > 10;
my $pid = $pm->start and ++$active_p1_jobs and ++$total_p1_jobs and next;
my $return = module::function(%args);
$pm->finish(0, { index => $total_jobs, return => $return });
}
print STDERR "Submitted all jobs, now waiting for children to exit.\n";
$pm->wait_all_children();
I'm going to call "type 2" the jobs that are limited to 10.
This is how I'd do it with P::FM:
use strict;
use warnings;
use List::Util qw( shuffle );
use Parallel::ForkManager qw( );
use POSIX qw( WNOHANG );
use Time::HiRes qw( sleep );
use constant MAX_WORKERS => 30;
use constant MAX_TYPE2_WORKERS => 10;
sub is_type2_job { $_[0]{type} == 2 }
my #jobs = shuffle(
( map { { type => 1, data => $_ } } 0..19 ),
( map { { type => 2, data => $_ } } 0..19 ),
);
my $pm = Parallel::ForkManager->new(MAX_WORKERS);
my $type2_count = 0;
$pm->run_on_finish(sub {
my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $job) = #_;
--$type2_count if is_type2_job($job);
print "Finished: $pid, $job->{type}, $job->{data}, $job->{result}\n";
});
my #postponed_jobs;
while (#postponed_jobs || #jobs) {
my $job;
if (#postponed_jobs && $type2_count < MAX_TYPE2_WORKERS) {
$job = shift(#postponed_jobs);
}
elsif (#jobs) {
$job = shift(#jobs);
if ($type2_count >= MAX_TYPE2_WORKERS && is_type2_job($job)) {
push #postponed_jobs, $job;
redo;
}
}
# elsif (#postponed_jobs) {
# # Already max type 2 jobs being processed,
# # but there are idle workers.
# $job = shift(#postponed_jobs);
# }
else {
local $SIG{CHLD} = sub { };
select(undef, undef, undef, 0.300);
$pm->wait_one_child(WNOHANG);
redo;
}
++$type2_count if is_type2_job($job);
my $pid = $pm->start and next;
$job->{result} = $job->{data} + 100; # Or whatever.
$pm->finish(0, $job);
}
$pm->wait_all_children();
But this is broken. The code that picks the next job should be done in the middle of start (i.e. after it waits for children to finish, but before it forks), not before start. This could cause jobs to be run out of order. This isn't the first time I've wished P::FM has a pre-fork callback. Maybe you could ask the maintainer for one.

AnyEvent timer question

How could I make "visible" the timer? This example returns (intependent from the sleep-time always) 2 (I expected something similar to the sleep-time).
#!/usr/local/bin/perl
use warnings;
use 5.014;
use AnyEvent;
my $c = 0;
my $cv = AnyEvent->condvar;
my $once_per_second = AnyEvent->timer (
after => 0,
interval => 1,
cb => sub {
$c++;
$cv->send;
},
);
sleep 5;
$cv->recv;
say $c;
There are at least two problems:
sleep 5 doesn't run the event loop.
Your callback triggers the cond. variable. If, for instance, you removed the sleep 5 statement, $c would only be 1.
Is this what you want?
my $c = 0;
my $cv = AnyEvent->condvar;
my $once_per_second = AnyEvent->timer(after => 0, interval => 1, cb => sub { $c++ });
my $five_seconds = AnyEvent->timer(after => 5, cb => sub { $cv->send });
$cv->recv;
say $c;
The event loop is not running (well nothing is running) while sleep is "active". So no event registered with AnyEvent can be triggered.
The rule: If you use AnyEvent (or any other ansynchronous framework), never use sleep.
See user5402's answer for the correct solution.

Retrying an operation after an exception: Please criticize my code

My Perl application uses resources that become temporarily unavailable at times, causing exceptions using die. Most notably, it accesses SQLite databases that are shared by multiple threads and with other applications using through DBIx::Class. Whenever such an exception occurs, the operation should be retried until a timeout has been reached.
I prefer concise code, therefore I quickly got fed up with repeatedly
typing 7 extra lines for each such operation:
use Time::HiRes 'sleep';
use Carp;
# [...]
for (0..150) {
sleep 0.1 if $_;
eval {
# database access
};
next if $# =~ /database is locked/;
}
croak $# if $#;
... so I put them into a (DB access-specific) function:
sub _retry {
my ( $timeout, $func ) = #_;
for (0..$timeout*10) {
sleep 0.1 if $_;
eval { $func->(); };
next if $# =~ /database is locked/;
}
croak $# if $#;
}
which I call like this:
my #thingies;
_retry 15, sub {
$schema->txn_do(
sub {
#thingies = $thingie_rs->search(
{ state => 0, job_id => $job->job_id },
{ rows => $self->{batchsize} } );
if (#thingies) {
for my $thingie (#thingies) {
$thingie->update( { state => 1 } );
}
}
} );
};
Is there a better way to implement this? Am I re-inventing the wheel? Is
there code on CPAN that I should use?
I'd probably be inclined to write retry like this:
sub _retry {
my ( $retrys, $func ) = #_;
attempt: {
my $result;
# if it works, return the result
return $result if eval { $result = $func->(); 1 };
# nah, it failed, if failure reason is not a lock, croak
croak $# unless $# =~ /database is locked/;
# if we have 0 remaining retrys, stop trying.
last attempt if $retrys < 1;
# sleep for 0.1 seconds, and then try again.
sleep 0.1;
$retrys--;
redo attempt;
}
croak "Attempts Exceeded $#";
}
It doesn't work identically to your existing code, but has a few advantages.
I got rid of the *10 thing, like another poster, I couldn't discern its purpose.
this function is able to return the value of whatever $func() does to its caller.
Semantically, the code is more akin to what it is you are doing, at least to my deluded mind.
_retry 0, sub { }; will still execute once, but never retry, unlike your present version, that will never execute the sub.
More suggested ( but slightly less rational ) abstractions:
sub do_update {
my %params = #_;
my #result;
$params{schema}->txn_do( sub {
#result = $params{rs}->search( #{ $params{search} } );
return unless (#result);
for my $result_item (#result) {
$result_item->update( #{ $params{update} } );
}
} );
return \#result;
}
my $data = _retry 15, sub {
do_update(
schema => $schema,
rs => $thingy_rs,
search => [ { state => 0, job_id => $job->job_id }, { rows => $self->{batchsize} } ],
update => [ { state => 1 } ],
);
};
These might also be handy additions to your code. ( Untested )
The only real problem I see is the lack of a last statement. This is how I would write it:
sub _retry {
my ($timeout, $func) = #_;
for my $try (0 .. $timeout*10) {
sleep 0.1 if $try;
eval { $func->(); 1 } or do {
next if $# =~ /database is locked/; #ignore this error
croak $#; #but raise any other error
};
last;
}
}
I might use 'return' instead of 'last' (in the code as amended by Chas Owens), but the net effect is the same. I am also not clear why you multiply the first parameter of your retry function by 10.
IMNSHO, it is far better to (re)factor common skeletal code into a function as you have done than to continually write the same code fragment over and over. There's too much danger that:
You have to change the logic - in far too many places
You forget to edit the logic correctly at some point
These are standard arguments in favour of using functions or equivalent abstractions over inline code.
In other words - good job on creating the function. And it is useful that Perl allows you to create the functions on the fly (thanks, Larry)!
Attempt by Mark Fowler seems to be pretty close to what I described above. Now, it would be handy if one could specify some sort of exception filter.