Furlでサーバへの接続に掛かった時間とレスポンスに掛かった時間を取得する方法

AnyEvent::HTTPの続き

package MyFurl::HTTP;

use strict;
use warnings;
use base qw/Furl::HTTP/;
use Time::HiRes;

sub response_time {
    if ( @_ > 1 ) { 
        $_[0]->{times} = $_[1];
    }
    $_[0]->{times};
}

sub connect : method {
    my($self, $host, $port, $timeout_at) = @_;
    push @{$self->response_time}, Time::HiRes::time;
    my $ret = $self->SUPER::connect($host, $port, $timeout_at);
    push @{$self->response_time}, Time::HiRes::time;
    $ret;
}

sub request {
    my $self = shift;
    $self->response_time([]);
    $self->{start_req} = Time::HiRes::time;
    my @ret = $self->SUPER::request(@_);
    $self->response_time([$self->{start_req},$self->{start_req}]) if @{$self->response_time} == 0; #keepalive
    push @{$self->response_time}, Time::HiRes::time;
    @ret;
}

1;

package MyFurl;

use strict;
use warnings;
use base qw/Furl/;

sub new {
    my $class = shift;
    bless \(MyFurl::HTTP->new(header_format => Furl::HTTP::HEADERS_AS_HASHREF(), @_)), $class;
}

sub response_time {
    ${shift @_}->response_time(@_);
}

1;

package main;

use strict;
use warnings;
use Plack::Util qw//;
use Net::DNS::Lite qw//;
use Cache::LRU;

{
    my $conncache = Cache::LRU->new(size => 10);
    my $furl = MyFurl->new(
        connection_pool => Plack::Util::inline_object(
            steal => sub{ my $key = $_[0].':'.$_[1]; $conncache->get($key) },
            push => sub{ my $key = $_[0].':'.$_[1]; $conncache->set($key,$_[2])  }
        ),
    );
    for my $i ( 1..3 ) {
        my $res = $furl->get("http://livedoor.blogimg.jp/");
        warn sprintf 'MyFurl %s [%s] connect: %s req_to_res: %s', 
            $i,
            $res->code,
            int(($furl->response_time->[1] - $furl->response_time->[0]) * 1_000_000), 
            int(($furl->response_time->[2] - $furl->response_time->[1]) * 1_000_000), 
    }
}

{
    local $Net::DNS::Lite::CACHE = Cache::LRU->new(size => 100);
    my $furl = MyFurl::HTTP->new(
        max_redirects => 0,
        connection_pool => Plack::Util::inline_object(steal=>sub{},push=>sub{}),
        inet_aton => sub { Net::DNS::Lite::inet_aton(@_) }
    );

    for my $i ( 1..3 ) {
        my @res = $furl->get("http://livedoor.blogimg.jp/");
        warn sprintf 'MyFurl::HTTP %s [%s] connect: %s req_to_res: %s', 
            $i,
            $res[1],
            int(($furl->response_time->[1] - $furl->response_time->[0]) * 1_000_000), 
            int(($furl->response_time->[2] - $furl->response_time->[1]) * 1_000_000), 
    }
}

実行結果

MyFurl 1 [200] connect: 21210 req_to_res: 10994 at furl_time.pl line 72.
MyFurl 2 [200] connect: 0 req_to_res: 10759 at furl_time.pl line 72.
MyFurl 3 [200] connect: 0 req_to_res: 10649 at furl_time.pl line 72.
MyFurl::HTTP 1 [200] connect: 20972 req_to_res: 13005 at furl_time.pl line 90.
MyFurl::HTTP 2 [200] connect: 10706 req_to_res: 11482 at furl_time.pl line 90.
MyFurl::HTTP 3 [200] connect: 10655 req_to_res: 11739 at furl_time.pl line 90.

上3つはkeepaliveした場合。下3つはDNSのキャッシュをしている