src/lib/Torrus/Renderer/Cache.pm

   1 #  Copyright (C) 2012  Dean Hamstead
   2 #  Copyright (C) 2002-2011  Stanislav Sinyagin
   3 #
   4 #  This program is free software; you can redistribute it and/or modify
   5 #  it under the terms of the GNU General Public License as published by
   6 #  the Free Software Foundation; either version 2 of the License, or
   7 #  (at your option) any later version.
   8 #
   9 #  This program is distributed in the hope that it will be useful,
  10 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 #  GNU General Public License for more details.
  13 #
  14 #  You should have received a copy of the GNU General Public License
  15 #  along with this program; if not, write to the Free Software
  16 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
  17
  18 # Dean Hamstead <dean@fragfest.com.au>
  19 # Stanislav Sinyagin <ssinyagin@yahoo.com>
  20
  21
  22 package Torrus::Renderer::Cache;
  23 use strict;
  24 use warnings;
  25
  26 use Digest::MD5 qw(md5_hex);
  27 use Cache::FastMmap;
  28 use FreezeThaw qw(freeze thaw);
  29
  30 use Torrus::DB;
  31 use Torrus::TimeStamp;
  32 use Torrus::Log;
  33
  34 our $VERSION = 1.0;
  35
  36 sub new
  37 {
  38     my $class = shift;
  39     my $self = {};
  40     bless $self, $class;
  41
  42     $self->{store} = Cache::FastMmap->new(
  43                 expire_time => $Torrus::Renderer::cacheMaxAge || 60,
  44     );
  45
  46     die 'Couldnt create cache object?' unless $self->{store};
  47
  48     return $self
  49 }
  50
  51 =head2 cacheKey($keystring, [\%options])
  52
  53 needs a unique string I<$keystring>. If the I<\%options> hashref
  54 is provided it will be used as well to generate the I<$newkeystring>
  55 that is returned
  56
  57 =cut
  58
  59 sub cacheKey
  60 {
  61     my $self = shift;
  62     my $keystring = shift;
  63     my $options = shift || {};
  64
  65     if( ref( $options->{'variables'} ) )
  66     {
  67         for my $name ( sort keys %{$options->{'variables'}} )
  68         {
  69             my $val = $options->{'variables'}->{$name};
  70             $keystring .= ':' . $name . '=' . $val;
  71         }
  72     }
  73     return $keystring
  74 }
  75
  76
  77 =head2 getCache($keystring)
  78
  79 needs I<$keystring> as a parameter, returns the cache values as a I<@list>
  80
  81 =cut
  82
  83 sub getCache
  84 {
  85     my $self = shift;
  86     my $keystring = shift;
  87     my $options = shift || {};
  88
  89     $keystring = $self->cacheKey($keystring,$options);
  90
  91     my $cacheval = $self->{store}->get( $keystring );
  92
  93     if( defined($cacheval) )
  94     {
  95         my $o = thaw( $cacheval );
  96
  97         return @{$o}[qw(t_render t_expires content mime_type)]
  98            if ($o->{t_expires} >= time());
  99
 100         # otherwise we go to the end and return nothing
 101
 102     }
 103
 104     #return ($t_render, $t_expires, $content, $mime_type)
 105     return (0, 0, '', '')
 106
 107 }
 108
 109 =head2 setCache($keystring, $options, $t_render, $t_expires, $filename, $mime_type)
 110
 111 Sets a value in the cache based on the provided arguments
 112
 113 =cut
 114
 115 sub setCache
 116 {
 117     my $self = shift;
 118     my $keystring = shift;
 119     my $options = shift;
 120     my $t_render = shift;
 121     my $t_expires = shift;
 122     my $content = shift;
 123     my $mime_type = shift;
 124
 125     $keystring = $self->cacheKey($keystring,$options);
 126
 127     my $o = {
 128         t_render   => $t_render,
 129         t_expires  => $t_expires,
 130         content    => $content,
 131         $mime_type => $mime_type,
 132
 133     };
 134
 135     $self->{store}->set( $keystring, freeze($o) );
 136
 137     return 1
 138 }
 139
 140 =head2 checkAndClearCache
 141
 142 Stub.
 143
 144 =cut
 145
 146 sub checkAndClearCache
 147 {
 148 return 1
 149 }
 150
 151 =head2 clearcache
 152
 153 Stub.
 154
 155 =cut
 156
 157 sub clearcache
 158 {
 159     return 1
 160 }
 161
 162 1;
 163
 164
 165 # Local Variables:
 166 # mode: perl
 167 # indent-tabs-mode: nil
 168 # perl-indent-level: 4
 169 # End: