view release on metacpan or  search on metacpan

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

package CHI::Memoize;
$CHI::Memoize::VERSION = '0.07';
use Carp;
use CHI;
use CHI::Memoize::Info;
use CHI::Driver;
use Hash::MoreUtils qw(slice_grep);
use strict;
use warnings;
use base qw(Exporter);

my $no_memoize = {};
sub NO_MEMOIZE { $no_memoize }

our @EXPORT      = qw(memoize);
our @EXPORT_OK   = qw(memoize memoized unmemoize NO_MEMOIZE);
our %EXPORT_TAGS = ( all => \@EXPORT_OK );

my %memoized;
my @get_set_options = qw( busy_lock expire_if expires_at expires_in expires_variance );
my %is_get_set_option = map { ( $_, 1 ) } @get_set_options;

sub memoize {
    my ( $func, %options ) = @_;

    my ( $func_name, $func_ref, $func_id ) = _parse_func_arg( $func, scalar(caller) );
    croak "'$func_id' is already memoized" if exists( $memoized{$func_id} );

    my $passed_key      = delete( $options{key} );
    my $cache           = delete( $options{cache} );
    my %compute_options = slice_grep { $is_get_set_option{$_} } \%options;
    my $prefix          = "memoize::$func_id";

    if ( !$cache ) {
        my %cache_options = slice_grep { !$is_get_set_option{$_} } \%options;
        $cache_options{namespace} ||= $prefix;
        if ( !$cache_options{driver} && !$cache_options{driver_class} ) {
            $cache_options{driver} = "Memory";
        }
        if ( $cache_options{driver} eq 'Memory' || $cache_options{driver} eq 'RawMemory' ) {
            $cache_options{global} = 1;
        }
        $cache = CHI->new(%cache_options);
    }

    my $wrapper = sub {
        my $wantarray = wantarray ? 'L' : 'S';
        my @key_parts =
          defined($passed_key)
          ? ( ( ref($passed_key) eq 'CODE' ) ? $passed_key->(@_) : ($passed_key) )
          : @_;
        if ( @key_parts == 1 && ( $key_parts[0] || 0 ) eq NO_MEMOIZE ) {
            return $func_ref->(@_);
        }
        else {
            my $key = [ $prefix, $wantarray, @key_parts ];
            my $args = \@_;
            return $cache->compute( $key, {%compute_options}, sub { $func_ref->(@$args) } );
        }
    };
    $memoized{$func_id} = CHI::Memoize::Info->new(
        orig       => $func_ref,
        wrapper    => $wrapper,
        cache      => $cache,
        key_prefix => $prefix
    );

    no strict 'refs';
    no warnings 'redefine';
    *{$func_name} = $wrapper if $func_name;

    return $wrapper;
}

sub memoized {
    my ( $func_name, $func_ref, $func_id ) = _parse_func_arg( $_[0], scalar(caller) );
    return $memoized{$func_id};
}

sub unmemoize {

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

    # The CHI cache where memoize results are stored
    #
    my $cache = memoized($func)->cache;
    $cache->clear;

    # Code references to the original function and to the new wrapped function
    #
    my $orig = memoized($func)->orig;
    my $wrapped = memoized($func)->wrapped;

=item unmemoize ($func)

Removes the wrapper around I<$func>, restoring it to its original unmemoized
state.  Also clears the memoize cache if possible (not supported by all
drivers, particularly L<memcached|CHI::Driver::Memcached>). Throws an error if
I<$func> has not been memoized.

    memoize('Some::Package::func');
    ...
    unmemoize('Some::Package::func');

=back

=head2 OPTIONS

The following options can be passed to L</memoize>.

=over

=item key

Specifies a code reference that takes arguments passed to the function and
returns a cache key. The key may be returned as a list, list reference or hash
reference; it will automatically be serialized to JSON in canonical mode
(sorted hash keys).

For example, this uses the second and third argument to the function as a key:

    memoize('func', key => sub { @_[1..2] });

and this is useful for functions that accept a list of key/value pairs:

    # Ignore order of key/value pairs
    memoize('func', key => sub { %@_ });

Regardless of what key you specify, it will automatically be prefixed with the
full function name and the calling context ("L" or "S").

If the coderef returns C<CHI::Memoize::NO_MEMOIZE> (or C<NO_MEMOIZE> if you
import it), this call won't be memoized. This is useful if you have a cache of
limited size or if you know certain arguments will yield nondeterministic
results. e.g.

    memoize('func', key => sub { $is_worth_caching ? @_ : NO_MEMOIZE });

=item set and get options

You can pass any of CHI's L<set|CHI/set> options (e.g.
L<expires_in|CHI/expires_in>, L<expires_variance|CHI/expires_variance>) or
L<get|CHI/get> options (e.g. L<expire_if|CHI/expire_if>,
L<busy_lock|CHI/busy_lock>). e.g.

    # Expire after one hour
    memoize('func', expires_in => '1h');
    
    # Expire when a particular condition occurs
    memoize('func', expire_if => sub { ... });

=item cache options

Any remaining options will be passed to the L<CHI constructor|CHI/CONSTRUCTOR>
to generate the cache:

    # Store in file instead of memory
    memoize( 'func', driver => 'File', root_dir => '/path/to/cache' );

    # Store in memcached instead of memory
    memoize('func', driver => 'Memcached', servers => ["127.0.0.1:11211"]);

Unless specified, the L<namespace|CHI/namespace> is generated from the full
name of the function being memoized.

You can also specify an existing cache object:

    # Store in memcached instead of memory
    my $cache = CHI->new(driver => 'Memcached', servers => ["127.0.0.1:11211"]);
    memoize('func', cache => $cache);

=back

=head1 CLONED VS RAW REFERENCES

By default C<CHI>, and thus C<CHI::Memoize>, returns a deep clone of the stored
value I<even> when caching in memory. e.g. in this code

    # func returns a list reference
    memoize('func');
    my $ref1 = func();
    my $ref2 = func();

C<$ref1> and C<$ref2> will be references to two completely different lists
which have the same contained values. More specifically, the value is
L<serialized|CHI/serializer> by L<Storable|Storable> on C<set> and deserialized
(hence cloned) on C<get>.

The advantage here is that it is safe to modify a reference returned from a
memoized function; your modifications won't affect the cached value.

    my $ref1 = func();
    push(@$ref1, 3, 4, 5);
    my $ref2 = func();
    # $ref2 does not have 3, 4, 5

The disadvantage is that it takes extra time to serialize and deserialize the
value, and that some values like code references may be more difficult to
store. And cloning may not be what you want at all, e.g. if you are returning
objects.

Alternatively you can use L<CHI::Driver::RawMemory|CHI::Driver::RawMemory>,
which will store raw references the way C<Memoize> does. Now, however, any
modifications to the contents of a returned reference will affect the cached