Skip to content

Commit

Permalink
fix: avoid infinite recursion on default subcaches
Browse files Browse the repository at this point in the history 
by adding the `no_defaults_for` constructor attribute, which (a) permits
specifying a list of keys to delete from the `defaults`, `namespace`,
and `storage` hashrefs prior to instantiating a CHI subclass instance,
and (b) mandatorily contains the keys `l1_cache` and `mirror_cache`.
  • Loading branch information
@tomeon
Matt Schreiber authored and tomeon committed Apr 21, 2024
1 parent 4e59ee1 commit 888f12d
Show file tree
Hide file tree
Showing 6 changed files with 243 additions and 29 deletions.
140 changes: 118 additions & 22 deletions lib/CHI.pm
View file
Expand Up @@ -6,6 +6,7 @@ use CHI::Stats;
use String::RewritePrefix;
use Module::Runtime qw(require_module);
use Moo::Role ();
use Hash::MoreUtils qw(slice_grep);
use strict;
use warnings;

Expand Down Expand Up @@ -36,6 +37,81 @@ sub _set_config {
*{"$class\::_get_config"} = sub { $config };
}

sub _defaults {
my ( $class, $params, $config ) = @_;

$params ||= {};
$config ||= $class->config || {};

my $no_defaults_for;
if ( my $reftype = ref( $no_defaults_for = $params->{no_defaults_for} ) ) {
croak "'no_defaults_for' must be an array reference or string"
unless $reftype eq 'ARRAY';
}
else {
$no_defaults_for = [ $no_defaults_for || () ];
}

# Create a hash that maps top-level constructor keys to '1' for each
# attribute that should not have a default value loaded from core,
# namespace, or storage defaults.
#
my %no_defaults_for_map = map { $_ => 1 } @$no_defaults_for;

# Returns a hash reference containing each key => value pair from the
# provided hash reference for which '$no_defaults_for{$key}' does not
# evaluate to '1'.
#
my $filter_default_values = sub {
return {} unless defined $_[0];
return { slice_grep { !$no_defaults_for_map{$_} } $_[0] };
};

# Takes a key into the '$params' hash reference and an optional default
# value in case '$params' does not contain the provided key. Looks up the
# resolved key in the '$config' hash reference, returning a hash reference
# containing all key => value pairs for which '$no_defaults_for{$key}'
# does not evaluate to '1'. If the provided key cannot be found in
# '$params' and the default value is undefined, returns an empty hash
# reference.
#
# For example:
#
# $params = {namespace => 'Foo'};
# $config = {namespace => {Foo => {storage => 'File'}
# $no_defaults_for => ['label'];
# $defaults = $extract_defaults->('namespace', 'Default');
# # $defaults == {storage => 'File'}
#
my $extract_defaults = sub {
my ( $key, $fallback ) = @_;

my $found = $params->{$key};
$found ||= $fallback unless $no_defaults_for_map{$key};

return {} unless defined $found;

return $filter_default_values->( $config->{$key}{$found} );
};

my $core_defaults = $filter_default_values->( $config->{defaults} );

my $namespace_defaults = $extract_defaults->( 'namespace', 'Default' );

my $storage_defaults = $extract_defaults->(
'storage', $namespace_defaults->{storage} || $core_defaults->{storage},
);

return ( $core_defaults, $storage_defaults, $namespace_defaults );
}

# Merges the hash references returned by '_defaults', preferring namespace
# defaults to storage defaults and storage defaults to core defaults.
#
sub defaults {
return { map { %$_ } &_defaults };
}

BEGIN { __PACKAGE__->config( {} ) }

sub memoized_cache_objects {
Expand Down Expand Up @@ -80,25 +156,15 @@ sub new {
}
}

# Gather defaults
# Combine passed-in arguments with defaults
#
my $core_defaults = $config->{defaults} || {};
my $namespace_defaults =
$config->{namespace}->{ $params{namespace} || 'Default' } || {};
my $storage =
$params{storage}
|| $namespace_defaults->{storage}
|| $core_defaults->{storage};
my $storage_defaults = {};
if ( defined($storage) ) {
$storage_defaults = $config->{storage}->{$storage}
or croak "no config for storage type '$storage'";
}
my $defaults = $chi_root_class->defaults( \%params, $config );
%params = ( %$defaults, %params );

# Combine passed params with defaults
#
%params =
( %$core_defaults, %$storage_defaults, %$namespace_defaults, %params );
my $storage = $params{storage};
if ( defined $storage && !exists $config->{storage}{$storage} ) {
croak "no config for storage type '$storage'";
}

