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.2 2010-12-27 08:40:19 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             Torrus::Renderer::Freeside
  41            );
  42
  43 sub new
  44 {
  45     my $self = {};
  46     my $class = shift;
  47     bless $self, $class;
  48
  49     if( not defined $Torrus::Global::cacheDir )
  50     {
  51         Error('$Torrus::Global::cacheDir must be defined');
  52         return undef;
  53     }
  54     elsif( not -d $Torrus::Global::cacheDir )
  55     {
  56         Error("No such directory: $Torrus::Global::cacheDir");
  57         return undef;
  58     }
  59
  60     $self->{'db'} = new Torrus::DB('render_cache', -WriteAccess => 1);
  61     if( not defined( $self->{'db'} ) )
  62     {
  63         return undef;
  64     }
  65
  66     srand( time() * $$ );
  67
  68     return $self;
  69 }
  70
  71
  72 # Returns the absolute filename and MIME type:
  73 #
  74 # my($fname, $mimetype) = $renderer->render($config_tree, $token, $view);
  75 #
  76
  77 sub render
  78 {
  79     my $self = shift;
  80     my $config_tree = shift;
  81     my $token = shift;
  82     my $view = shift;
  83     my %new_options = @_;
  84
  85     # If no options given, preserve the existing ones
  86     if( %new_options )
  87     {
  88         $self->{'options'} = \%new_options;
  89     }
  90
  91     $self->checkAndClearCache( $config_tree );
  92
  93     my($t_render, $t_expires, $filename, $mime_type);
  94
  95     my $tree = $config_tree->treeName();
  96
  97     if( not $config_tree->isTset($token) )
  98     {
  99         if( my $alias = $config_tree->isAlias($token) )
 100         {
 101             $token = $alias;
 102         }
 103         if( not defined( $config_tree->path($token) ) )
 104         {
 105             Error("No such token: $token");
 106             return undef;
 107         }
 108     }
 109
 110     $view = $config_tree->getDefaultView($token) unless defined $view;
 111
 112     my $uid = '';
 113     if( $self->{'options'}->{'uid'} )
 114     {
 115         $uid = $self->{'options'}->{'uid'};
 116     }
 117
 118     my $cachekey = $self->cacheKey( $uid . ':' . $tree . ':' .
 119                                     $token . ':' . $view );
 120
 121     ($t_render, $t_expires, $filename, $mime_type) =
 122         $self->getCache( $cachekey );
 123
 124     my $not_in_cache = 0;
 125
 126     if( not defined( $filename ) )
 127     {
 128         $filename = Torrus::Renderer::newCacheFileName( $cachekey );
 129         $not_in_cache = 1;
 130     }
 131
 132     my $cachefile = $Torrus::Global::cacheDir.'/'.$filename;
 133
 134     if( ( not $not_in_cache ) and
 135         -f $cachefile and
 136         $t_expires >= time() )
 137     {
 138         return ($cachefile, $mime_type, $t_expires - time());
 139     }
 140
 141     my $method = 'render_' . $config_tree->getParam($view, 'view-type');
 142
 143     ($t_expires, $mime_type) =
 144         $self->$method( $config_tree, $token, $view, $cachefile );
 145
 146     if( %new_options )
 147     {
 148         $self->{'options'} = undef;
 149     }
 150
 151     my @ret;
 152     if( defined($t_expires) and defined($mime_type) )
 153     {
 154         $self->setCache($cachekey, time(), $t_expires, $filename, $mime_type);
 155         @ret = ($cachefile, $mime_type, $t_expires - time());
 156     }
 157
 158     return @ret;
 159 }
 160
 161
 162 sub cacheKey
 163 {
 164     my $self = shift;
 165     my $keystring = shift;
 166
 167     if( ref( $self->{'options'}->{'variables'} ) )
 168     {
 169         foreach my $name ( sort keys %{$self->{'options'}->{'variables'}} )
 170         {
 171             my $val = $self->{'options'}->{'variables'}->{$name};
 172             $keystring .= ':' . $name . '=' . $val;
 173         }
 174     }
 175     return $keystring;
 176 }
 177
 178
 179 sub getCache
 180 {
 181     my $self = shift;
 182     my $keystring = shift;
 183
 184     my $cacheval = $self->{'db'}->get( $keystring );
 185
 186     if( defined($cacheval) )
 187     {
 188         return split(':', $cacheval);
 189     }
 190     else
 191     {
 192         return undef;
 193     }
 194 }
 195
 196
 197 sub setCache
 198 {
 199     my $self = shift;
 200     my $keystring = shift;
 201     my $t_render = shift;
 202     my $t_expires = shift;
 203     my $filename = shift;
 204     my $mime_type = shift;
 205
 206     $self->{'db'}->put( $keystring,
 207                         join(':',
 208                              ($t_render, $t_expires, $filename, $mime_type)));
 209 }
 210
 211
 212
 213 sub checkAndClearCache
 214 {
 215     my $self = shift;
 216     my $config_tree = shift;
 217
 218     my $tree = $config_tree->treeName();
 219
 220     Torrus::TimeStamp::init();
 221     my $known_ts = Torrus::TimeStamp::get($tree . ':renderer_cache');
 222     my $actual_ts = $config_tree->getTimestamp();
 223     if( $actual_ts >= $known_ts or
 224         time() >= $known_ts + $Torrus::Renderer::cacheMaxAge )
 225     {
 226         $self->clearcache();
 227         Torrus::TimeStamp::setNow($tree . ':renderer_cache');
 228     }
 229     Torrus::TimeStamp::release();
 230 }
 231
 232
 233 sub clearcache
 234 {
 235     my $self = shift;
 236
 237     Debug('Clearing renderer cache');
 238     my $cursor = $self->{'db'}->cursor( -Write => 1 );
 239     while( my ($key, $val) = $self->{'db'}->next( $cursor ) )
 240     {
 241         my($t_render, $t_expires, $filename, $mime_type) =  split(':', $val);
 242
 243         unlink $Torrus::Global::cacheDir.'/'.$filename;
 244         $self->{'db'}->c_del( $cursor );
 245     }
 246     undef $cursor;
 247     Debug('Renderer cache cleared');
 248 }
 249
 250
 251 sub newCacheFileName
 252 {
 253     my $cachekey = shift;
 254     return sprintf('%s_%.5d', md5_hex($cachekey), rand(1e5));
 255 }
 256
 257 sub xmlnormalize
 258 {
 259     my( $txt )= @_;
 260
 261     # Remove spaces in the head and tail.
 262     $txt =~ s/^\s+//om;
 263     $txt =~ s/\s+$//om;
 264
 265     # Unscreen special characters
 266     $txt =~ s/{COLON}/:/ogm;
 267     $txt =~ s/{SEMICOL}/;/ogm;
 268     $txt =~ s/{PERCENT}/%/ogm;
 269
 270     $txt =~ s/\&/\&amp\;/ogm;
 271     $txt =~ s/\</\&lt\;/ogm;
 272     $txt =~ s/\>/\&gt\;/ogm;
 273     $txt =~ s/\'/\&apos\;/ogm;
 274     $txt =~ s/\"/\&quot\;/ogm;
 275
 276     return $txt;
 277 }
 278
 279
 280
 281 1;
 282
 283
 284 # Local Variables:
 285 # mode: perl
 286 # indent-tabs-mode: nil
 287 # perl-indent-level: 4
 288 # End: