CHI

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN


* Improvements
  - Add CHI->config() to register storage types, and set core and per-namespace defaults

* Fixes
  - Fix new test_max_key_length test to work on drivers that do not support get_keys

0.50  Nov 30, 2011

* Docs
  - Clarify busy_lock doc, add obj_ref doc (perlover)

* Fixes
  - Override set() rather than set_object() in Role/HasSubcaches.pm so that
    keys are not double-transformed when set in l1 or mirror caches. This is
    simpler and should be more robust.
  - Remove htdocs which were accidentally added into dist

0.49  Jun 23, 2011

* Fixes
  - Go back to generating version numbers for all sub-modules again

0.48  Jun 15, 2011

* Fixes
  - Disregard default expires_at and expires_in if either are provided - RT #67970 (spjw)

0.47  Apr 28, 2011

* Improvements
  - Allow compute() to take get options - expire_if and busy_lock
  - Add atomic operations: add, append, replace (alpha)

0.46  Apr 22, 2011

* Other
  - Only generate version numbers for .pm files with documentation, to reduce inter-version churn

0.45  Apr 18, 2011

* Improvements

lib/CHI.pm  view on Meta::CPAN

=item *

Automatic serialization of keys and values

=item *

Multilevel caches

=item *

Probabilistic expiration and busy locks, to reduce cache miss stampedes

=item *

Optional logging and statistics collection of cache activity

=back

=for readme stop

=head1 CONSTRUCTOR

lib/CHI.pm  view on Meta::CPAN

=item expire_if [CODEREF]

If I<$key> exists and has not expired, call code reference with the
L<CHI::CacheObject|CHI::CacheObject> and L<CHI::Driver|CHI::Driver> as the
parameters. If code returns a true value, C<get> returns undef as if the item
were expired. For example, to treat the cache as expired if I<$file> has
changed since the value was computed:

    $cache->get('foo', expire_if => sub { $_[0]->created_at < (stat($file))[9] });

=item busy_lock [DURATION]

If the value has expired, the get will still return undef, but the expiration
time of the cache entry will be set to the current time plus the specified
L<duration|/DURATION EXPRESSIONS>.  This is used to prevent multiple processes
from recomputing the same expensive value simultaneously. The problem with this
technique is that it doubles the number of writes performed - see
L</expires_variance> for another technique.

=item obj_ref [SCALARREF]

lib/CHI/Driver.pm  view on Meta::CPAN

          sub { croak "method '$method' not supported by '$class'" };
    }
}

sub cache_object_class { 'CHI::CacheObject' }

# To override time() for testing - must be writable in a dynamically scoped way from tests
our $Test_Time;    ## no critic (ProhibitPackageVars)
our $Build_Depth = 0;    ## no critic (ProhibitPackageVars)

sub valid_get_options { qw(expire_if busy_lock) }
sub valid_set_options { qw(expires_at expires_in expires_variance) }

sub BUILD {
    my ( $self, $params ) = @_;

    # Ward off infinite build recursion, e.g. from circular subcache configuration.
    #
    local $Build_Depth = $Build_Depth + 1;
    die "$Build_Depth levels of CHI cache creation; infinite recursion?"
      if ( $Build_Depth > $self->max_build_depth );

lib/CHI/Driver.pm  view on Meta::CPAN

    #
    my $is_expired = $obj->is_expired()
      || ( defined( $params{expire_if} )
        && $params{expire_if}->( $obj, $self ) );
    if ($is_expired) {
        $self->_record_get_stats( 'expired_misses', $elapsed_time )
          if defined($ns_stats);
        $self->_log_get_result( $log, "MISS (expired)", $key, $elapsed_time )
          if $log_is_debug;

        # If busy_lock value provided, set a new "temporary" expiration time that many
        # seconds forward before returning undef
        #
        if ( defined( my $busy_lock = $params{busy_lock} ) ) {
            my $time = $Test_Time || time();
            my $busy_lock_time = $time + parse_duration($busy_lock);
            $obj->set_early_expires_at($busy_lock_time);
            $obj->set_expires_at($busy_lock_time);
            $self->set_object( $key, $obj );
        }

        return undef;
    }

    $self->_record_get_stats( 'hits', $elapsed_time ) if defined($ns_stats);
    $self->_log_get_result( $log, "HIT", $key, $elapsed_time ) if $log_is_debug;
    return $obj->value;
}

lib/CHI/Driver.pm  view on Meta::CPAN

    my $wantarray = wantarray();

    # Allow these in either order for backward compatibility
    my ( $code, $options ) =
      ( ref( $_[0] ) eq 'CODE' ) ? ( $_[0], $_[1] ) : ( $_[1], $_[0] );

    croak "must specify key and code" unless defined($key) && defined($code);

    my %get_options =
      ( ref($options) eq 'HASH' )
      ? slice_grep { /(?:expire_if|busy_lock)/ } $options
      : ();
    my $set_options =
        ( ref($options) eq 'HASH' )
      ? { slice_grep { !/(?:expire_if|busy_lock)/ } $options }
      : $options;

    my $value = $self->get( $key, %get_options );
    if ( !defined $value ) {
        my ( $start_time, $elapsed_time );
        my $ns_stats = $self->{ns_stats};
        $start_time = gettimeofday if defined($ns_stats);
        $value = $wantarray ? [ $code->() ] : $code->();
        $elapsed_time = ( gettimeofday() - $start_time ) * 1000
          if defined($ns_stats);

lib/CHI/t/Driver.pm  view on Meta::CPAN


    my $margin = int( $expected * 0.1 );
    if ( abs( $value - $expected ) <= $margin ) {
        pass($msg);
    }
    else {
        fail("$msg - got $value, expected $expected");
    }
}

sub test_busy_lock : Tests {
    my $self  = shift;
    my $cache = $self->{cache};

    my ( $key, $value ) = $self->kvpair();
    my @bl = ( busy_lock => '30 sec' );
    my $start_time = time();

    local $CHI::Driver::Test_Time = $start_time;
    $cache->set( $key, $value, 100 );
    local $CHI::Driver::Test_Time = $start_time + 90;
    is( $cache->get( $key, @bl ), $value, "hit before expiration" );
    is(
        $cache->get_expires_at($key),
        $start_time + 100,
        "expires_at before expiration"
    );
    local $CHI::Driver::Test_Time = $start_time + 110;
    ok( !defined( $cache->get( $key, @bl ) ), "miss after expiration" );
    is(
        $cache->get_expires_at($key),
        $start_time + 140,
        "expires_at after busy lock"
    );
    is( $cache->get( $key, @bl ), $value, "hit after busy lock" );
}

sub test_obj_ref : Tests {
    my $self = shift;

    # Make sure obj_ref works in conjunction with subcaches too
    my $cache =
      $self->new_cache( l1_cache => { driver => 'Memory', datastore => {} } );
    my $obj;
    my ( $key, $value ) = ( 'medium', [ a => 5, b => 6 ] );



( run in 0.269 second using v1.01-cache-2.11-cpan-87723dcf8b7 )