Changeset 20898 for lang

Show
Ignore:
Timestamp:
10/07/08 17:54:44 (5 years ago)
Author:
bonnu
Message:

lang/perl/Method-Cached - benchmark script was updated

Location:
lang/perl/Method-Cached/trunk
Files:
1 removed
2 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/Method-Cached/trunk/lib/Method/Cached/Domain.pm

    r20895 r20898  
    88use Scalar::Util qw/blessed/; 
    99use UNIVERSAL::require; 
    10 use Method::Cached::KeyRegularizer; 
     10use Method::Cached::KeyRule; 
    1111use Method::Cached::MethodRegistry; 
    1212 
    … …  
    4242    my ($self, $name, @args) = @_; 
    4343    my $registry = Method::Cached::MethodRegistry::refer($name); 
    44     Method::Cached::KeyRegularizer->regularize( 
     44    Method::Cached::KeyRule::regularize( 
    4545        $registry->{key_rule} || $self->key_rule || undef,  
    4646        $name, 

  • lang/perl/Method-Cached/trunk/t/benchmark2.pl

    r20895 r20898  
    55use FindBin::libs; 
    66 
    7 use Method::Cached::Manager -default => { 
    8     storage_class => 'Cache::Memcached::Fast', 
    9     storage_args  => [ 
    10         { servers => [qw/ 127.0.0.1:11211 /] }, 
    11     ], 
    12     key_rule      => 'LIST', # SERIALIZE / LIST 
    13 }; 
     7my ($cache, $volume, @default); 
    148 
    15 use Method::Cached2 -default => { 
    16     storage_class => 'Cache::Memcached::Fast', 
    17     storage_args  => [ 
    18         { servers => [qw/ 127.0.0.1:11211 /] }, 
    19     ], 
    20     key_rule      => 'LIST', # SERIALIZE / LIST 
    21 }; 
     9BEGIN { 
    2210 
     11    $cache  = shift || 'memcached'; 
     12    $volume = shift || 10000; 
     13 
     14    $default[0] = $cache eq 'memcached' 
     15        ? { 
     16            storage_class => 'Cache::Memcached::Fast', 
     17            storage_args  => [ 
     18                { servers => [qw/ 127.0.0.1:1121%s /] }, 
     19            ], 
     20            key_rule      => 'SERIALIZE', # SERIALIZE / LIST 
     21        } 
     22        : $cache eq 'fastmmap' 
     23        ? { 
     24            storage_class => 'Cache::FastMmap', 
     25            storage_args  => [ 
     26                share_file     => '/tmp/fastmmap_%s.bin', 
     27                unlink_on_exit => 1, 
     28            ], 
     29            key_rule      => 'SERIALIZE', # SERIALIZE / LIST 
     30        } 
     31        : die "Illegal cache option: $cache" 
     32    ; 
     33 
     34    use Storable qw/dclone/; 
     35    $default[1] = dclone($default[0]); 
     36 
     37    no strict 'refs'; 
     38    map { 
     39        my $args_ref = $default[$_]->{storage_args}; 
     40        if ($cache eq 'memcached') { 
     41            my $serv_ref = $args_ref->[0]->{servers}; 
     42            $serv_ref->[0] = sprintf $serv_ref->[0], $_ + 1; 
     43        } 
     44        if ($cache eq 'fastmmap') { 
     45            $args_ref->[1] = sprintf $args_ref->[1], $_; 
     46        } 
     47    } (0, 1); 
     48 
     49} 
     50 
     51print "Benchmark test using $cache($volume) :", "\n"; 
     52 
     53AT_STARTUP_SCRIPT : 
     54{ 
     55    use Method::Cached::Manager -default => shift @default; 
     56    use Method::Cached2         -default => shift @default; 
     57} 
     58 
     59AT_PACKAGE : 
    2360{ 
    2461    package Dummy; 
    … …  
    2663    use Method::Cached; 
    2764    use Method::Cached2; 
    28     use Attribute::Memoize; 
    2965 
    3066    sub fib { 
    … …  
    3470    } 
    3571 
    36     sub fib_cache :Cached(5) { 
     72    sub fib_cache :Cached(3600) { 
    3773        my $n = shift; 
    3874        return $n if $n < 2; 
    … …  
    4076    } 
    4177 
    42     sub fib_cache2 :Cached2(5) { 
     78    sub fib_cache2 :Cached2(3600) { 
    4379        my $n = shift; 
    4480        return $n if $n < 2; 
    4581        fib_cache2($n - 1) + fib_cache2($n - 2); 
    4682    } 
    47  
    48     sub fib_memoize :Memoize { 
    49         my $n = shift; 
    50         return $n if $n < 2; 
    51         fib_memoize($n - 1) + fib_memoize($n - 2); 
    52     } 
    5383} 
    5484 
    55 package main; 
    56  
    57 use Benchmark qw/cmpthese/; 
    58  
    59 my $num = 13; 
    60  
    61 my ($fib, $c_fib, $c2_fib, $m_fib); 
    62  
    63 sub fib    { $fib    = $num; $fib    = Dummy::fib($fib)           } 
    64 sub c_fib  { $c_fib  = $num; $c_fib  = Dummy::fib_cache($c_fib)   } 
    65 sub c2_fib { $c2_fib = $num; $c2_fib = Dummy::fib_cache2($c2_fib) } 
    66 sub m_fib  { $m_fib  = $num; $m_fib  = Dummy::fib_memoize($m_fib) } 
    67  
    68 cmpthese(10000, { 
    69     'fib'     => \&fib, 
    70     'Cached'  => \&c_fib, 
    71     'Cached2' => \&c2_fib, 
    72     'Memoize' => \&m_fib, 
    73 }); 
     85AT_MAIN : 
     86{ 
     87    use Benchmark qw/cmpthese/; 
     88     
     89    my $num = 13; 
     90     
     91    my ($fib, $c_fib, $c2_fib); 
     92     
     93    sub fib    { $fib    = $num; $fib    = Dummy::fib($fib)           } 
     94    sub c_fib  { $c_fib  = $num; $c_fib  = Dummy::fib_cache($c_fib)   } 
     95    sub c2_fib { $c2_fib = $num; $c2_fib = Dummy::fib_cache2($c2_fib) } 
     96     
     97    cmpthese($volume, { 
     98        'fib'     => \&fib, 
     99        'Cached'  => \&c_fib, 
     100        'Cached2' => \&c2_fib, 
     101    }); 
     102}