view release on metacpan or  search on metacpan

erecipes/perl/lib/CGI/Ex/Recipes/Cache.pm  view on Meta::CPAN

    0;
}

sub get {
    my ($self,$key) = @_;
    #dex_trace(); #debug $self;
    if(exists $self->{cache_hash}{$key}) {
        return $self->{cache_hash}{$key}{value};
    }
    #warn 'getting $key'.$key.' from database';
    my $row = $self->{dbh}->selectrow_hashref('SELECT * FROM cache WHERE id=?',{},$key) 
        || return undef;
    $self->{cache_hash}{$key} = $row;
    if($self->{cache_hash}{$key}{expires} < time ){
        #warn 'could not $key'.$key.' from database. data expired.';
        return undef;
    }
    return $self->{cache_hash}{$key}{value};
}

sub set {
    if (!$_[2]) { 
        croak 'Please provide a value to be set!';
    }
    #NOTE: compatible only with SQLITE and MySQL
    $_[0]->{dbh}->prepare(
        'REPLACE INTO `cache` (id, value, tstamp, expires) VALUES ( ?,?,?,? )'
    )->execute( $_[1], $_[2], time, ($_[3]?time+$_[3]:$_[0]->{expires}) );
}

sub clear {
    $_[0]->{cache_hash} = {};
    $_[0]->{dbh}->do('DELETE FROM `cache`')
        and $_[0]->{dbh}->do('VACUUM');

}

sub freeze {
    $_[0]->set( 
        $_[1], 
        ref $_[2] ? Storable::nfreeze($_[2]) : $_[2], 
        $_[3] || $_[0]->{expires},
    );
}

sub thaw {
    Storable::thaw( $_[0]->get($_[1]) ) ;
}


1;

__END__

=head1 NAME

CGI::Ex::Recipes::Cache - Naive caching in a database table

=head1 SYNOPSIS

Example from C<CGI::Ex::Recipes::Template::Menu::list_item()>:

    # ... somewhere at the beginning of a method/subroutine which does heavy computations
    if( $out = $app->cache->get($cache_key) ){ return $out; }
    # ... here are your heavy calculations spread accross many lines
    # making database calls generating HTML etc.
    # ... just before the return of the method
    #try cache support
    $app->cache->set($cache_key, $out);
    return $out;

=head1 DESCRIPTION

I found that when I cached in memory some output from CGI::Ex::Recipes::Template::Menu,
the performance under mod_perl jumped from: 

    ...
    Requests per second:    19.42 [#/sec] (mean)
    Time per request:       154.441 [ms] (mean)
    Time per request:       51.480 [ms] (mean, across all concurrent requests)
    Transfer rate:          67.73 [Kbytes/sec] received

to

    ...
    Requests per second:    42.99 [#/sec] (mean)
    Time per request:       69.792 [ms] (mean)
    Time per request:       23.264 [ms] (mean, across all concurrent requests)
    Transfer rate:          151.74 [Kbytes/sec] received

ApacheBench was invoked like this:

    berov@berovi:~> /opt/apache2/bin/ab -c3  -n300 http://localhost:8081/recipes/index.pl

Of cource this is copied and pasted from my shell. Your results will be different.

I searched CPAN and after realizing that there are too many alternatives I
decided to have some fun and write another one -- simple, stupid and naive.

After implementing my naive caching in a database table I have the following results:

    ...
    Requests per second:    58.35 [#/sec] (mean)
    Time per request:       51.418 [ms] (mean)
    Time per request:       17.139 [ms] (mean, across all concurrent requests)
    Transfer rate:          206.74 [Kbytes/sec] received

Not bad, I would say.

NOTE: 

    This module is not necessarily compatible with the L<Cache|Cache> interface nor near complete.

=head1 METHODS

head2 new

The constructor.

    our $cache_obj = CGI::Ex::Recipes::Cache->new(
        {cache_hash =>\%CACHE_HASH, dbh=>$dbh , expires =>3600*24 }
    );
    Arguments(a hashref):
        cache_hash: Applicaton-wide HASH reference.
                    useful only under mod_perl.
        dbh:        A DBI object.
        expires:    Default expiration for cache entries. Default:time + 3600(one hour)
    Returns:    $self - The cache object used in CGI::Ex::Recipes

=head2 exists

    my $bool = $cache->exists('somekey');

Checks for existence of a given key in C<$self-E<gt>{cache_hash}>.