А сам CHI?

package CHI; $CHI::VERSION = '0.61'; use 5.006; use Carp; use CHI::Stats; use String::RewritePrefix; use Module::Runtime qw(require_module); use Moo::Role (); use strict; use warnings; my ( %final_class_seen, %memoized_cache_objects, %stats ); my %valid_config_keys = map { ( $_, 1 ) } qw(defaults memoize_cache_objects namespace storage); sub logger { warn "CHI now uses Log::Any for logging - see Log::Any documentation for details"; } sub config { my $class = shift; $class->_set_config(@_) if @_; return $class->_get_config(); } sub _set_config { my ( $class, $config ) = @_; if ( my @bad_keys = grep { !$valid_config_keys{$_} } keys(%$config) ) { croak "unknown keys in config hash: " . join( ", ", @bad_keys ); } # set class specific configuration no strict 'refs'; no warnings 'redefine'; *{"$class\::_get_config"} = sub { $config }; } BEGIN { __PACKAGE__->config( {} ) } sub memoized_cache_objects { my ($class) = @_; # Each CHI root class gets its hash of memoized objects # $memoized_cache_objects{$class} ||= {}; return $memoized_cache_objects{$class}; } sub clear_memoized_cache_objects { my ($class) = @_; $memoized_cache_objects{$class} = {}; } sub stats { my ($class) = @_; # Each CHI root class gets its own stats object # $stats{$class} ||= CHI::Stats->new( chi_root_class => $class ); return $stats{$class}; } sub new { my ( $chi_root_class, %params ) = @_; my $config = $chi_root_class->config; # Cache object memoization: See if cache object with these parameters # has already been created, and return it if so. Only for parameters # with 0 or 1 keys. # my ( $cache_object_key, $cache_objects ); if ( $config->{memoize_cache_objects} && keys(%params) <= 1 ) { $cache_object_key = join chr(28), %params; $cache_objects = $chi_root_class->memoized_cache_objects; if ( my $cache_object = $cache_objects->{$cache_object_key} ) { return $cache_object; } } # Gather 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'"; } # Combine passed params with defaults # %params = ( %$core_defaults, %$storage_defaults, %$namespace_defaults, %params ); # Get driver class from driver or driver_class parameters # my $driver_class; if ( my $driver = delete( $params{driver} ) ) { ($driver_class) = String::RewritePrefix->rewrite( { '' => 'CHI::Driver::', '+' => '' }, $driver ); } else { $driver_class = delete( $params{driver_class} ); } croak "missing required param 'driver' or 'driver_class'" unless defined $driver_class; # Load driver class if it hasn't been loaded or defined in-line already # unless ( $driver_class->can('fetch') ) { require_module($driver_class); } # Select roles depending on presence of certain arguments. Everyone gets # the Universal role. Accept both 'roles' and 'traits' for backwards # compatibility. Add CHI::Driver::Role:: unless prefixed with '+'. # my @roles = ('Universal'); foreach my $param_name (qw(roles traits)) { if ( exists( $params{$param_name} ) ) { push( @roles, @{ delete( $params{$param_name} ) } ); } } if ( exists( $params{max_size} ) || exists( $params{is_size_aware} ) ) { push( @roles, 'IsSizeAware' ); } if ( exists( $params{l1_cache} ) || exists( $params{mirror_cache} ) ) { push( @roles, 'HasSubcaches' ); } if ( $params{is_subcache} ) {

push( @roles, 'IsSubcache' ); } @roles = String::RewritePrefix->rewrite( { '' => 'CHI::Driver::Role::', '+' => '' }, @roles ); # Select a final class based on the driver class and roles, creating it # if necessary - adapted from MooseX::Traits # my $final_class = Moo::Role->create_class_with_roles( $driver_class, @roles ); my $cache_object = $final_class->new( chi_root_class => $chi_root_class, driver_class => $driver_class, %params ); # Memoize if appropriate # if ($cache_object_key) { $cache_objects->{$cache_object_key} = $cache_object; } return $cache_object; } 1; CHI

Но там всё в CHI::Driver::File