CGI::Application::Plugin::Cache::Adaptive - Provide cacheable to method using attribute.

  package MyApp;
  use base qw(CGI::Application);
  use CGI::Application::Plugin::Cache::Adaptive;

  use Cache::FileCache;

  sub setup {
    my $self = shift;

    $self->start_mode('default');
    $self->run_modes(
        'default' => 'do_default'
    );

    $self->cache_adaptive({
        backend => Cache::FileCache->new({
            namespace => 'html_cache',
            max_size  => 10 * 1024 * 1024,
        }),
        expires_min => 3,
        expires_max => 60,
        check_load  => sub {
            my $entry = shift;
            int($entry->{process_time} * 2) - 1;
        },
    });
  }

  sub do_default : Cacheable(qw/path path_info query/) {
    sleep 10;
    return "test";
  }

package CGI::Application::Plugin::Cache::Adaptive;

use strict;
use warnings;

use base qw(Exporter);
use Attribute::Handlers;
use Cache::Adaptive;
use Carp qw(croak);
use Class::Inspector;
use Storable qw(freeze);

our @EXPORT = qw(&cache_adaptive);

our $VERSION = '0.03';

sub cache_adaptive {
    my $self = shift;

    if (@_ == 2) {
        if (UNIVERSAL::isa($_[1], 'Cache::Adaptive')) {
            $self->{'Cache::Adaptive::cache_adaptive'}{$_[0]} = $_[1];
        }
        else {
            $self->{'Cache::Adaptive::cache_adaptive'}{$_[0]} = Cache::Adaptive->new($_[1]);
        }
    }
    elsif (@_ == 1) {
        if (UNIVERSAL::isa($_[0], 'Cache::Adaptive')) {
            return $self->{'Cache::Adaptive::cache_adaptive'}{'default'} = $_[0];
        }
        elsif (ref $_[0] eq 'HASH') {
            $self->{'Cache::Adaptive::cache_adaptive'}{'default'} = Cache::Adaptive->new($_[0]);
        }
        else {
            return $self->{'Cache::Adaptive::cache_adaptive'}{$_[0]};
        }
    }
    else {
        return $self->{'Cache::Adaptive::cache_adaptive'}{'default'};
    }
}

sub CGI::Application::Cacheable : ATTR(CODE,BEGIN) {
    my ($package, $symbol, $referent, $attr, $data, $phase) = @_;

    my %key_index = (
        'path' => 0,
        'query' => 1,
        'path_info' => 2,
        'session' => 3
    );

    $package->add_callback('init',
        sub {
            my $self = shift;

            ### In the next process, runmode will be rededined.
            ### In CAP::AutoRunmode, it was cached code reference before redefined.
            ### Therefore now start_mode and error_mode must be static value.
            if (Class::Inspector->loaded('CGI::Application::Plugin::AutoRunmode')) {
                $self->start_mode;
                $self->error_mode;
            }
        }
    );

    $package->add_callback('init', 
        sub {
            my ($self, @args) = @_;

            $data = {} unless ($data);
            my $data_type = ref $data;

            if ($data_type eq 'ARRAY' || $data_type eq 'HASH') {
                my $label = ($data_type eq 'HASH') ? delete $data->{label} || 'default' : 'default';
                my $key_from = ($data_type eq 'HASH') ? delete $data->{key_from} : $data;
                $key_from = [qw(path)] if (!$key_from || @$key_from == 0);

                my %extra_params = ($data_type eq 'HASH') ? %$data : ();

                my $method = (grep { $package->can($_) == $referent } @{Class::Inspector->methods($package)})[0];
                return unless ($method);

                {
                    no strict 'refs';
                    no warnings 'redefine';

                    *{$package . "::" . $method} = sub {
                        my ($self, @args) = @_;

                        local $CGI::USE_PARAM_SEMICOLONS = 0;
                        my @key_array = (undef, undef, undef, undef);

                        for my $key (grep { exists $key_index{$_} } @$key_from) {
                            my $value = undef;

                            $value = $self->query->script_name if ($key eq 'path');
                            $value = $self->query->query_string if ($key eq 'query');
                            $value = $self->query->path_info if ($key eq 'path_info');
                            $value = ($self->can('session')) ? $self->session->id : undef if ($key eq 'session');

                            $key_array[$key_index{$key}] = $value if (exists $key_index{$key} && defined $value);
                        }

#                        {
#                            my %debug = ();
#                            $debug{$_} = $key_array[$key_index{$_}] for (keys %key_index);
#
#                            $self->cache_adaptive($label)->log->(\%debug);
#                        }

                        return $self->cache_adaptive($label)->access({
                            key => freeze(\@key_array),
                            builder => sub {
                                return $referent->($self, @args);
                            },
                            %extra_params
                        });
                    };

                    ### If using CAP::AutoRunmode, it's code reference cache table must be refleshed.
                    if (Class::Inspector->loaded('CGI::Application::Plugin::AutoRunmode')) {
                        if (exists $CGI::Application::Plugin::AutoRunmode::RUNMODES{"$referent"}) {
                            delete $CGI::Application::Plugin::AutoRunmode::RUNMODES{"$referent"};
                            $CGI::Application::Plugin::AutoRunmode::RUNMODES{$package->can($method)} = 1;
                        }
                    }
                }
            }
        }
    );
}

1; # End of CGI::Application::Plugin::Cache::Adaptive