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