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__ =pod =head1 NAME CHI::Driver::Memory - In-process memory based cache =head1 VERSION version 0.61 =head1 SYNOPSIS use CHI; my $hash = {}; my $cache = CHI->new( driver => 'Memory', datastore => $hash ); my $cache = CHI->new( driver => 'Memory', global => 1 ); my $cache = CHI->new( driver => 'Memory', global => 0 ); =head1 DESCRIPTION This cache driver stores data on a per-process basis. This is the fastest of the cache implementations, but data can not be shared between processes. Data will remain in the cache until cleared, expired, or the process dies. To maintain the same semantics as other caches, references to data structures are deep-copied on set and get. Thus, modifications to the original data structure will not affect the data structure stored in the cache, and vice versa. See L for a faster memory cache that sacrifices this behavior. =head1 CONSTRUCTOR OPTIONS When using this driver, the following options can be passed to CHI->new() in addition to the L. One of I or I must be specified, or else a warning (possibly an error eventually) will be thrown. =over =item datastore [HASHREF] A reference to a hash to be used for storage. Within the hash, each namespace is used as a key to a second-level hash. This hash may be passed to multiple CHI::Driver::Memory constructors. =item global [BOOL] Use a standard global datastore. Multiple caches created with this set to true will see the same data. Before 0.21, this was the default behavior; now it must be specified explicitly (to avoid accidentally sharing the same datastore in unrelated code). If this is set to false then datastore will be set to a new reference to a hash. =back =head1 DISCARD POLICY For L caches, this driver implements an 'LRU' policy, which discards the least recently used items first. This is the default policy. =head1 SEE ALSO L, L =head1 AUTHOR Jonathan Swartz =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2021 by Jonathan Swartz. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut