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 File::Spec;
  28 use IO::File;
  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     if( not defined $Torrus::Global::cacheDir )
  43     {
  44         Error('$Torrus::Global::cacheDir must be defined');
  45         return
  46     }
  47     elsif( not -d $Torrus::Global::cacheDir )
  48     {
  49         Error("No such directory: $Torrus::Global::cacheDir");
  50         return
  51     }
  52
  53     $self->{'cachedir'} = $Torrus::Global::cacheDir;
  54     $self->{'cachemaxage'} = $Torrus::Renderer::cacheMaxAge || 60;
  55
  56     $self->{'db'} = Torrus::DB->new('render_cache', -WriteAccess => 1);
  57     if( not defined( $self->{'db'} ) )
  58     {
  59         die 'Failed to create render cache';
  60     }
  61
  62     srand( time() * $$ );
  63
  64     return $self
  65 }
  66
  67 =head2 cacheKey($keystring, [\%options])
  68
  69 needs a unique string I<$keystring>. If the I<\%options> hashref
  70 is provided it will be used as well to generate the I<$newkeystring>
  71 that is returned
  72
  73 =cut
  74
  75 sub cacheKey
  76 {
  77     my $self = shift;
  78     my $keystring = shift;
  79     my $options = shift || {};
  80
  81     if( ref( $options->{'variables'} ) )
  82     {
  83         for my $name ( sort keys %{$options->{'variables'}} )
  84         {
  85             my $val = $options->{'variables'}->{$name};
  86             $keystring .= ':' . $name . '=' . $val;
  87         }
  88     }
  89     return $keystring
  90 }
  91
  92
  93 =head2 getCache($keystring)
  94
  95 needs I<$keystring> as a parameter, returns the cache values as a I<@list>
  96
  97 =cut
  98
  99 sub getCache
 100 {
 101     my $self = shift;
 102     my $keystring = shift;
 103     my $options = shift || {};
 104
 105     $keystring = $self->cacheKey($keystring,$options);
 106
 107     my $cacheval = $self->{db}->get( $keystring );
 108
 109     if( defined($cacheval) )
 110     {
 111         my ($t_render, $t_expires, $filename, $mime_type) =  split(':', $cacheval);
 112
 113         my $cachefile = File::Spec->catfile($Torrus::Global::cacheDir,$filename);
 114
 115         if ($t_expires >= time() and -f $cachefile) { # if we delete the cache files we are ok
 116
 117             my $fh = IO::File->new($cachefile, '<');
 118             if( defined($fh) )
 119             {
 120                 my $content = <$fh>;
 121                 $fh->close();
 122                 return ($t_render, $t_expires, $content, $mime_type)
 123             }
 124
 125         }
 126         # otherwise we go to the end and return nothing
 127
 128     }
 129
 130     #return ($t_render, $t_expires, $content, $mime_type)
 131     return (0, 0, '', '')
 132
 133 }
 134
 135 =head2 setCache($keystring, $t_render, $t_expires, $filename, $mime_type)
 136
 137 Sets a value in the cache based on the provided arguments
 138
 139 =cut
 140
 141 sub setCache
 142 {
 143     my $self = shift;
 144     my $keystring = shift;
 145     my $options = shift;
 146     my $t_render = shift;
 147     my $t_expires = shift;
 148     my $content = shift;
 149     my $mime_type = shift;
 150
 151     $keystring = $self->cacheKey($keystring,$options);
 152
 153     my $filename = $self->newCacheFileName($keystring);
 154
 155     my $fh = IO::File->new($filename, '>') or return;
 156     print $fh $content;
 157     $fh->close();
 158
 159     $self->{db}->put( $keystring,
 160                 join(':',
 161                      ($t_render, $t_expires, $filename, $mime_type)));
 162     return 1
 163 }
 164
 165 sub checkAndClearCache
 166 {
 167     my $self = shift;
 168     my $config_tree = shift;
 169
 170     my $tree = $config_tree->treeName();
 171
 172     my $ts = Torrus::TimeStamp->new();
 173     my $known_ts = $ts->get($tree . ':renderer_cache');
 174     my $actual_ts = $config_tree->getTimestamp($ts);
 175     if( $actual_ts >= $known_ts or
 176         time() >= $known_ts + $self->{'cachemaxage'} )
 177     {
 178         $self->clearcache();
 179         $ts->setNow($tree . ':renderer_cache');
 180     }
 181     return 1
 182 }
 183
 184
 185 sub clearcache
 186 {
 187     my $self = shift;
 188
 189     Debug('Clearing renderer cache');
 190     my $cursor = $self->{'db'}->cursor( -Write => 1 );
 191     sleep(1);
 192     while( my ($key, $val) = $self->{'db'}->next( $cursor ) )
 193     {
 194         my($t_render, $t_expires, $filename, $mime_type) =  split(':', $val);
 195
 196         unlink File::Spec->catfile($self->{cachedir},$filename);
 197         $self->{'db'}->c_del( $cursor );
 198     }
 199     $self->{'db'}->c_close($cursor);
 200     Debug('Renderer cache cleared');
 201
 202     return 1
 203 }
 204
 205 =head newCacheFileName
 206
 207 Returns a new cachefilename based on the provided args $cachekey and
 208 a random number
 209
 210 It would be far better if this used File::Temp
 211
 212 =cut
 213
 214 sub newCacheFileName
 215 {
 216     my $cachekey = shift;
 217     return sprintf('%s_%.5d', md5_hex($cachekey), rand(1e5));
 218 }
 219
 220
 221 1;
 222
 223
 224 # Local Variables:
 225 # mode: perl
 226 # indent-tabs-mode: nil
 227 # perl-indent-level: 4
 228 # End: