lib/Class/Simple/Cached.pm

Structural Coverage (Approximate)

TER1 (Statement): 100.00%
TER2 (Branch): 96.67%
TER3 (LCSAJ): 100.0% (9/9)
Approximate LCSAJ segments: 61

LCSAJ Legend

● Covered — this LCSAJ path was executed during testing.

● Not covered — this LCSAJ path was never executed. These are the paths to focus on.

Multiple dots on a line indicate that multiple control-flow paths begin at that line. Hovering over any dot shows:

        start → end → jump

start – first line of the linear sequence
end – last line before control flow changes
jump – line execution jumps to next

Uncovered paths show [NOT COVERED] in the tooltip.

Mutant Testing Legend

Survived (tests missed this) Killed (tests detected this) No mutation

1: package Class::Simple::Cached; 2: 3: use strict; 4: use warnings; 5: use autodie qw(:all); 6: 7: use Carp (); 8: use Class::Simple; 9: use Params::Get 0.15; 10: use Scalar::Util (); 11: use Sub::Protected; 12: 13: # Stored in the cache to distinguish "the object returned undef" from 14: # "this key has never been cached". Must never be a legitimate return value. 15: use constant UNDEF_SENTINEL => __PACKAGE__ . '>UNDEF<'; 16: 17: # Evaluated once at compile time so DESTROY never pays a string comparison 18: # on every object teardown just to decide whether ${^GLOBAL_PHASE} exists. 19: use constant _GLOBAL_PHASE_AVAILABLE => defined($^V) && ($^V ge 'v5.14.0'); 20: 21: =head1 NAME 22: 23: Class::Simple::Cached - cache getter results for any get/set object 24: 25: =head1 VERSION 26: 27: Version 0.06 28: 29: =cut 30: 31: our $VERSION = '0.06'; 32: 33: =encoding UTF-8 34: 35: =head1 SYNOPSIS 36: 37: use CHI; 38: use Class::Simple::Cached; 39: 40: # Wrap an existing object with a cache layer 41: my $cache = CHI->new(driver => 'RawMemory', global => 1); 42: my $obj = Class::Simple::Cached->new( 43: cache => $cache, 44: object => My::Expensive::Object->new(), 45: ); 46: 47: $obj->name('Alice'); # setter: delegates to wrapped object, updates cache 48: my $n = $obj->name(); # getter: returns cached 'Alice' without hitting object 49: 50: # Or use a plain hash ref as the cache backend 51: my %store; 52: my $simple = Class::Simple::Cached->new(cache => \%store); 53: $simple->colour('blue'); 54: print $simple->colour(); # 'blue', served from %store 55: 56: =head1 DESCRIPTION 57: 58: A subclass of L<Class::Simple> that transparently caches the return values of 59: getter calls, so that repeated reads of expensive-to-compute or 60: expensive-to-transport values hit the cache instead of the wrapped object. 61: 62: Cache coherency is I<not> automatic. If the wrapped object's state changes 63: through a path other than the cached wrapper, callers must invalidate the cache 64: themselves. 65: 66: =head1 SUBROUTINES/METHODS 67: 68: =head2 new 69: 70: Constructs a C<Class::Simple::Cached> instance that wraps C<object> behind 71: C<cache>. 72: 73: =head3 ARGUMENTS 74: 75: =over 4 76: 77: =item C<cache> (mandatory) 78: 79: Either a blessed object implementing C<get($key)>, C<set($key, $val, $expires)>, 80: and C<purge()> (e.g. any L<CHI> driver); or a plain hash reference used as an 81: in-process store. 82: 83: =item C<object> (optional) 84: 85: The object whose methods will be proxied and cached. Defaults to a fresh 86: C<Class::Simple> instance. 87: 88: =back 89: 90: Calling C<< ->new() >> on an already-blessed instance returns a shallow clone 91: (all stored fields are merged, including the existing cache handle). 92: 93: =head3 RETURNS 94: 95: A blessed C<Class::Simple::Cached> instance. 96: 97: =head3 SIDE EFFECTS 98: 99: None beyond allocating the new instance. 100: 101: =head3 EXAMPLE 102: 103: # CHI-backed cache 104: use CHI; 105: my $obj = Class::Simple::Cached->new( 106: cache => CHI->new(driver => 'RawMemory', global => 1), 107: object => My::Model->new(), 108: ); 109: 110: # Hash-ref cache (useful for tests or short-lived objects) 111: my $obj = Class::Simple::Cached->new(cache => {}); 112: 113: # Clone an existing wrapped object 114: my $clone = $obj->new(); 115: 116: =head3 API SPECIFICATION 117: 118: Input: 119: cache => HashRef | CHICompatibleObject # required 120: object => Object # optional 121: 122: Output: 123: Class::Simple::Cached instance 124: 125: =head3 MESSAGES 126: 127: Message Meaning Resolution 128: --------------------------------------------------- ----------------------------------- ---------------------------------------- 129: "use ->new() not ::new() to instantiate" Called as Class::Simple::Cached::new Use $obj->new() or ClassName->new() 130: "Usage: $class->new(cache => \$cache)" No arguments supplied Pass at least cache => ... 131: "Cache must be ref to HASH or object" cache is a plain scalar or wrong ref Use a hashref or CHI-compatible object 132: "Cache object must implement get, set, purge" Blessed cache lacks required methods Use a fully CHI-compatible object 133: 134: =head3 PSEUDOCODE 135: 136: new(class, args): 137: IF class undefined â†’ carp and return undef 138: IF class is blessed â†’ merge fields, return shallow clone 139: IF no args â†’ croak Usage message 140: PARSE args into hashref via Params::Get 141: IF params.object absent â†’ params.object = Class::Simple->new() 142: IF params.cache is a blessed object: 143: VERIFY it can('get') AND can('set') AND can('purge') 144: IF not â†’ croak capability message 145: RETURN bless params, class 146: IF params.cache is a HASH ref: 147: RETURN bless params, class 148: croak "Cache must be ref to HASH or object" 149: 150: =cut 151: 152: sub new 153: { ●154 → 157 → 163 154: my $class = shift; 155: 156: # Guard: always call as a method, not a bare function

Mutants (Total: 1, Killed: 1, Survived: 0)

158: Carp::carp(__PACKAGE__, ' use ->new() not ::new() to instantiate'); 159: return; 160: } 161: 162: # When called on a blessed instance, return a shallow clone ●163 → 163 → 192 163: if(Scalar::Util::blessed($class)) {

Mutants (Total: 1, Killed: 1, Survived: 0)

164: my $params = Params::Get::get_params(undef, \@_) || {}; 165: my %merged = (%{$class}, %{$params}); 166: # Always recalculate internal dispatch fields after the merge so that 167: # caller-supplied _is_hash_cache or _cache_prefix args cannot corrupt 168: # the cache-type flag or the key-prefix (internal field injection). 169: $merged{'_is_hash_cache'} = ref($merged{'cache'}) eq 'HASH'; 170: $merged{'_cache_prefix'} = ref($class) . ':'; 171: