Adding a periodic timeout to select from a sub-class of Net::Server::HTTP - perl

I'm trying to write a small service that responds to a couple commands (to check/report on status), but every 15 seconds or so breaks out of its polling status to check a database for messages and fork off a child to do some processing.
I'm sub-classing Net::Server::HTTP, for example:
my $service = MyService->new("port" => 8080);
$service->run(app => {
"/ping" => sub { print_client("Pong"); },
"/status" => sub { print_client("Good, thanks"); },
});
but I can't figure out how to get a timeout through the class hierarchy to reach the socket's select call. I was hoping I could pass a timeout through, or use a while(1) with an alarm to break out of the run method, but neither is working.
What I was /hoping/ for was to do:
while (1) {
$service->run(
timeout => 15,
app => { ... }
});
check_database();
}
Is there a better way to do this while keeping the code simple?

Related

Why Dancer `halt` command bypass all events?

Example:
hook on_route_exception => sub {
# This code is not executed
}
hook on_handler_exception => sub {
# This code is not executed
}
hook after => sub {
# This code is not executed
}
hook after_error_render => sub {
# This code is not executed
}
hook before => sub {
if ($some_condition) {
halt("Unauthorized");
# This code is not executed :
do_stuff();
}
};
get '/' => sub {
"hello there";
};
I can find this piece of documentation:
Thus, any code after a halt is ignored, until the end of the route.
But hooks are after the end of route, so should not be ignored. Should be?
Why hooks are ignored too?
I would think that the reason is that the processing was halted. The
halt("Unauthorized");
would essentially return that content in the response object and no further events are required. The halt effectively halted all processing for that request/response.
That is a guess based on how it is behaving and the description.
A closer look at :https://metacpan.org/release/BIGPRESH/Dancer-1.3513/source/lib/Dancer.pm#L156
shows that after the Response Content is set to "Unauthorized" it calls:
Dancer::Continuation::Halted->new->throw
which dies:
https://metacpan.org/release/BIGPRESH/Dancer-1.3513/source/lib/Dancer/Continuation.pm#L14
sub throw { die shift }
At least that's how I read that code. Since it dies there is nothing else to do.
Likely a deliberate design decision based on the intention to halt.

Why would hot deploy of Hypnotoad rerun old http requests?

