File Coverage

blib/lib/CGI/Application/Plugin/CHI.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package CGI::Application::Plugin::CHI;

use strict;
use warnings;

use base 'Exporter';

use CHI;
use Scalar::Util 'blessed', 'reftype';
use Carp 'croak';

our $VERSION = 0.03;

# export by default since we're doing a mixin-style class
our @EXPORT = ( 'cache_config', 'cache_default', 'cache', 'rmcache', '__get_cache' );


my %CONFIG;

sub cache_config {
    my $class = shift;

    if ( @_ == 1 ) {
        croak 'first argument to cache_config() must be a hashref or cache name'
          unless reftype $_[0] eq 'HASH';

        return $CONFIG{default} = $_[0];
    } elsif ( @_ >= 2 ) {
        my %args = @_;
        foreach my $key( keys %args ) {
            croak 'multiple-argument form of cache_config() requires name => hashref pairs'
              unless ref( $args{$key} ) && reftype $args{$key} eq 'HASH';

            $CONFIG{named}{$key} = $args{$key};
        }

        return 1;
    }

    croak 'no arguments to cache_config()';
}

sub cache_default {
    my $class = shift;

    croak 'cache_default requires one argument'
      unless @_ == 1;

    if ( my $def_conf = $CONFIG{named}{$_[0]} ) {
        return $CONFIG{default} = $def_conf;
    }

    croak "no such cache named '$_[0]'";
}

sub cache {
    my $self = shift;

    croak 'cache must be called as an object method'
      unless ref $self;

    croak 'too many arguments to cache()'
      if @_ > 1;

    return $self->__get_cache( [ @_ ] );
}

sub rmcache {
    my $self = shift;

    croak 'rmcache must be called as an object method'
      unless ref $self;

    my $ns = blessed( $self ) . '::' . $self->get_current_runmode;

    return $self->__get_cache( [ @_ ], $ns );
}


sub __get_cache {
    my $self = shift;

    my @args = @{ $_[0] };
    my $ns   = $_[1] || '';

    if ( @args == 0 ) {
        if ( my $conf = $CONFIG{default} ) {
            return CHI->new( %$conf,
                             $ns
                             ? ( namespace => $ns )
                             : ( )
                           );

        } else {
            croak "no default cache configured";
        }
    } elsif ( @args == 1 ) {
        if ( my $conf = $CONFIG{named}{$args[0]} ) {
            return CHI->new( %$conf,
                             $ns
                             ? ( namespace => $ns )
                             : ( )
                           );
        }

        croak "no such cache '$args[0]' configured";
    }

    die 'too many args for _get_cache';
}


# really only used for testing
sub _clean_conf {
    %CONFIG = ( );
}


1;


__END__