# Get driver class from driver or driver_class parameters
#
Expand Down Expand Up @@ -151,7 +217,7 @@ sub new {
my $cache_object = $final_class->new(
chi_root_class => $chi_root_class,
driver_class => $driver_class,
%params
%params,
);

# Memoize if appropriate
Expand Down Expand Up @@ -200,7 +266,7 @@ CHI - Unified cache handling interface
);
# Create your own driver
#
#
my $cache = CHI->new( driver => '+My::Special::Driver', ... );
# Cache operations
Expand Down Expand Up @@ -455,7 +521,30 @@ C<CHI::Driver::Role::> unless preceded with a '+'. e.g.
traits => ['StoresAccessedAt', '+My::CHI::Driver::Role']
=back
=item no_defaults_for [LISTREF]
List of one or more default settings (see L</SUBCLASSING AND CONFIGURING CHI>)
to ignore when instantiating the object.
My::CHI->config({
storage => {
local_file => { driver => 'File', root_dir => '/my/root' },
},
defaults => {
storage => 'local_file',
label => 'static-assets',
},
});
My::CHI->new->label; # "static-assets"
My::CHI->new( no_defaults_for => ['label'] )->label; # "File"
Duplicate values are removed upon assignment:
my $cache = My::CHI->new(no_defaults_for => [qw(storage storage storage)])
$cache->no_defaults_for; # ["storage"]
=back
=head1 INSTANCE METHODS
Expand Down Expand Up @@ -823,7 +912,14 @@ e.g.
namespace
serializer
<<<<<<< HEAD
||||||| parent of 81a591b (Add `no_defaults_for' attribute)
=======
no_defaults_for
>>>>>>> 81a591b (Add `no_defaults_for' attribute)
=back
=head2 Deprecated methods
Expand Down Expand Up @@ -1418,8 +1514,8 @@ from the logs and report a summary. See L<CHI::Stats|CHI::Stats> for details.
CHI is intended as an evolution of DeWitt Clinton's
L<Cache::Cache|Cache::Cache> package. It starts with the same basic API (which
has proven durable over time) but addresses some implementation shortcomings
that cannot be fixed in Cache::Cache due to backward compatibility concerns.
In particular:
that cannot be fixed in Cache::Cache due to backward compatibility concerns. In
particular:
=over
Expand Down
5 changes: 5 additions & 0 deletions lib/CHI/Driver.pm
View file
Expand Up @@ -139,6 +139,11 @@ my @common_params;
storage => {
is => 'ro',
},
no_defaults_for => {
is => 'ro',
isa => ArrayRef [Str],
coerce => \&to_UniqArrayRef,
},
);
push @common_params, keys %attr;
for my $attr ( keys %attr ) {
Expand Down
20 changes: 15 additions & 5 deletions lib/CHI/Driver/Role/HasSubcaches.pm
View file
Expand Up @@ -3,7 +3,6 @@ package CHI::Driver::Role::HasSubcaches;
use Moo::Role;
use CHI::Types qw(:all);
use MooX::Types::MooseLike::Base qw(:all);
use Hash::MoreUtils qw(slice_exists);
use Log::Any qw($log);
use Scalar::Util qw(weaken);
use strict;
Expand Down Expand Up @@ -31,7 +30,10 @@ sub _non_overridable {
my @subcache_inherited_params = (
qw(expires_at expires_in expires_variance namespace on_get_error on_set_error serializer)
);
for my $type (qw(l1_cache mirror_cache)) {

my @subcache_types = qw(l1_cache mirror_cache);

for my $type (@subcache_types) {
my $config_acc = "_${type}_config";
has $config_acc => (
is => 'ro',
Expand All @@ -46,13 +48,21 @@ for my $type (qw(l1_cache mirror_cache)) {

my %inherit = map { ( defined $self->$_ ) ? ( $_ => $self->$_ ) : () }
@subcache_inherited_params;

# Don't instantiate the subcache with another subcache that's defined
# using the core, namespace or storage defaults.
#
my @no_defaults_for = @{ $self->no_defaults_for || [] };
push @no_defaults_for, @subcache_types;

my $build_config = {
%inherit,
label => $self->label . ":$type",
%$config,
is_subcache => 1,
parent_cache => $self,
subcache_type => $type,
is_subcache => 1,
parent_cache => $self,
subcache_type => $type,
no_defaults_for => \@no_defaults_for,
};

return $self->chi_root_class->new(%$build_config);
Expand Down
20 changes: 20 additions & 0 deletions lib/CHI/Types.pm
View file
Expand Up @@ -2,6 +2,7 @@ package CHI::Types;

use Carp;
use CHI::Util qw(can_load parse_duration parse_memory_size);
use List::MoreUtils qw(uniq);
use MooX::Types::MooseLike qw(exception_message);
use MooX::Types::MooseLike::Base qw(:all);
use MooX::Types::MooseLike::Numeric qw(:all);
Expand Down Expand Up @@ -125,6 +126,25 @@ sub to_Digester {
}
push @EXPORT_OK, 'to_Digester';

# Strip duplicates from an array reference. Also accepts a single string.
# Passes through any values other than array references so that they can be
# caught by 'isa' constraints.
#
sub to_UniqArrayRef {
my $from = shift;

if ( is_ArrayRef($from) ) {
[ uniq @$from ];
}
elsif ( is_Str($from) ) {
[$from];
}
else {
return $from;
}
}
push @EXPORT_OK, 'to_UniqArrayRef';

my $data_serializer_loaded = can_load('Data::Serializer');

sub _build_data_serializer {
Expand Down

0 comments on commit 888f12d

Please sign in to comment.