File Coverage

blib/lib/CHI/Driver/Memory.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch	9	10	90.0
condition			n/a
subroutine	16	16	100.0
pod	0	9	0.0
total	74	84	88.1

package CHI::Driver::Memory;
$CHI::Driver::Memory::VERSION = '0.61';
use Carp qw(cluck croak);
use CHI::Constants qw(CHI_Meta_Namespace);
use Moo;
use MooX::Types::MooseLike::Base qw(:all);
use strict;
use warnings;

extends 'CHI::Driver';

our %Global_Datastore = ();    ## no critic (ProhibitPackageVars)

has 'datastore' => ( is => 'ro', isa => HashRef );
has 'global'    => ( is => 'ro', isa => Bool );

sub default_discard_policy { 'lru' }

# We see a lot of repeated '$self->{datastore}->{$self->{namespace}}'
# expressions below. The reason this cannot be easily memoized in the object
# is that we want the cache to be cleared across multiple existing CHI
# objects when the datastore itself is emptied - e.g. %datastore = ()
#

sub BUILD {
    my ( $self, $params ) = @_;

    if ( defined $self->{global} ) {
        croak "cannot specify both 'datastore' and 'global'"
          if ( defined( $self->{datastore} ) );
        $self->{datastore} = $self->{global} ? \%Global_Datastore : {};
    }
    if ( !defined( $self->{datastore} ) ) {
        cluck "must specify either 'datastore' hashref or 'global' flag";
        $self->{datastore} = \%Global_Datastore;
    }
}

sub fetch {
    my ( $self, $key ) = @_;

    if ( $self->{is_size_aware} ) {
        $self->{datastore}->{ CHI_Meta_Namespace() }->{last_used_time}->{$key}
          = time;
    }
    return $self->{datastore}->{ $self->{namespace} }->{$key};
}

sub store {
    my ( $self, $key, $data ) = @_;

    $self->{datastore}->{ $self->{namespace} }->{$key} = $data;
}

sub remove {
    my ( $self, $key ) = @_;

    delete $self->{datastore}->{ $self->{namespace} }->{$key};
    delete $self->{datastore}->{ CHI_Meta_Namespace() }->{last_used_time}
      ->{$key};
}

sub clear {
    my ($self) = @_;

    $self->{datastore}->{ $self->{namespace} } = {};
}

sub get_keys {
    my ($self) = @_;

    return keys( %{ $self->{datastore}->{ $self->{namespace} } } );
}

sub get_namespaces {
    my ($self) = @_;

    return keys( %{ $self->{datastore} } );
}

sub discard_policy_lru {
    my ($self) = @_;

    my $last_used_time =
      $self->{datastore}->{ CHI_Meta_Namespace() }->{last_used_time};
    my @keys_in_lru_order =
      sort { $last_used_time->{$a} <=> $last_used_time->{$b} } $self->get_keys;
    return sub {
        shift(@keys_in_lru_order);
    };
}

1;

__END__