Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
130 changes: 110 additions & 20 deletions lib/CHI.pm
Original file line number Diff line number Diff line change
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 @@ -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,6 +912,7 @@ e.g.

namespace
serializer
no_defaults_for

=back

Expand Down Expand Up @@ -1418,7 +1508,7 @@ 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.
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
Original file line number Diff line number Diff line change
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
Original file line number Diff line number Diff line change
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
Original file line number Diff line number Diff line change
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
Loading