torrus/perllib/Torrus/Renderer.pm

   1 #  Copyright (C) 2002  Stanislav Sinyagin
   2 #
   3 #  This program is free software; you can redistribute it and/or modify
   4 #  it under the terms of the GNU General Public License as published by
   5 #  the Free Software Foundation; either version 2 of the License, or
   6 #  (at your option) any later version.
   7 #
   8 #  This program is distributed in the hope that it will be useful,
   9 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 #  GNU General Public License for more details.
  12 #
  13 #  You should have received a copy of the GNU General Public License
  14 #  along with this program; if not, write to the Free Software
  15 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
  16
  17 # $Id: Renderer.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $
  18 # Stanislav Sinyagin <ssinyagin@yahoo.com>
  19
  20 package Torrus::Renderer;
  21
  22 use strict;
  23 use Digest::MD5 qw(md5_hex);
  24
  25 use Torrus::DB;
  26 use Torrus::ConfigTree;
  27 use Torrus::TimeStamp;
  28 use Torrus::RPN;
  29 use Torrus::Log;
  30 use Torrus::SiteConfig;
  31
  32 use Torrus::Renderer::HTML;
  33 use Torrus::Renderer::RRDtool;
  34
  35 # Inherit methods from these modules
  36 use base qw(Torrus::Renderer::HTML
  37             Torrus::Renderer::RRDtool
  38             Torrus::Renderer::Frontpage
  39             Torrus::Renderer::AdmInfo);
  40
  41 sub new
  42 {
  43     my $self = {};
  44     my $class = shift;
  45     bless $self, $class;
  46
  47     if( not defined $Torrus::Global::cacheDir )
  48     {
  49         Error('$Torrus::Global::cacheDir must be defined');
  50         return undef;
  51     }
  52     elsif( not -d $Torrus::Global::cacheDir )
  53     {
  54         Error("No such directory: $Torrus::Global::cacheDir");
  55         return undef;
  56     }
  57
  58     $self->{'db'} = new Torrus::DB('render_cache', -WriteAccess => 1);
  59     if( not defined( $self->{'db'} ) )
  60     {
  61         return undef;
  62     }
  63
  64     srand( time() * $$ );
  65
  66     return $self;
  67 }
  68
  69
  70 # Returns the absolute filename and MIME type:
  71 #
  72 # my($fname, $mimetype) = $renderer->render($config_tree, $token, $view);
  73 #
  74
  75 sub render
  76 {
  77     my $self = shift;
  78     my $config_tree = shift;
  79     my $token = shift;
  80     my $view = shift;
  81     my %new_options = @_;
  82
  83     # If no options given, preserve the existing ones
  84     if( %new_options )
  85     {
  86         $self->{'options'} = \%new_options;
  87     }
  88
  89     $self->checkAndClearCache( $config_tree );
  90
  91     my($t_render, $t_expires, $filename, $mime_type);
  92
  93     my $tree = $config_tree->treeName();
  94
  95     if( not $config_tree->isTset($token) )
  96     {
  97         if( my $alias = $config_tree->isAlias($token) )
  98         {
  99             $token = $alias;
 100         }
 101         if( not defined( $config_tree->path($token) ) )
 102         {
 103             Error("No such token: $token");
 104             return undef;
 105         }
 106     }
 107
 108     $view = $config_tree->getDefaultView($token) unless defined $view;
 109
 110     my $uid = '';
 111     if( $self->{'options'}->{'uid'} )
 112     {
 113         $uid = $self->{'options'}->{'uid'};
 114     }
 115
 116     my $cachekey = $self->cacheKey( $uid . ':' . $tree . ':' .
 117                                     $token . ':' . $view );
 118
 119     ($t_render, $t_expires, $filename, $mime_type) =
 120         $self->getCache( $cachekey );
 121
 122     my $not_in_cache = 0;
 123
 124     if( not defined( $filename ) )
 125     {
 126         $filename = Torrus::Renderer::newCacheFileName( $cachekey );
 127         $not_in_cache = 1;
 128     }
 129
 130     my $cachefile = $Torrus::Global::cacheDir.'/'.$filename;
 131
 132     if( ( not $not_in_cache ) and
 133         -f $cachefile and
 134         $t_expires >= time() )
 135     {
 136         return ($cachefile, $mime_type, $t_expires - time());
 137     }
 138
 139     my $method = 'render_' . $config_tree->getParam($view, 'view-type');
 140
 141     ($t_expires, $mime_type) =
 142         $self->$method( $config_tree, $token, $view, $cachefile );
 143
 144     if( %new_options )
 145     {
 146         $self->{'options'} = undef;
 147     }
 148
 149     my @ret;
 150     if( defined($t_expires) and defined($mime_type) )
 151     {
 152         $self->setCache($cachekey, time(), $t_expires, $filename, $mime_type);
 153         @ret = ($cachefile, $mime_type, $t_expires - time());
 154     }
 155
 156     return @ret;
 157 }
 158
 159
 160 sub cacheKey
 161 {
 162     my $self = shift;
 163     my $keystring = shift;
 164
 165     if( ref( $self->{'options'}->{'variables'} ) )
 166     {
 167         foreach my $name ( sort keys %{$self->{'options'}->{'variables'}} )
 168         {
 169             my $val = $self->{'options'}->{'variables'}->{$name};
 170             $keystring .= ':' . $name . '=' . $val;
 171         }
 172     }
 173     return $keystring;
 174 }
 175
 176
 177 sub getCache
 178 {
 179     my $self = shift;
 180     my $keystring = shift;
 181
 182     my $cacheval = $self->{'db'}->get( $keystring );
 183
 184     if( defined($cacheval) )
 185     {
 186         return split(':', $cacheval);
 187     }
 188     else
 189     {
 190         return undef;
 191     }
 192 }
 193
 194
 195 sub setCache
 196 {
 197     my $self = shift;
 198     my $keystring = shift;
 199     my $t_render = shift;
 200     my $t_expires = shift;
 201     my $filename = shift;
 202     my $mime_type = shift;
 203
 204     $self->{'db'}->put( $keystring,
 205                         join(':',
 206                              ($t_render, $t_expires, $filename, $mime_type)));
 207 }
 208
 209
 210
 211 sub checkAndClearCache
 212 {
 213     my $self = shift;
 214     my $config_tree = shift;
 215
 216     my $tree = $config_tree->treeName();
 217
 218     Torrus::TimeStamp::init();
 219     my $known_ts = Torrus::TimeStamp::get($tree . ':renderer_cache');
 220     my $actual_ts = $config_tree->getTimestamp();
 221     if( $actual_ts >= $known_ts or
 222         time() >= $known_ts + $Torrus::Renderer::cacheMaxAge )
 223     {
 224         $self->clearcache();
 225         Torrus::TimeStamp::setNow($tree . ':renderer_cache');
 226     }
 227     Torrus::TimeStamp::release();
 228 }
 229
 230
 231 sub clearcache
 232 {
 233     my $self = shift;
 234
 235     Debug('Clearing renderer cache');
 236     my $cursor = $self->{'db'}->cursor( -Write => 1 );
 237     while( my ($key, $val) = $self->{'db'}->next( $cursor ) )
 238     {
 239         my($t_render, $t_expires, $filename, $mime_type) =  split(':', $val);
 240
 241         unlink $Torrus::Global::cacheDir.'/'.$filename;
 242         $self->{'db'}->c_del( $cursor );
 243     }
 244     undef $cursor;
 245     Debug('Renderer cache cleared');
 246 }
 247
 248
 249 sub newCacheFileName
 250 {
 251     my $cachekey = shift;
 252     return sprintf('%s_%.5d', md5_hex($cachekey), rand(1e5));
 253 }
 254
 255 sub xmlnormalize
 256 {
 257     my( $txt )= @_;
 258
 259     # Remove spaces in the head and tail.
 260     $txt =~ s/^\s+//om;
 261     $txt =~ s/\s+$//om;
 262
 263     # Unscreen special characters
 264     $txt =~ s/{COLON}/:/ogm;
 265     $txt =~ s/{SEMICOL}/;/ogm;
 266     $txt =~ s/{PERCENT}/%/ogm;
 267
 268     $txt =~ s/\&/\&amp\;/ogm;
 269     $txt =~ s/\</\&lt\;/ogm;
 270     $txt =~ s/\>/\&gt\;/ogm;
 271     $txt =~ s/\'/\&apos\;/ogm;
 272     $txt =~ s/\"/\&quot\;/ogm;
 273
 274     return $txt;
 275 }
 276
 277
 278
 279 1;
 280
 281
 282 # Local Variables:
 283 # mode: perl
 284 # indent-tabs-mode: nil
 285 # perl-indent-level: 4
 286 # End: