File Coverage

blib/lib/Authen/Quiz/Plugin/Memcached.pm
Criterion Covered Total %
statement 9 21 42.8
branch 0 2 0.0
condition 0 9 0.0
subroutine 3 6 50.0
pod 2 2 100.0
total 14 40 35.0


line stmt bran cond sub pod time code
1             package Authen::Quiz::Plugin::Memcached;
2             #
3             # Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
4             #
5             # $Id: Memcached.pm 361 2008-08-18 18:29:46Z lushe $
6             #
7 1     1   514 use strict;
  1         2  
  1         30  
8 1     1   6 use warnings;
  1         1  
  1         305  
9              
10             eval{ require Cache::Memcached::Fast }; ## no critic.
11             if (my $error= $@) {
12             $error=~m{Can\'t\s+locate\s+Cache.+?Memcached.+?Fast}i || die $error;
13             require Cache::Memcached;
14             *cache= sub { $_[0]->{_cache} ||= Cache::Memcached->new($_[0]->{memcached}) };
15             } else {
16 0   0 0     *cache= sub { $_[0]->{_cache} ||= Cache::Memcached::Fast->new($_[0]->{memcached}) };
17             }
18              
19             our $VERSION= '0.01';
20              
21             our $CacheKey= 'authen_quiz_plugin_memcached';
22              
23             sub new {
24 0     0 1   my $self= shift->next::method(@_);
25 0   0       my $c= $self->{memcached} ||= {};
26 0   0       $c->{servers} ||= ["127.0.0.1:11211"];
27 0   0       $self->{memcached_expire} ||= 600;
28 0           $self;
29             }
30             sub load_quiz {
31 0     0 1   my($self)= @_;
32 1     1   5 no warnings qw/ once /;
  1         3  
  1         124  
33 0           my $key= "${CacheKey}_$Authen::Quiz::QuizYaml";
34 0 0         $self->cache->get($key) || do {
35 0           my $data= $self->next::method;
36 0           $self->cache->set($key=> $data, $self->{memcached_expire});
37 0           $data;
38             };
39             }
40              
41             1;
42              
43             __END__
44              
45             =head1 NAME
46              
47             Authen::Quiz::Plugin::Memcached - Plugin to which problem data of Authen::Quiz is cached.
48              
49             =head1 SYNOPSIS
50              
51             use Authen::Quiz::FW qw/ Memcached /;
52            
53             my $q= Authen::Quiz::FW->new(
54             data_folder => '/path/to/authen_quiz',
55             memcached => {
56             servers=> ["127.0.0.1:11211"],
57             },
58             memcached_expire => 600,
59             );
60              
61             =head1 DESCRIPTION
62              
63             I think that it comes to influence the response when the problem data of L<Authen::Quiz>
64             is enlarged. This plugin caches the problem data with Memcached, and prevents the
65             response from deteriorating.
66              
67             The option of Memcached is passed to the constructor reading by way of
68             L<Authen::Quiz::FW> to use it.
69              
70             Besides, the item named memcached_expire that sets the expiration date of cache
71             can be passed. Default is 600.
72              
73             When load_quiz is called by this, cache comes to be effective.
74              
75             =head1 METHODS
76              
77             =head2 new
78              
79             Constructor.
80              
81             =head2 load_quiz
82              
83             The method of L<Authen::Quiz> is Obarraited and cache is effective.
84              
85             =head2 cache
86              
87             The cashe object is returned.
88              
89             =head1 SEE ALSO
90              
91             L<Authen::Quiz>,
92             L<Authen::Quiz::FW>,
93             L<Cache::Memcached>,
94             L<Cache::Memcached::Fast>,
95              
96             L<http://egg.bomcity.com/wiki?Authen%3a%3aQuiz>,
97              
98             =head1 AUTHOR
99              
100             Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt>
101              
102             =head1 COPYRIGHT AND LICENSE
103              
104             Copyright (C) 2008 by Bee Flag, Corp. E<lt>http://egg.bomcity.com/E<gt>.
105              
106             This library is free software; you can redistribute it and/or modify
107             it under the same terms as Perl itself, either Perl version 5.8.8 or,
108             at your option, any later version of Perl 5 you may have available.
109              
110             =cut