1408b7f64a30b0e2727da9b055af781f46c7a371
[freeside.git] / torrus / perllib / Torrus / Renderer / HTML.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: HTML.pm,v 1.9 2011-02-27 19:08:12 ivan Exp $
18 # Stanislav Sinyagin <ssinyagin@yahoo.com>
19
20 package Torrus::Renderer::HTML;
21
22 use strict;
23
24 use Torrus::ConfigTree;
25 use Torrus::Search;
26 use Torrus::Log;
27
28 use URI::Escape;
29 use Template;
30 use POSIX qw(abs log floor pow);
31 use Date::Parse;
32 use Date::Format;
33
34 Torrus::SiteConfig::loadStyling();
35
36 # All our methods are imported by Torrus::Renderer;
37
38 sub render_html
39 {
40     my $self = shift;
41     my $config_tree = shift;
42     my $token = shift;
43     my $view = shift;
44     my $outfile = shift;
45
46     my $tmplfile = $config_tree->getParam($view, 'html-template');
47
48     my $expires = $config_tree->getParam($view, 'expires');
49     
50     # Create the Template Toolkit processor once, and reuse
51     # it in subsequent render() calls
52
53     if( not defined( $self->{'tt'} ) )
54     {
55         $self->{'tt'} =
56             new Template(INCLUDE_PATH => $Torrus::Global::templateDirs,
57                          TRIM => 1);
58     }
59     my $ttvars =
60     {
61         'treeName'   => $config_tree->treeName(),
62         'token'      => $token,
63         'view'       => $view,
64         'expires'    => $expires,
65         'path'       => sub { return $config_tree->path($_[0]); },
66         'pathToken'  => sub { return $config_tree->token($_[0]); },
67         'nodeExists' => sub { return $config_tree->nodeExists($_[0]); },
68         'children'   => sub { return $config_tree->getChildren($_[0]); },
69         'isLeaf'     => sub { return $config_tree->isLeaf($_[0]); },
70         'isAlias'    => sub { return $config_tree->isAlias($_[0]); },
71         'sortTokens' => sub { return $self->sortTokens($config_tree,
72                                                        $_[0]); },
73         'nodeName'   => sub { return $self->nodeName($config_tree, $_[0]); },
74         'parent'     => sub { return $config_tree->getParent($_[0]); },
75         'nodeParam'  => sub { return $config_tree->getNodeParam(@_); },
76         'param'      => sub { return $config_tree->getParam(@_); },
77         'url'        => sub { return $self->makeURL($config_tree, 0, @_); },
78         'persistentUrl' => sub { return $self->makeURL($config_tree, 1, @_); },
79         'clearVar'   => sub { delete $self->{'options'}{'variables'}{$_[0]};
80                               return undef;},
81         'plainURL'   => $Torrus::Renderer::plainURL,
82         'splitUrls'  => sub { return $self->makeSplitURLs($config_tree,
83                                                           $_[0], $_[1]); },
84         'topURL'     => ($Torrus::Renderer::rendererURL ne '' ?
85                          $Torrus::Renderer::rendererURL : '/'),
86         'rrprint'    => sub { return $self->rrPrint($config_tree,
87                                                     $_[0], $_[1]); },
88         'scale'      => sub { return $self->scale($_[0], $_[1]); },
89         'tsetMembers' => sub { $config_tree->tsetMembers($_[0]); },
90         'tsetList'   => sub { $config_tree->getTsets(); },
91         'style'      => sub { return $self->style($_[0]); },
92         'companyName'=> $Torrus::Renderer::companyName,
93         'companyLogo'=> $Torrus::Renderer::companyLogo,
94         'companyURL' => $Torrus::Renderer::companyURL,
95         'siteInfo'   => $Torrus::Renderer::siteInfo,
96         'treeInfo'   => sub { return $Torrus::Global::treeConfig{
97             $config_tree->treeName()}{'info'}; },
98         'version'    => $Torrus::Global::version,
99         'xmlnorm'    => \&Torrus::Renderer::xmlnormalize,
100         'userAuth'   => $Torrus::CGI::authorizeUsers,
101         'uid'        => $self->{'options'}->{'uid'},
102         'userAttr'   => sub { return $self->userAttribute( $_[0] ) },
103         'mayDisplayAdmInfo' => sub {
104             return $self->may_display_adminfo( $config_tree, $_[0] ) },
105         'adminfo' => $self->{'adminfo'},
106         'mayDisplayReports' => sub {
107             return $self->may_display_reports($config_tree) },
108         'reportsUrl' => sub {
109             return $self->reportsUrl($config_tree); },
110         'timestamp'  => sub { return time2str($Torrus::Renderer::timeFormat,
111                                               time()); },
112         'verifyDate'  => sub { return verifyDate($_[0]); },
113         'markup'     => sub{ return $self->translateMarkup( @_ ); },
114         'searchEnabled' => $Torrus::Renderer::searchEnabled,
115         'searchResults' => sub { return $self->doSearch($config_tree, $_[0]); },
116
117         #Freeside
118         'freesideHeader' => sub { return $self->freesideHeader(@_); },
119         'freesideFooter' => sub { return $self->freesideFooter(); },
120         'freesideComponent' => sub { return $self->freesideComponent(@_); },
121         'uri_escape'        => sub { return uri_escape(@_); },
122         'matches'        => sub { return $_[0] =~ $_[1]; },
123         'slash2underscore' => sub { $_[0] =~ s/\//_/g; return $_[0]; },
124         'load_nms'       => sub { return $self->load_nms; },
125         'get_serviceids'    => sub { my $nms = shift; 
126                                   my $router = shift;
127                                   return $nms->get_router_serviceids($router);
128                                 },
129         'popup_link'     => sub {  
130           my $type = shift;
131
132           if($type eq 'nms-add_iface.html') {
133               my $host = shift;
134               my $iface = shift;
135               my $nms = shift;
136               my $serviceids = shift;
137               my $svc_port = '';
138
139               if ( $serviceids && $serviceids->{$iface} ) {
140
141                 my $svc_port = $nms->find_svc($serviceids->{$iface})
142
143                 if ($svc_port) {
144                    my $url = $Torrus::Freeside::FSURL.
145                              "/view/svc_port.cgi?".$svc_port->svcnum;
146                    return "<A HREF='$url'>View Service</A>";
147                 } else {
148                    return 'Monitored as '. $serviceids->{$iface}.
149                           '; customer service not yet provisioned';
150                 }
151
152               } else {
153
154                return
155                    $self->freesideComponent('/elements/popup_link.html',
156                        'action' => "/freeside/misc/".
157                                $type."?host=$host;iface=$iface",
158                         'label' => 'Monitor for billing',
159                         'actionlabel' => 'Monitor interface',
160                    );
161
162               }
163
164           } elsif ($type eq 'nms-add_router.html') {
165                return
166                    $self->freesideComponent('/elements/popup_link.html',
167                        'action' => "/freeside/misc/$type",
168                         'label' => 'Add Router',
169                         'actionlabel' => 'Add Router',
170                    );
171           }
172
173           '';
174        },
175
176     };
177     
178     
179     # Pass the options from Torrus::Renderer::render() to Template
180     while( my( $opt, $val ) = each( %{$self->{'options'}} ) )
181     {
182         $ttvars->{$opt} = $val;
183     }
184
185     my $result = $self->{'tt'}->process( $tmplfile, $ttvars, $outfile );
186
187     undef $ttvars;
188
189     if( not $result )
190     {
191         if( $config_tree->isTset( $token ) )
192         {
193             Error("Error while rendering tokenset $token: " .
194                   $self->{'tt'}->error());
195         }
196         else
197         {
198             my $path = $config_tree->path($token);
199             Error("Error while rendering $path: " .
200                   $self->{'tt'}->error());
201         }
202         return undef;
203     }
204
205     return ($expires+time(), 'text/html; charset=UTF-8');
206 }
207
208
209 sub nodeName
210 {
211     my $self = shift;
212     my $config_tree = shift;
213     my $token = shift;
214
215     my $n = $config_tree->getNodeParam($token, 'node-display-name', 1);
216     if( defined( $n ) and length( $n ) > 0 )
217     {
218         return $n;
219     }
220     
221     return $config_tree->nodeName($config_tree->path($token));
222 }
223
224
225 sub sortTokens
226 {
227     my $self = shift;
228     my $config_tree = shift;
229     my $tokenlist = shift;
230
231     my @sorted = ();
232     if( ref($tokenlist) and scalar(@{$tokenlist}) > 0 )
233     {
234         @sorted = sort
235         {
236             my $p_a = $config_tree->getNodeParam($a, 'precedence', 1);
237             $p_a = 0 unless defined $p_a;
238             my $p_b = $config_tree->getNodeParam($b, 'precedence', 1);
239             $p_b = 0 unless defined $p_b;
240             if( $p_a == $p_b )
241             {
242                 my $n_a = $config_tree->path($a);
243                 my $n_b = $config_tree->path($b);
244                 return $n_a cmp $n_b;
245             }
246             else
247             {
248                 return $p_b <=> $p_a;
249             }
250         } @{$tokenlist};
251     }
252     else
253     {
254         push(@sorted, $tokenlist);
255     }
256     return @sorted;
257 }
258
259
260 # compose an URL for a node.
261 # $persistent defines if the link should be persistent
262 # Persistent link is done with nodeid if available, or with path
263
264 sub makeURL
265 {
266     my $self = shift;
267     my $config_tree = shift;
268     my $persistent = shift;
269     my $token = shift;
270     my $view = shift;
271     my @add_vars = @_;
272
273     my $ret = $Torrus::Renderer::rendererURL . '/' . $config_tree->treeName();
274     
275     if( $persistent )
276     {
277         my $nodeid = $config_tree->getNodeParam($token, 'nodeid', 1);
278         if( defined( $nodeid ) )
279         {
280             $ret .= '?nodeid=' .
281                 uri_escape($nodeid, $Torrus::Renderer::uriEscapeExceptions);
282         }
283         else
284         {
285             $ret .= '?path=' .
286                 uri_escape($config_tree->path($token),
287                            $Torrus::Renderer::uriEscapeExceptions);
288         }
289     }
290     else
291     {
292         $ret .= '?token=' . uri_escape($token);
293     }
294
295     if( $view )
296     {
297         $ret .= '&amp;view=' . uri_escape($view);
298     }
299
300     my %vars = ();
301     # This could be array or a reference to array
302     my $add_vars_size = scalar( @add_vars );
303     if( $add_vars_size == 1 and ref( $add_vars[0] ) )
304     {
305         %vars = @{$add_vars[0]};
306     }
307     elsif( $add_vars_size > 0 and ($add_vars_size % 2 == 0) )
308     {
309         %vars = @add_vars;
310     }
311
312     if( ref( $self->{'options'}->{'variables'} ) )
313     {
314         foreach my $name ( sort keys %{$self->{'options'}->{'variables'}} )
315         {
316             my $val = $self->{'options'}->{'variables'}->{$name};
317             if( not defined( $vars{$name} ) )
318             {
319                 $vars{$name} = $val;
320             }
321         }
322     }
323
324     foreach my $name ( sort keys %vars )
325     {
326         if( $vars{$name} ne '' )
327         {
328             $ret .= '&amp;' . $name . '=' .
329                 uri_escape( $vars{$name},
330                             $Torrus::Renderer::uriEscapeExceptions );
331         }
332     }
333
334     return $ret;
335 }
336
337 sub makeSplitURLs
338 {
339     my $self = shift;
340     my $config_tree = shift;
341     my $token = shift;
342     my $view = shift;
343
344     my $ret = '';
345     while( defined( $token ) )
346     {
347         my $path = $config_tree->path($token);
348         
349         my $str = '<SPAN CLASS="PathElement">';
350         $str .=
351             sprintf('<A HREF="%s">%s%s</A>',
352                     $self->makeURL($config_tree, 0, $token, $view),
353                     $config_tree->nodeName($path),
354                     ( $config_tree->isSubtree($token) and
355                       $path ne '/') ? '/':'' );
356         $str .= "</SPAN>\n";
357         
358         $ret = $str . $ret;
359                 
360         $token = $config_tree->getParent( $token );
361     }
362     
363     return $ret;
364 }
365
366
367 sub rrPrint
368 {
369     my $self = shift;
370     my $config_tree = shift;
371     my $token = shift;
372     my $view = shift;
373
374     my @ret = ();
375     my($fname, $mimetype) = $self->render( $config_tree, $token, $view );
376
377     if( $mimetype ne 'text/plain' )
378     {
379         Error("View $view does not produce text/plain for token $token");
380     }
381     else
382     {
383         if( not open(IN, $fname) )
384         {
385             Error("Cannot open $fname for reading: $!");
386         }
387         else
388         {
389             chomp(my $values = <IN>);
390             @ret = split(':', $values);
391             close IN;
392         }
393     }
394     return @ret;
395 }
396
397 # This subroutine is taken from Dave Plonka's Flowscan
398
399 sub scale
400 {
401     my $self = shift;
402     # This is based somewhat on Tobi Oetiker's code in rrd_graph.c:
403     my $fmt = shift;
404     my $value = shift;
405     my @symbols = ("a", # 10e-18 Ato
406                    "f", # 10e-15 Femto
407                    "p", # 10e-12 Pico
408                    "n", # 10e-9  Nano
409                    "u", # 10e-6  Micro
410                    "m", # 10e-3  Milli
411                    " ", # Base
412                    "k", # 10e3   Kilo
413                    "M", # 10e6   Mega
414                    "G", # 10e9   Giga
415                    "T", # 10e12  Terra
416                    "P", # 10e15  Peta
417                    "E"); # 10e18  Exa
418
419     my $symbcenter = 6;
420     my $digits = (0 == $value)? 0 : floor(log(abs($value))/log(1000));
421     return sprintf( $fmt . " %s", $value/pow(1000, $digits),
422                     $symbols[ $symbcenter+$digits ] );
423 }
424
425 sub style
426 {
427     my $self = shift;
428     my $object = shift;
429
430     my $media;
431     if( not defined( $media = $self->{'options'}->{'variables'}->{'MEDIA'} ) )
432     {
433         $media = 'default';
434     }
435     return  $Torrus::Renderer::styling{$media}{$object};
436 }
437
438
439
440 sub userAttribute
441 {
442     my $self = shift;
443     my $attr = shift;
444
445     if( $self->{'options'}->{'uid'} and $self->{'options'}->{'acl'} )
446     {
447         $self->{'options'}->{'acl'}->
448             userAttribute( $self->{'options'}->{'uid'}, $attr );
449     }
450     else
451     {
452         return '';
453     }
454 }
455
456 sub hasPrivilege
457 {
458     my $self = shift;
459     my $object = shift;
460     my $privilege = shift;
461
462     if( $self->{'options'}->{'uid'} and $self->{'options'}->{'acl'} )
463     {
464         $self->{'options'}->{'acl'}->
465             hasPrivilege( $self->{'options'}->{'uid'}, $object, $privilege );
466     }
467     else
468     {
469         return undef;
470     }
471 }
472
473
474 sub translateMarkup
475 {
476     my $self = shift;
477     my @strings = @_;
478
479     my $tt = new Template( TRIM => 1 );
480
481     my $ttvars =
482     {
483         'em'      =>  sub { return '<em>' . $_[0] . '</em>'; },
484         'strong'  =>  sub { return '<strong>' . $_[0] . '</strong>'; }
485     };
486     
487     my $ret = '';
488     
489     foreach my $str ( @strings )
490     {
491         my $output = '';
492         my $result = $tt->process( \$str, $ttvars, \$output );
493
494         if( not $result )
495         {
496             Error('Error translating markup: ' . $tt->error());
497         }
498         else
499         {
500             $ret .= $output;
501         }
502     }
503
504     undef $tt;
505     
506     return $ret;
507 }
508
509
510 sub verifyDate
511 {
512     my $input = shift;
513
514     my $time = str2time( $input );
515     # rrdtool does not understand dates prior to 1980 (315529200)
516     if( defined( $time ) and $time > 315529200 )
517     {
518         # Present the time in format understood by rrdtool
519         return time2str('%H:%M %Y%m%d', $time);
520     }
521     else
522     {
523         return '';
524     }
525 }
526
527
528 sub may_display_reports
529 {
530     my $self = shift;
531     my $config_tree = shift;
532
533     if( $Torrus::Renderer::displayReports )
534     {
535         if( not $Torrus::CGI::authorizeUsers )
536         {
537             return 1;
538         }
539         
540         my $tree = $config_tree->treeName();
541         if( $self->hasPrivilege( $tree, 'DisplayReports' ) and
542             -r $Torrus::Global::reportsDir . '/' . $tree .
543             '/html/index.html' )
544         {
545             return 1;
546         }
547     }
548     return 0;
549 }
550
551
552 sub reportsUrl
553 {
554     my $self = shift;
555     my $config_tree = shift;
556
557     return $Torrus::Renderer::rendererURL . '/' .
558         $config_tree->treeName() . '?htmlreport=index.html';
559 }
560
561
562 sub doSearch
563 {
564     my $self = shift;
565     my $config_tree = shift;
566     my $string = shift;
567     
568
569     my $tree = $config_tree->treeName();
570     
571     my $sr = new Torrus::Search;
572     $sr->openTree( $tree );
573     my $result = $sr->searchPrefix( $string, $tree );
574     $sr->closeTree( $tree );
575
576     my $ret = [];
577     push( @{$ret}, sort {$a->[0] cmp $b->[0]} @{$result} );
578     
579     return $ret;
580 }
581
582
583 1;
584
585
586 # Local Variables:
587 # mode: perl
588 # indent-tabs-mode: nil
589 # perl-indent-level: 4
590 # End: