X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=torrus%2Fperllib%2FTorrus%2FRenderer.pm;fp=torrus%2Fperllib%2FTorrus%2FRenderer.pm;h=803dd18585ebf46c14d190e76551732b003cb0d0;hb=74e058c8a010ef6feb539248a550d0bb169c1e94;hp=0000000000000000000000000000000000000000;hpb=35359a73152b3d7a9ad5e3d37faf81f6fedb76e8;p=freeside.git diff --git a/torrus/perllib/Torrus/Renderer.pm b/torrus/perllib/Torrus/Renderer.pm new file mode 100644 index 000000000..803dd1858 --- /dev/null +++ b/torrus/perllib/Torrus/Renderer.pm @@ -0,0 +1,286 @@ +# Copyright (C) 2002 Stanislav Sinyagin +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. + +# $Id: Renderer.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $ +# Stanislav Sinyagin + +package Torrus::Renderer; + +use strict; +use Digest::MD5 qw(md5_hex); + +use Torrus::DB; +use Torrus::ConfigTree; +use Torrus::TimeStamp; +use Torrus::RPN; +use Torrus::Log; +use Torrus::SiteConfig; + +use Torrus::Renderer::HTML; +use Torrus::Renderer::RRDtool; + +# Inherit methods from these modules +use base qw(Torrus::Renderer::HTML + Torrus::Renderer::RRDtool + Torrus::Renderer::Frontpage + Torrus::Renderer::AdmInfo); + +sub new +{ + my $self = {}; + my $class = shift; + bless $self, $class; + + if( not defined $Torrus::Global::cacheDir ) + { + Error('$Torrus::Global::cacheDir must be defined'); + return undef; + } + elsif( not -d $Torrus::Global::cacheDir ) + { + Error("No such directory: $Torrus::Global::cacheDir"); + return undef; + } + + $self->{'db'} = new Torrus::DB('render_cache', -WriteAccess => 1); + if( not defined( $self->{'db'} ) ) + { + return undef; + } + + srand( time() * $$ ); + + return $self; +} + + +# Returns the absolute filename and MIME type: +# +# my($fname, $mimetype) = $renderer->render($config_tree, $token, $view); +# + +sub render +{ + my $self = shift; + my $config_tree = shift; + my $token = shift; + my $view = shift; + my %new_options = @_; + + # If no options given, preserve the existing ones + if( %new_options ) + { + $self->{'options'} = \%new_options; + } + + $self->checkAndClearCache( $config_tree ); + + my($t_render, $t_expires, $filename, $mime_type); + + my $tree = $config_tree->treeName(); + + if( not $config_tree->isTset($token) ) + { + if( my $alias = $config_tree->isAlias($token) ) + { + $token = $alias; + } + if( not defined( $config_tree->path($token) ) ) + { + Error("No such token: $token"); + return undef; + } + } + + $view = $config_tree->getDefaultView($token) unless defined $view; + + my $uid = ''; + if( $self->{'options'}->{'uid'} ) + { + $uid = $self->{'options'}->{'uid'}; + } + + my $cachekey = $self->cacheKey( $uid . ':' . $tree . ':' . + $token . ':' . $view ); + + ($t_render, $t_expires, $filename, $mime_type) = + $self->getCache( $cachekey ); + + my $not_in_cache = 0; + + if( not defined( $filename ) ) + { + $filename = Torrus::Renderer::newCacheFileName( $cachekey ); + $not_in_cache = 1; + } + + my $cachefile = $Torrus::Global::cacheDir.'/'.$filename; + + if( ( not $not_in_cache ) and + -f $cachefile and + $t_expires >= time() ) + { + return ($cachefile, $mime_type, $t_expires - time()); + } + + my $method = 'render_' . $config_tree->getParam($view, 'view-type'); + + ($t_expires, $mime_type) = + $self->$method( $config_tree, $token, $view, $cachefile ); + + if( %new_options ) + { + $self->{'options'} = undef; + } + + my @ret; + if( defined($t_expires) and defined($mime_type) ) + { + $self->setCache($cachekey, time(), $t_expires, $filename, $mime_type); + @ret = ($cachefile, $mime_type, $t_expires - time()); + } + + return @ret; +} + + +sub cacheKey +{ + my $self = shift; + my $keystring = shift; + + if( ref( $self->{'options'}->{'variables'} ) ) + { + foreach my $name ( sort keys %{$self->{'options'}->{'variables'}} ) + { + my $val = $self->{'options'}->{'variables'}->{$name}; + $keystring .= ':' . $name . '=' . $val; + } + } + return $keystring; +} + + +sub getCache +{ + my $self = shift; + my $keystring = shift; + + my $cacheval = $self->{'db'}->get( $keystring ); + + if( defined($cacheval) ) + { + return split(':', $cacheval); + } + else + { + return undef; + } +} + + +sub setCache +{ + my $self = shift; + my $keystring = shift; + my $t_render = shift; + my $t_expires = shift; + my $filename = shift; + my $mime_type = shift; + + $self->{'db'}->put( $keystring, + join(':', + ($t_render, $t_expires, $filename, $mime_type))); +} + + + +sub checkAndClearCache +{ + my $self = shift; + my $config_tree = shift; + + my $tree = $config_tree->treeName(); + + Torrus::TimeStamp::init(); + my $known_ts = Torrus::TimeStamp::get($tree . ':renderer_cache'); + my $actual_ts = $config_tree->getTimestamp(); + if( $actual_ts >= $known_ts or + time() >= $known_ts + $Torrus::Renderer::cacheMaxAge ) + { + $self->clearcache(); + Torrus::TimeStamp::setNow($tree . ':renderer_cache'); + } + Torrus::TimeStamp::release(); +} + + +sub clearcache +{ + my $self = shift; + + Debug('Clearing renderer cache'); + my $cursor = $self->{'db'}->cursor( -Write => 1 ); + while( my ($key, $val) = $self->{'db'}->next( $cursor ) ) + { + my($t_render, $t_expires, $filename, $mime_type) = split(':', $val); + + unlink $Torrus::Global::cacheDir.'/'.$filename; + $self->{'db'}->c_del( $cursor ); + } + undef $cursor; + Debug('Renderer cache cleared'); +} + + +sub newCacheFileName +{ + my $cachekey = shift; + return sprintf('%s_%.5d', md5_hex($cachekey), rand(1e5)); +} + +sub xmlnormalize +{ + my( $txt )= @_; + + # Remove spaces in the head and tail. + $txt =~ s/^\s+//om; + $txt =~ s/\s+$//om; + + # Unscreen special characters + $txt =~ s/{COLON}/:/ogm; + $txt =~ s/{SEMICOL}/;/ogm; + $txt =~ s/{PERCENT}/%/ogm; + + $txt =~ s/\&/\&\;/ogm; + $txt =~ s/\/\>\;/ogm; + $txt =~ s/\'/\&apos\;/ogm; + $txt =~ s/\"/\"\;/ogm; + + return $txt; +} + + + +1; + + +# Local Variables: +# mode: perl +# indent-tabs-mode: nil +# perl-indent-level: 4 +# End: