Catalyst::Plugin::Cache::Curried - Curried versions of C<cache_set>,

Catalyst-Plugin-Cache documentation Contained in the Catalyst-Plugin-Cache distribution.

Index

Code Index:

NAME

Top

Catalyst::Plugin::Cache::Curried - Curried versions of cache_set, cache_get and cache_remove that look more like a backend.

SYNOPSIS

Top

    my $curried = $c->cache( %meta );

    $curried->get( $key, $value ); # no need to specify %meta

DESCRIPTION

Top

See META DATA in Catalyst::Plugin::Cache for details.

METHODS

Top

new %meta

Create a new curried cache, that captures %meta.

backend %additional_meta

This calls choose_cache_backend on the $c object with the captured meta and the additional meta.

set $key, $value, %additional_meta
get $key, %additional_meta
remove $key, %additional_meta
compute $key, $code, %additional_meta

Dellegate to the c object's cache_set, cache_get, cache_remove or cache_compute with the arguments, then the captured meta from meta, and then the additional meta.

meta

Returns the array ref that captured %meta from new.

c

The captured $c object to delegate to.

Catalyst-Plugin-Cache documentation Contained in the Catalyst-Plugin-Cache distribution. 
#!/usr/bin/perl

package Catalyst::Plugin::Cache::Curried;

use strict;
use warnings;

use base qw/Class::Accessor::Fast/;

use Scalar::Util ();

__PACKAGE__->mk_accessors(qw/c meta/);

sub new {
    my ( $class, $c, @meta ) = @_;

    my $self = $class->SUPER::new({
        c    => $c,
        meta => \@meta,
    });

    Scalar::Util::weaken( $self->{c} )
        if ref( $self->{c} );

    return $self;
}

sub backend {
    my ( $self, @meta ) = @_;
    $self->c->choose_cache_backend( @{ $self->meta }, @meta )
}

sub set {
    my ( $self, $key, $value, @meta ) = @_;
    @meta = ( expires => $meta[0] ) if @meta == 1;
    $self->c->cache_set( $key, $value, @{ $self->meta }, @meta );
}

sub get {
    my ( $self, $key ) = @_;
    $self->c->cache_get( $key, @{ $self->meta } );
}

sub remove {
    my ( $self, $key ) = @_;
    $self->c->cache_remove( $key, @{ $self->meta } );
}

sub compute {
    my ($self, $key, $code, @meta) = @_;
    @meta = ( expires => $meta[0] ) if @meta == 1;
    $self->c->cache_compute( $key, $code, @{ $self->meta }, @meta );
}

__PACKAGE__;

__END__