File Coverage

blib/lib/DBIx/MoCo/Cache.pm

Criterion	Covered	Total	%
statement	17	23	73.9
branch	4	10	40.0
condition	1	3	33.3
subroutine	6	8	75.0
pod	0	6	0.0
total	28	50	56.0

package DBIx::MoCo::Cache;
use strict;
use warnings;

my $cache = {};
my $cache_created = time();
my $cache_expire = 600; # seconds

sub new { bless {}, shift }

sub set {
    my $self = shift;
    my ($k,$v) = @_;
    $cache->{$k} = $v if defined $k;
}

sub get {
    my $self = shift;
    my $k = shift or return;
    if (!$cache_created || ($cache_created + $cache_expire < time())) {
        $self->clear;
        #warn 'clear cache';
    }
    return $cache->{$k};
}

sub clear {
    $cache = {};
    $cache_created = time();
}

sub remove {
    my $self = shift;
    my $k = shift or return;
    #warn "remove cache $k";
    $cache->{$k} = undef;
}

sub cache_expire {
    my $class = shift;
    $cache_expire = $_[0] if $_[0];
    $cache_expire;
}

1;

=head1 NAME

DBIx::MoCo::Cache - Simple Cache for DBIx::MoCo

=head1 SYNOPSIS

  my $c = DBIx::MoCo::Cache->new;
  my $u = User->new(user_id => '123');
  my $oid = $u->object_id;
  $c->set($oid, $u);
  my $o = $c->get($oid); # $o is $u
  $c->remove($oid); # flush

=head1 SEE ALSO

L, L

=head1 AUTHOR

Junya Kondo, [e-mail]

=head1 COPYRIGHT AND LICENSE

Copyright (C) Hatena Inc. All Rights Reserved.

This library is free software; you may redistribute it and/or modify
it under the same terms as Perl itself.

=cut