#!/usr/bin/perl use strict; use warnings; use Tk; use HTTP::Request; my $handler = RequestHandler->new(); my $time; init_time(); my $mw = tkinit(); $mw->Label(-text => 'Time: ')->pack(-side => 'left'); $mw->Label(-textvariable => \$time )->pack(-side => 'left'); $mw->repeat(100 => sub { $handler->listener(); $mw->update(); }); MainLoop; sub init_time { $handler->add_listener('_time', sub { _time(@_) } ); _time(); } sub _time { my ($value) = @_; $handler->add_request( HTTP::Request->new('GET', 'http://bit.ly/2v7njgk'), '_time', sub { _time(@_) } ); $time = $value if $value; } package RequestHandler; use strict; use warnings; use HTTP::Async; sub new { my ( $class, ) = @_; my $self = { parallel_requests => 20, #async default requests_per_task => 5, # useful in times of lagging, asking several times and take the first error-free response request_delay => 0.1, #in s, including decimals }; bless $self, ref($class) || $class; return $self; } sub _async { my ($self, ) = @_; $self->{'HTTP'}->{'async'} = HTTP::Async->new() unless $self->{'HTTP'}->{'async'}; return $self->{'HTTP'}->{'async'}; } sub listener { my ( $self, ) = @_; $self->_handle_responses(); for my $listener ( keys %{ $self->{'listen_to'} } ) { my $callback = $self->{'listen_to'}->{$listener}->{'sub'}; my $args = $self->{'listen_to'}->{$listener}->{'arg'}; #print "LISTEN\n"; $callback->($args || ''); } } sub add_listener { my ( $self, $name, $sub, $arg, ) = @_; print "New Listener: $name\n"; $self->{'listen_to'}->{$name}->{'sub'} = $sub; $self->{'listen_to'}->{$name}->{'arg'} = $arg; #dyn args dev } sub add_request { my ($self, $req, $req_type, $callback) = @_; if (defined $self->{'request_map'}->{$req_type}) { if ( ( @{ $self->{'request_map'}->{$req_type}->{'ids'} } >= $self->{'requests_per_task'} ) || ( ( time - $self->{'request_map'}->{$req_type}->{'time'} ) <= $self->{'request_delay'} ) ) { return undef; } } my $id = $self->_async->add($req); push @{ $self->{'request_map'}->{$req_type}->{'ids'} }, $id; $self->{'request_map'}->{$req_type}->{'time'} = time(); $self->{'request_map'}->{$req_type}->{'callback'} = $callback; print "ID: $id - $req_type\n"; return $id } sub _handle_requests { my ( $self, $id, $content, $http_error ) = @_; for my $req_type ( keys %{ $self->{'request_map'} } ) { my $queued_ids = \$self->{'request_map'}->{$req_type}->{'ids'}; for my $queued_id (@{ $$queued_ids }) { if ( $id eq $queued_id ) { #only remove queue if we haven't an http-error in response unless ( $http_error ) { for my $del_id (@{ $$queued_ids }) { $self->_async->remove($del_id); } $$queued_ids = []; } else { @{ $$queued_ids } = grep {$_ ne $id} @{ $$queued_ids }; } my $callback = $self->{'request_map'}->{$req_type}->{'callback'}; $callback->($content); return 1; } } } return 0; } sub _handle_responses { my ( $self, ) = @_; while ( my ($res, $id) = $self->_async->next_response ) { print "Working on $id\n"; my ( $content, $http_error ) = ( undef, 0 ); if ( $res->is_success ) { $content = $res->content; } else { $content = $res->status_line; $http_error = 1; } $self->_handle_requests($id, $content, $http_error); } } sub DESTROY { my ( $self, ) = @_; $self->_async->remove_all(); } 1;