さっきの記事のShikaのベンチのコード

id:tokuhiromさんにベンチうｐ頼まれたんだけども超個人的なBenchmarkコードなのでそのままCodeReposにあげれるような代物でもないということもあり取り急ぎエントリとしてあげておきますので自由に変更しちゃってください。


#!/usr/local/bin/perl -w
use strict;
use warnings;

package MooseBuild;
use Moose;

has userid => (
    is => 'rw',
);

has agent  => (
    is => 'rw',
    required => 1,
);

sub BUILD {
    my $self = shift;
    $self->userid(90);
    $self->userid($self->agent->user_id ) unless $self->agent->is_non_mobile;
}

no Moose;
__PACKAGE__->meta->make_immutable;
1;

package MooseDefault;
use Moose;

has userid => (
    is      => 'rw',
    lazy    => 1,
    default => sub {
        my $self = shift;
        return $self->agent->is_non_mobile ? 90 : $self->agent->user_id;
    }
);

has agent  => (
    is       => 'rw',
    required => 1,
);

no Moose;
__PACKAGE__->meta->make_immutable;
1;

package ShikaDefault;
use Shika;

has userid => (
    is      => 'rw',
    lazy    => 1,
    default => sub {
        my $self = shift;
        return $self->agent->is_non_mobile ? 90 : $self->agent->user_id;
    }
);

has agent  => (
    is       => 'rw',
    required => 1,
);

no Shika;
1;

package ClassAccessor;
use strict;
use warnings;
use base qw/Class::Accessor::Fast/;
use Carp qw/croak/;

__PACKAGE__->mk_accessors(qw/
    userid
    agent
/);

sub new {
    my $self = shift->SUPER::new(@_);
    $self->agent or croak 'agent not found';
    $self->userid( 90 );
    $self->userid( $self->agent->user_id ) unless $self->agent->is_non_mobile;
    return $self;
}

package Popo;
sub new {
    my $class = shift;
    my $param = ref $_[0] eq 'HASH' ? shift : {@_};
    return bless $param, ref $class || $class;
}

sub agent {
    my $self = shift;
    return $self->{agent} = shift if @_;
    return $self->{agent};
}

sub userid {
    my $self = shift;
    return $self->{userid} = shift if @_;
    exists $self->{userid} || do {
        $self->{userid} = $self->agent->is_non_mobile ? 90 : $self->agent->user_id;
    };
    return $self->{userid};
}

package main;

use HTTP::MobileAgent;
my $agent = HTTP::MobileAgent->new('');

use Benchmark qw(cmpthese timethese :hireswallclock);

#    my $obj1 = MooseBuild->new( agent => $agent );
#    my $obj2 = MooseDefault->new( agent => $agent );
#    my $obj3 = ClassAccessor->new({ agent => $agent });
#    my $obj4 = Popo->new( agent => $agent );
#    my $obj5 = ShikaDefault->new( agent => $agent );

cmpthese(10000,{
    moose_build => sub {
        my $obj = MooseBuild->new( agent => $agent );
        $obj->userid;
        $obj->userid('hoge');
    },
    moose_default    => sub {
        my $obj = MooseDefault->new( agent => $agent );
        $obj->userid;
        $obj->userid('hoge');
    },
    shika_default    => sub {
        my $obj = ShikaDefault->new( agent => $agent );
        $obj->userid;
        $obj->userid('hoge');
    },
    class_accessor    => sub {
        my $obj = ClassAccessor->new({ agent => $agent });
        $obj->userid;
        $obj->userid('hoge');
    },
    popo    => sub {
        my $obj = Popo->new( agent => $agent );
        $obj->userid;
        $obj->userid('hoge');
    },
});

HTTP::MobileAgent使ってたり若干ノイズがありますがご愛嬌を・・・。一応細かい違いはあれど同じような挙動をするように実装してます。

実行結果は


                  Rate shika_default moose_default class_accessor moose_build popo
shika_default  15152/s            --          -55%           -65%        -65% -83%
moose_default  33333/s          120%            --           -23%        -23% -63%
class_accessor 43478/s          187%           30%             --          0% -52%
moose_build    43478/s          187%           30%             0%          -- -52%
popo           90909/s          500%          173%           109%        109%   --

# ↓はWindows環境
                   Rate shika_default moose_default class_accessor moose_build popo
shika_default   25641/s            --          -48%           -52%        -56% -76%
moose_default   49261/s           92%            --            -7%        -15% -54%
class_accessor  53191/s          107%            8%             --         -9% -51%
moose_build     58140/s          127%           18%             9%          -- -46%
popo           107527/s          319%          118%           102%         85%   --

何かミスってたら突っ込みよろです。では。

ちなみにMooseのバージョンは0.60です。

追記

svn HEAD でとるとこうなりますね。XS を有効にするのがポイントです。gfx++


                  Rate moose_default moose_build class_accessor shika_default popo
moose_default  37037/s            --        -19%           -22%          -30% -59%
moose_build    45455/s           23%          --            -5%          -14% -50%
class_accessor 47619/s           29%          5%             --          -10% -48%
shika_default  52632/s           42%         16%            11%            -- -42%
popo           90909/s          145%        100%            91%           73%   --

Shika is slow? - tokuhirom's blog.

これははやい。

現状CPANに上がってるShikaはXSの部分がコメントアウトされてますね。なるほど合点です。

XS使える環境であればClass::Accessorよりもはやいのでこれはいよいよガシガシ使うのアリですね。

というかこれで元記事でMooseに抱いていた懸念点は全て払拭されたような・・・・。

クシャナの判断は正しかった。