AnyEvent timer question - perl

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.

Related

Change the text of a Tk label asynchronously

I need graphical output from a Perl program. The window has a label status field and should show what programming code decides.
How do I change the text of a label field after the window has been created without any buttons?
I have the following:
use Tk;
$mw = Tk::MainWindow->new(-title => 'Status Window',-bg=>"white");
$mw->geometry ("400x200+0+0");
$lala = $mw->Label(-text => "Current Status")->grid(-row=>0,-column=>0);
$mw->bind( 'all' => '<Key-Escape>' => sub {exit;} );
MainLoop;
How do I incorporate the following subroutine so that it is run automatically
after the window is created? Label-Widget does not have
a -command field. It should start immediately and
not wait for a event to happen
sub calculate() {
for ( $i = 0; $i < 10; $i++ ) {
sleep 2s;
$lala->configure(-text=>"Current Status : $i");
}
}
The following seems to work. I used after() to run code after 100 ms then used update() to redraw window:
use feature qw(say);
use strict;
use warnings;
use Tk;
my $mw = Tk::MainWindow->new(-title => 'Status Window',-bg=>"white");
$mw->geometry ("400x200+0+0");
my $lala = $mw->Label(-text => "Current Status")->grid(-row=>0,-column=>0);
$mw->bind('all'=> '<Key-Escape>' => sub {exit;});
$lala->after(100, \&calculate );
MainLoop;
sub calculate() {
for(my $i=0; $i<10; $i++){
sleep 1;
$lala->configure(-text=>"Current Status : $i");
$mw->update();
}
}
Edit:
The above code blocks during the sleep 1 call, so any input for the Tk event loop will will be delayed. In particular, pressing Esc to quit the application will not work immediately. It will be blocked until sleep returns. To solve this, one can use Tk's repeat() instead of sleep and Tk's after(), and cancel the repeat if necessary:
my $repeat_count = 10;
my $timer_id = $lala->repeat(1000, \&calculate );
MainLoop;
sub calculate() {
$lala->configure(-text=>"Current Status : $repeat_count");
if ( --$repeat_count == 0) {
$timer_id->cancel;
}
}

Start stop reset timer in perl

Is there a start/stop timer in Perl. I had tried AnyEvent but this is like a one time or recurring timer. Once set, I can reset the timeout interval.
I have a requirement where I have to reset the timer if an event occurs within the timer timeout interval. Is there any Perl module that does this job?
Thanks in advance.
UPDATE
This question actually prompted quite a bit of discussion on the #mojo IRC channel. The end result is that, barring some unforseen problems, the upcoming Mojolicious 4.0 release will include a new reactor method again which can restart timers. It turns out that this new method (inspired partially by this question) provides a massive performance increase when used internally by Mojolicious in a certain case (high load with high concurrency). Once 4.0 is released, try this updated example version of the second example below:
#!/usr/bin/env perl
use Mojo::Base -strict;
use Mojo::IOLoop;
my $loop = Mojo::IOLoop->singleton;
my $now = 1;
$loop->recurring( 1 => sub { print $now++ . "\n" } );
my $timer = $loop->timer( 3 => \&boom );
$loop->timer( 2 => sub {
print "Event resets. No boom yet\n";
$loop->reactor->again($timer);
});
$loop->start;
sub boom {
print "Boom!\n";
$loop->stop;
}
ORIGINAL
Here is a quick and dirty using the Mojo::IOLoop directly. If this is run inside a server you probably don't need the start and stop methods. Basically the there is a countdown variable which may be reset elsewhere and the recurring timer checks to see if that countdown has expired before it goes boom.
#!/usr/bin/env perl
use Mojo::Base -strict;
use Mojo::IOLoop;
my $loop = Mojo::IOLoop->singleton;
my $now = 1;
my $timeout = 3;
$loop->recurring( 1 => sub {
print $now++ . "\n";
boom() unless $timeout--;
});
$loop->timer( 2 => sub {
print "Event resets. No boom yet\n";
$timeout = 3;
});
$loop->start;
sub boom {
print "Boom!\n";
$loop->stop;
}
The above method is more efficient if you expect that you are going to have many resets. Here is another example which is a less efficient but more direct example. In this case, the idea is to keep the id of the timer so you can remove it and add another. This effectively resets the timer.
#!/usr/bin/env perl
use Mojo::Base -strict;
use Mojo::IOLoop;
my $loop = Mojo::IOLoop->singleton;
my $now = 1;
$loop->recurring( 1 => sub { print $now++ . "\n" } );
my $timer = $loop->timer( 3 => \&boom );
$loop->timer( 2 => sub {
print "Event resets. No boom yet\n";
$loop->remove($timer);
$timer = $loop->timer( 3 => \&boom );
});
$loop->start;
sub boom {
print "Boom!\n";
$loop->stop;
}
Note that the recurring event used here is just to show the elapsed time and isn't important to the flow.

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.

What does send/recv/begin/end mean for AnyEvent's condvar?

I'm at a loss what it means, though I'm read several examples on it:
#!/usr/bin/perl
use strict;
use AnyEvent;
my $cv = AnyEvent->condvar( cb => sub {
warn "done";
});
for my $i (1..10) {
$cv->begin;
my $w; $w = AnyEvent->timer(after => $i, cb => sub {
warn "finished timer $i";
undef $w;
$cv->end;
});
}
$cv->recv;
Can anyone explain in more detail what send/recv/begin/end does?
UPDATE
my $i = 1;
my $s = sub {
print $i;
};
my $i = 10;
$s->(); # 1
In the code you provided, the condvar is there to prevent the program from exiting prematurely. Without the recv, the program would end before any timers would have a chance to fire. With the recv, all ten timers must fire before recv returns.
recv will block if send has never been called. It will unblock when send is called.
begin and end is an alternative to using send. When there has been as many end calls as there has been begin calls, a send occurs.
AnyEvent

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

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;