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/\&/\&amp\;/ogm;
277    $txt =~ s/\</\&lt\;/ogm;
278    $txt =~ s/\>/\&gt\;/ogm;
279    $txt =~ s/\'/\&apos\;/ogm;
280    $txt =~ s/\"/\&quot\;/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