lib/Catalyst/Plugin/Cache/Choose/KeyRegexes.pm

   1 #!/usr/bin/perl
   2
   3 package Catalyst::Plugin::Cache::Choose::KeyRegexes;
   4
   5 use strict;
   6 use warnings;
   7
   8 sub setup {
   9     my $app = shift;
  10     my $ret = $app->NEXT::setup( @_ );
  11
  12     my $regexes = $app->config->{cache}{key_regexes} ||= [];
  13
  14     die "the regex list must be an array containing regexex/backend pairs" unless ref $regexes eq "ARRAY";
  15
  16     $ret;
  17 }
  18
  19 sub get_cache_key_regexes {
  20     my ( $c, %meta ) = @_;
  21     @{ $c->config->{cache}{key_regexes} };
  22 }
  23
  24 sub choose_cache_backend {
  25     my ( $c, %meta ) = @_;
  26
  27     my @regexes = $c->get_cache_key_regexes( %meta );
  28
  29     while ( @regexes and my ( $re, $backend ) = splice( @regexes, 0, 2 ) ) {
  30         return $backend if $meta{key} =~ $re;
  31     }
  32
  33     $c->NEXT::choose_cache_backend( %meta );
  34 }
  35
  36 __PACKAGE__;
  37
  38 __END__
  39
  40 =pod
  41
  42 =head1 NAME
  43
  44 Catalyst::Plugin::Cache::Choose::KeyRegex - Choose a cache backend based on key regexes.
  45
  46 =head1 SYNOPSIS
  47
  48         use Catalyst::Plugin::Cache::Choose::KeyRegex;
  49
  50 =head1 DESCRIPTION
  51
  52 =cut
  53
  54