The nutshell:
When I do a hot deployment of Hypnotoad sometimes the new server immediately processes a slew of HTTP requests that were already handled by the previous server.
If a response has been rendered but the thread is still doing some processing does Mojo/Hypnotoad retain the request until the processing has stopped? Do I need to tell the server that the HTTP request is resolved?
The long version:
I have a Mojolicious::Lite app running under Hypnotoad.
The app's function is to accept HTTP requests from another service.
We are processing jobs that progress through a series of states.
At each job state change the app is notified with an HTTP request.
This is a busy little script - recieving more than 1000 req/hour.
The scripts job is to manipulate some data .. doing DB updates, editng files, sending mail.
In an effort to keep things moving along, when it recieves the HTTP request it sanity checks the data it recieved. If the data looks good it sends a 200 response to the caller immediately and then continues on to do the more time consuming tasks. (I'm guessing this is the underlying cause)
When I hot deploy - by rerunning the start script (which runs 'localperl/bin/hypnotoad $RELDIR/etc/bki/bki.pl') - some requests that were already handled are sent to the new server and reprocessed.
Why are these old transactions still being held by the original server? Many have been long since completed!
Does the need to tell Mojolicious that the request is done before it goes off and messes with data?
(I considered $c->finish() but that is just for sockets?)
How does Hypnotoad decide what requests should be passed to it's replacement server?
Here is some psuedo code with what I'm doing:
get '/jobStateChange/:jobId/:jobState/:jobCause' => sub {
my $c =shift;
my $jobId = $c->stash("jobId");
return $c->render(text => "invalid jobId: $jobId", status => 400) unless $jobId=~/^\d+$/;
my $jobState = $c->stash("jobState");
return $c->render(text => "invalid jobState: $jobState", status => 400) unless $jobState=~/^\d+$/;
my $jobCause = $c->stash("jobCause");
return $c->render(text => "invalid jobCause: $jobCause", status => 400) unless $jobCause=~/^\d+$/;
my $jobLocation = $c->req->param('jobLocation');
if ($jobLocation){ $jobLocation = $ENV{'DATADIR'} . "/jobs/" . $jobLocation; }
unless ( $jobLocation && -d $jobLocation ){
app->log->debug("determining jobLocation because passed job jobLocation isn't useable");
$jobLocation = getJobLocation($jobId);
$c->stash("jobLocation", $jobLocation);
}
# TODO - more validation? would BKI lie to us?
return if $c->tx->res->code && 400 == $c->tx->res->code; # return if we rendered an error above
# tell BKI we're all set ASAP
$c->render(text => 'ok');
handleJobStatusUpdate($c, $jobId, $jobState, $jobCause, $jobLocation);
};
sub handleJobStatusUpdate{
my ($c, $jobId, $jobState, $jobCause, $jobLocation) = #_;
app->log->info("job $jobId, state $jobState, cause $jobCause, loc $jobLocation");
# set the job states in jobs
app->work_db->do($sql, undef, #params);
if ($jobState == $SOME_JOB_STATE) {
... do stuff ...
... uses $c->stash to hold data used by other functions
}
if ($jobState == $OTHER_JOB_STATE) {
... do stuff ...
... uses $c->stash to hold data used by other functions
}
}
Your request will not be complete until the request handler returns. This little app, for example, will take 5 seconds to output "test":
# test.pl
use Mojolicious::Lite;
get '/test' => sub { $_[0]->render( text => "test" ); sleep 5 };
app->start;
The workaround for your app would be to run handleJobStatusUpdate in a background process.
get '/jobStateChange/:jobId/:jobState/:jobCause' => sub {
my $c =shift;
my $jobId = $c->stash("jobId");
my $jobState = $c->stash("jobState");
my $jobCause = $c->stash("jobCause");
my $jobLocation = $c->req->param('jobLocation');
...
$c->render(text => 'ok');
if (fork() == 0) {
handleJobStatusUpdate($c, $jobId, $jobState, $jobCause, $jobLocation);
exit;
}

Subscribers connecting to a STOMP queue don't get added to round-robin distribution

I am using perl's Net::Stomp on top of RabbitMQ to rig up a very simple cross-platform distributed work queue. The idea is to submit a bunch of jobs to a single queue name and have a number of workers pull off jobs and execute them.
If I start up "workers" and submit the frames/jobs to the queue, I get exactly what I expect: the workers pop the frames off the queue in a round-robin fashion.
If I submit jobs to the persistent queue and then start up a number of workers, only the first pulls jobs off the queue.
# submit.pl
use Net::Stomp;
use JSON::PP;
my $stomp = Net::Stomp->new( { hostname => 'localhost', port => '61613' } );
$stomp->connect( { login => 'a', passcode => 'a' } ) or die;
for (my $i=0; $i < 20; $i++) {
my $package = encode_json( { seed => $i } );
$stomp->send( { destination => '/queue/runs', body => $package } );
}
$stomp->disconnect;
# worker.pl
my $stomp = Net::Stomp->new( { hostname => 'localhost', port => '61613' } );
$stomp->connect( { login => 'a', passcode => 'a' } );
$stomp->subscribe({
destination => '/queue/runs',
ack => 'client',
'activemq.prefetchSize' => 1 });
while (my $frame = $stomp->receive_frame) {
next unless defined $frame;
$stomp->ack( { frame => $frame } );
next unless $frame->body;
my $spec = decode_json $frame->body;
say $$ . " " . $spec->{seed};
sleep 1;
}
Running this:
$ perl submit.pl && perl worker.pl & perl worker.pl
What I would expect to see is something like:
30026 0
30024 1
30026 2
30024 3
...
Instead I see only the first "worker" pulling frames off the queue. If I kill the first "worker" process, the second then begins pulling frames.
30024 0
30024 1
30024 2
30024 3
...
I would like it to be the case that immediately as workers subscribe to the queue they begin pulling frames in a round-robin fashion. I would rather not have to write explicit stuff to handle this. I assume there is some mechanism in the protocol already that I am overlooking, or perhaps a bug in Net::Stomp?
As I said, the round-robin dispatch works perfectly if the workers are running before submit.pl is run.
On Rabbitmq's STOMP plugin the activemq.prefetchSize key shown in the Net::Stomp documentation does nothing. All I had to do was change it to 'prefetch-count' => 1 and then it all worked as I expected.

AnyEvent->timer not working with AnyEvent::Handle?

I'm trying to build a timeout scenario in my Catalyst, AnyEvent, Websocket app.
For that I'm using
AnyEvent->timer
which should be called after let's say a few seconds of inactivity (no more WS frames coming in).
The problem is, that my timer is never executed:
my $w = AnyEvent->timer (after => 3,
cb => sub {
warn "TIMEOUT!";
});
$self->{server} = Protocol::WebSocket::Handshake::Server->new_from_psgi(
$c->req->env) or die $c->log->fatal($!);
$self->{handle} = AnyEvent::Handle->new(
fh => $c->req->io_fh,
on_error => sub {
my ($hd, $fatal, $msg) = #_;
$clean_up->();
}
);
die $c->log->fatal("WS Server error: '$_'")
if $self->{server}->error;
$self->{server}->parse($self->{handle}->fh);
$self->{handle}->push_write($self->{server}->to_string);
$self->{handle}->on_read(sub {
(my $frame = $self->{server}->build_frame)->append($_[0]->rbuf);
while (my $frame_msg = $frame->next) {
...
}
The timer callback is never executed.
My guess would be, that the timer doesn't work inside another Event loop (AnyEvent::Handle)?
Are you actually getting into the event loop for the timer to be processed? Your code snippet does not indicate this.
Also, AnyEvent::Handle has inactivity timeouts built-in:
timeout => $fractional_seconds
If non-zero, then this enables an "inactivity" timeout: whenever
this many seconds pass without a successful read or write on the
underlying file handle, the "on_timeout" callback will be invoked
(and if that one is missing, a non-fatal "ETIMEDOUT" error will
be raised).
Note that timeout processing is also active when you currently do
not have any outstanding read or write requests: If you plan to
keep the connection idle then you should disable the timout
temporarily or ignore the timeout in the "on_timeout" callback,
in which case AnyEvent::Handle will simply restart the timeout.
Zero (the default) disables this timeout.
on_timeout => $cb->($handle)
Called whenever the inactivity timeout passes. If you return from
this callback, then the timeout will be reset as if some activity
had happened, so this condition is not fatal in any way.

Can I use a AnyEvent->timer() in a AnyEvent::Fork ?

Let's say I work with a number N of account object.
I would like to create for N Account, several forks, and independently include an event AnyEvent-> timer ().
here is what my code looks like:
for my $num_account (1..2) {
my $fork_1 = AnyEvent::Fork
->new
->require ("TweetFactory")
->fork
->run ("TweetFactory::worker",sub {
my ($master_filehandle) =#_;
my $wait1 = AnyEvent->timer(after => 0, interval => 100 ,cb => sub {
my $account = UsersPool::get_account($num_account);
my $tf = new TweetFactory ({account => $account, topic => $topic});
%search_article = $tf->search_articles_from_topic_list($dbh,\$db_access,#rh_website);
$tf->save_url_to_process($dbh,\$db_access,%search_article);
#url_to_process = $tf->get_url_to_process(100,$dbh,\$db_access);
%articles_urls_titles = $tf->get_infos_url($mech,#url_to_process);
$tf->save_url_processed($dbh,\$db_access,%articles_urls_titles);
});
});
my $fork_2 = AnyEvent::Fork
->new
->require ("TargetUsers")
->fork
->run ("TargetUsers::worker",sub {
my ($master_filehandle) =#_;
my $wait2 = AnyEvent->timer(after => 0, interval => 80, cb => sub {
my $account = UsersPool::get_account($num_account);
TargetUsers::save_all_messages($account,$dbh,\$db_access);
});
});
my $fork_3 = AnyEvent::Fork
->new
->require ("TargetUsers")
->fork
->run ("TargetUsers::worker",sub {
my ($master_filehandle) =#_;
my $wait3 = AnyEvent->timer(after => 0 , interval => 80, cb => sub {
my $account = UsersPool::get_account($num_account);
TargetUsers::save_followers($dbh,\$db_access,$account);
});
});
AnyEvent::Loop::run;
}
But during the execution, the timers does not start.
I have, on the contrary, tried to launch an event AnyEvent-> timer in which I create my fork :
my $wait2 = AnyEvent->timer(after => 0, interval => 10, cb => sub {
my $fork_2 = AnyEvent::Fork
->new
->require ("TargetUsers")
->fork
->run ("TargetUsers::worker",sub {
my ($master_filehandle) =#_;
my $account = UsersPool::get_account($num_account);
TargetUsers::save_all_messages($account,$dbh,\$db_access);
});
});
At this moment, the event was well launched, but I had to wait for the execution of the last event to create the next fork.
Have you some idea please ? Thanks
First some observations: in your example, you do not need to call ->fork. You also don't show the code running in the forked process, you only show how you create timers in the parent process, and these should certainly work. Lastly, you don't seem to do anything with the forked process (you do nothing to the $master_filehandle).
More importantly, your example creates and instantly destroys the fork objects, they never survive the loop, and you actually call the loop function inside your for loop, so probably you don't loop more than once
Maybe there is some misunderstanding involved - the callback you pass to run is executed in the parent, the same process whjere you execute AnyEvent::Fork->new, The code that runs in the child would be the TargetUsers::worker function for example.
To make timers work in the newly created processes, you would need to run an event loop in them.
Maybe AnyEvent::Fork::RPC with the async backend would be more suited for your case: it runs an event loop for you, it has a simpler request/response usage and it can pass data to and from the newly created process.