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