← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:10 2021

Filename/usr/local/libexec/sympa/Sympa/Template.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sSympa::Template::::BEGIN@33Sympa::Template::BEGIN@33
0000s0sSympa::Template::::BEGIN@34Sympa::Template::BEGIN@34
0000s0sSympa::Template::::BEGIN@35Sympa::Template::BEGIN@35
0000s0sSympa::Template::::BEGIN@36Sympa::Template::BEGIN@36
0000s0sSympa::Template::::BEGIN@37Sympa::Template::BEGIN@37
0000s0sSympa::Template::::BEGIN@38Sympa::Template::BEGIN@38
0000s0sSympa::Template::::BEGIN@39Sympa::Template::BEGIN@39
0000s0sSympa::Template::::BEGIN@41Sympa::Template::BEGIN@41
0000s0sSympa::Template::::BEGIN@42Sympa::Template::BEGIN@42
0000s0sSympa::Template::::BEGIN@43Sympa::Template::BEGIN@43
0000s0sSympa::Template::::BEGIN@44Sympa::Template::BEGIN@44
0000s0sSympa::Template::::BEGIN@45Sympa::Template::BEGIN@45
0000s0sSympa::Template::::BEGIN@46Sympa::Template::BEGIN@46
0000s0sSympa::Template::::BEGIN@47Sympa::Template::BEGIN@47
0000s0sSympa::Template::::__ANON__Sympa::Template::__ANON__ (xsub)
0000s0sSympa::Template::::__ANON__[:171]Sympa::Template::__ANON__[:171]
0000s0sSympa::Template::::__ANON__[:178]Sympa::Template::__ANON__[:178]
0000s0sSympa::Template::::__ANON__[:185]Sympa::Template::__ANON__[:185]
0000s0sSympa::Template::::__ANON__[:187]Sympa::Template::__ANON__[:187]
0000s0sSympa::Template::::__ANON__[:204]Sympa::Template::__ANON__[:204]
0000s0sSympa::Template::::__ANON__[:215]Sympa::Template::__ANON__[:215]
0000s0sSympa::Template::::__ANON__[:237]Sympa::Template::__ANON__[:237]
0000s0sSympa::Template::::__ANON__[:247]Sympa::Template::__ANON__[:247]
0000s0sSympa::Template::::__ANON__[:253]Sympa::Template::__ANON__[:253]
0000s0sSympa::Template::::__ANON__[:259]Sympa::Template::__ANON__[:259]
0000s0sSympa::Template::::__ANON__[:278]Sympa::Template::__ANON__[:278]
0000s0sSympa::Template::::__ANON__[:388]Sympa::Template::__ANON__[:388]
0000s0sSympa::Template::::__ANON__[:425]Sympa::Template::__ANON__[:425]
0000s0sSympa::Template::::__ANON__[:432]Sympa::Template::__ANON__[:432]
0000s0sSympa::Template::::__ANON__[:433]Sympa::Template::__ANON__[:433]
0000s0sSympa::Template::::_escape_cstrSympa::Template::_escape_cstr
0000s0sSympa::Template::::_escape_urlSympa::Template::_escape_url
0000s0sSympa::Template::::_escape_xmlSympa::Template::_escape_xml
0000s0sSympa::Template::::_get_option_descriptionSympa::Template::_get_option_description
0000s0sSympa::Template::::_mailboxSympa::Template::_mailbox
0000s0sSympa::Template::::_mailtoSympa::Template::_mailto
0000s0sSympa::Template::::_mailtourlSympa::Template::_mailtourl
0000s0sSympa::Template::::_obfuscateSympa::Template::_obfuscate
0000s0sSympa::Template::::_optdesc_funcSympa::Template::_optdesc_func
0000s0sSympa::Template::::_template2textdomainSympa::Template::_template2textdomain
0000s0sSympa::Template::::_url_funcSympa::Template::_url_func
0000s0sSympa::Template::::decode_utf8Sympa::Template::decode_utf8
0000s0sSympa::Template::::encode_utf8Sympa::Template::encode_utf8
0000s0sSympa::Template::::locdatetimeSympa::Template::locdatetime
0000s0sSympa::Template::::maketextSympa::Template::maketext
0000s0sSympa::Template::::newSympa::Template::new
0000s0sSympa::Template::::parseSympa::Template::parse
0000s0sSympa::Template::::qencodeSympa::Template::qencode
0000s0sSympa::Template::::wrapSympa::Template::wrap
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# -*- indent-tabs-mode: nil; -*-
2# vim:ft=perl:et:sw=4
3# $Id$
4
5# Sympa - SYsteme de Multi-Postage Automatique
6#
7# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
8# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
9# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
10# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
11# Copyright 2017, 2018, 2020 The Sympa Community. See the AUTHORS.md
12# file at the top-level directory of this distribution and at
13# <https://github.com/sympa-community/sympa.git>.
14#
15# This program is free software; you can redistribute it and/or modify
16# it under the terms of the GNU General Public License as published by
17# the Free Software Foundation; either version 2 of the License, or
18# (at your option) any later version.
19#
20# This program is distributed in the hope that it will be useful,
21# but WITHOUT ANY WARRANTY; without even the implied warranty of
22# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23# GNU General Public License for more details.
24#
25# You should have received a copy of the GNU General Public License
26# along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28# TT2 adapter for sympa's template system - Chia-liang Kao <clkao@clkao.org>
29# usage: replace require 'parser.pl' in wwwsympa and other .pl
30
31package Sympa::Template;
32
33use strict;
34use warnings;
35use CGI::Util;
36use Encode qw();
37use English qw(-no_match_vars);
38use MIME::EncWords;
39use Template;
40
41use Sympa;
42use Conf;
43use Sympa::HTMLDecorator;
44use Sympa::Language;
45use Sympa::ListOpt;
46use Sympa::Robot;
47use Sympa::Tools::Text;
48
49my $language = Sympa::Language->instance;
50
51sub new {
52 my $class = shift;
53 my $that = shift;
54 my %options = @_;
55
56 $options{include_path} ||= [];
57
58 bless {%options, context => $that} => $class;
59}
60
61sub qencode {
62 my $string = shift;
63 # We are not able to determine the name of header field, so assume
64 # longest (maybe) one.
65 return MIME::EncWords::encode_mimewords(
66 Encode::decode('utf8', $string),
67 Encoding => 'A',
68 Charset => Conf::lang2charset($language->get_lang),
69 Field => "message-id"
70 );
71}
72
73# OBSOLETED. This is kept only for backward compatibility.
74# Old name: tt2::escape_url().
75sub _escape_url {
76 my $string = shift;
77
78 $string =~ s/([\s+])/sprintf('%%%02x', ord $1)/eg;
79 # Some MUAs aren't able to decode ``%40'' (escaped ``@'') in e-mail
80 # address of mailto: URL, or take ``@'' in query component for a
81 # delimiter to separate URL from the rest.
82 my ($body, $query) = split(/\?/, $string, 2);
83 if (defined $query) {
84 $query =~ s/(\@)/sprintf('%%%02x', ord $1)/eg;
85 $string = $body . '?' . $query;
86 }
87
88 return $string;
89}
90
91# OBSOLETED. This is kept only for backward compatibility.
92# Old name:: tt2::escape_xml().
93sub _escape_xml {
94 my $string = shift;
95
96 $string =~ s/&/&amp;/g;
97 $string =~ s/</&lt;/g;
98 $string =~ s/>/&gt;/g;
99 $string =~ s/\'/&apos;/g;
100 $string =~ s/\"/&quot;/g;
101
102 return $string;
103}
104
105# Old name: tt2::escape_quote().
106# No longer used. Use _escape_cstr().
107#sub _escape_quote;
108
109sub _escape_cstr {
110 my $string = shift;
111
112 $string =~ s{([\t\n\r\'\"\\])}{
113 ($1 eq "\t") ? "\\t" :
114 ($1 eq "\n") ? "\\n" :
115 ($1 eq "\r") ? "\\r" :
116 "\\$1"
117 }eg;
118
119 return $string;
120}
121
122sub encode_utf8 {
123 my $string = shift;
124
125 ## Skip if already internally tagged utf8
126 if (Encode::is_utf8($string)) {
127 return Encode::encode_utf8($string);
128 }
129
130 return $string;
131
132}
133
134sub decode_utf8 {
135 my $string = shift;
136
137 ## Skip if already internally tagged utf8
138 unless (Encode::is_utf8($string)) {
139 ## Wrapped with eval to prevent Sympa process from dying
140 ## FB_CROAK is used instead of FB_WARN to pass $string intact to
141 ## succeeding processes it operation fails
142 eval { $string = Encode::decode('utf8', $string, Encode::FB_CROAK); };
143 $EVAL_ERROR = '';
144 }
145
146 return $string;
147
148}
149
150# We use different catalog/textdomains depending on the template that
151# requests translations.
152# help.tt2 and help_*.tt2 templates use domain "web_help". Others use default
153# domain "sympa".
154sub _template2textdomain {
155 my $template_name = shift;
156 return ($template_name =~ /\Ahelp(?:_[-\w]+)?[.]tt2\z/) ? 'web_help' : '';
157}
158
159sub maketext {
160 my ($context, @arg) = @_;
161
162 my $template_name = $context->stash->get('component')->{'name'};
163 my $textdomain = _template2textdomain($template_name);
164
165 return sub {
166 my $ret = $language->maketext($textdomain, $_[0], @arg);
167 # <acronym> was deprecated: Use <abbr> instead.
168 $ret =~ s/(<\/?)acronym\b/${1}abbr/g
169 if $ret and $textdomain eq 'web_help';
170 return $ret;
171 };
172}
173
174sub locdatetime {
175 my ($fmt, $arg) = @_;
176
177 if (defined $arg and $arg =~ /\A-?\d+\z/) {
178 return sub { $language->gettext_strftime($_[0], localtime $arg); };
179 } elsif (defined $arg
180 and $arg =~
181 /\A(\d{4})\D(\d\d?)(?:\D(\d\d?)(?:\D(\d\d?)\D(\d\d?)(?:\D(\d\d?))?)?)?/
182 ) {
183 my @arg =
184 ($6 || 0, $5 || 0, $4 || 0, $3 || 1, $2 - 1, $1 - 1900, 0, 0, 0);
185 return sub { $language->gettext_strftime($_[0], @arg); };
186 } else {
187 return sub { $language->gettext("(unknown date)"); };
188 }
189}
190
191sub wrap {
192 my ($context, $init, $subs, $cols) = @_;
193 $init = '' unless defined $init;
194 $init = ' ' x $init if $init =~ /^\d+$/;
195 $subs = '' unless defined $subs;
196 $subs = ' ' x $subs if $subs =~ /^\d+$/;
197
198 return sub {
199 my $text = shift;
200 my $nl = $text =~ /\n$/;
201 my $ret = Sympa::Tools::Text::wrap_text($text, $init, $subs, $cols);
202 $ret =~ s/\n$// unless $nl;
203 $ret;
204 };
205}
206
207sub _mailbox {
208 my ($context, $email, $comment) = @_;
209
210 return sub {
211 my $text = shift;
212
213 return Sympa::Tools::Text::addrencode($email, $text,
214 Conf::lang2charset($language->get_lang), $comment);
215 };
216}
217
218sub _mailto {
219 my ($context, $email, $query, $nodecode) = @_;
220
221 return sub {
222 my $text = shift;
223
224 unless ($text =~ /\S/) {
225 $text =
226 $nodecode ? Sympa::Tools::Text::encode_html($email) : $email;
227 }
228 return sprintf '<a href="%s">%s</a>',
229 Sympa::Tools::Text::encode_html(
230 Sympa::Tools::Text::mailtourl(
231 $email,
232 decode_html => !$nodecode,
233 query => $query,
234 )
235 ),
236 $text;
237 };
238}
239
240sub _mailtourl {
241 my ($context, $query) = @_;
242
243 return sub {
244 my $text = shift;
245
246 return Sympa::Tools::Text::mailtourl($text, query => $query);
247 };
248}
249
250sub _obfuscate {
251 my ($context, $mode) = @_;
252
253 return sub {shift}
254 unless grep { $mode eq $_ } qw(at concealed javascript);
255
256 return sub {
257 my $text = shift;
258 Sympa::HTMLDecorator->instance->decorate($text, email => $mode);
259 };
260}
261
262sub _optdesc_func {
263 my $self = shift;
264 my $type = shift;
265 my $withval = shift;
266
267 my $that = $self->{context};
268 my $encode_html = ($self->{subdir} && $self->{subdir} eq 'web_tt2');
269
270 return sub {
271 my $x = shift;
272 return undef unless defined $x;
273 return undef unless $x =~ /\S/;
274 $x =~ s/^\s+//;
275 $x =~ s/\s+$//;
276 my $title = _get_option_description($that, $x, $type, $withval);
277 $encode_html ? Sympa::Tools::Text::encode_html($title) : $title;
278 };
279}
280
281# Old name: Sympa::List::get_option_title().
282# Old name: Sympa::ListOpt::get_title().
283# Old name: Sympa::ListOpt::get_option_description().
284sub _get_option_description {
285 my $that = shift;
286 my $option = shift;
287 my $type = shift || '';
288 my $withval = shift || 0;
289
290 my $title = undef;
291
292 if ($type eq 'dayofweek') {
293 if ($option =~ /\A[0-9]+\z/) {
294 $title = [
295 split /:/,
296 $language->gettext(
297 'Sunday:Monday:Tuesday:Wednesday:Thursday:Friday:Saturday'
298 )
299 ]->[$option % 7];
300 }
301 } elsif ($type eq 'lang') {
302 $language->push_lang;
303 if ($language->set_lang($option)) {
304 $title = $language->native_name;
305 }
306 $language->pop_lang;
307 } elsif ($type eq 'listtopic' or $type eq 'listtopic:leaf') {
308 my $robot_id;
309 if (ref $that eq 'Sympa::List') {
310 $robot_id = $that->{'domain'};
311 } elsif (ref $that eq 'Sympa::Family') {
312 $robot_id = $that->{'domain'};
313 } elsif ($that and $that ne '*') {
314 $robot_id = $that;
315 } else {
316 $robot_id = '*';
317 }
318 if ($type eq 'listtopic') {
319 $title = Sympa::Robot::topic_get_title($robot_id, $option);
320 } else {
321 $title =
322 [Sympa::Robot::topic_get_title($robot_id, $option)]->[-1];
323 }
324 } elsif ($type eq 'password') {
325 return '*' x length($option); # return
326 } elsif ($type eq 'unixtime') {
327 $title = $language->gettext_strftime('%d %b %Y at %H:%M:%S',
328 localtime $option);
329 } else {
330 my $map = {
331 'reception' => \%Sympa::ListOpt::reception_mode,
332 'visibility' => \%Sympa::ListOpt::visibility_mode,
333 'status' => \%Sympa::ListOpt::list_status,
334 'status:cap' => \%Sympa::ListOpt::list_status_capital,
335 }->{$type}
336 || \%Sympa::ListOpt::list_option;
337 my $t = $map->{$option} || {};
338 if ($t->{gettext_id}) {
339 $title = $language->gettext($t->{gettext_id});
340 $title =~ s/^\s+//;
341 $title =~ s/\s+$//;
342 }
343 }
344
345 if (defined $title) {
346 return sprintf '%s (%s)', $title, $option if $withval;
347 return $title;
348 }
349 return $option;
350}
351
352sub _url_func {
353 my $self = shift;
354 my $is_abs = shift;
355 my $data = shift;
356 my %options;
357 @options{qw(paths query fragment)} = @_;
358
359 # Flatten nested path components.
360 if ($options{paths} and @{$options{paths}}) {
361 $options{paths} =
362 [map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @{$options{paths}}];
363 }
364
365 @options{qw(authority decode_html nomenu)} = (
366 ($is_abs ? 'default' : 'omit'),
367 ($self->{subdir} && $self->{subdir} eq 'web_tt2'),
368 ($self->{subdir} && $self->{subdir} eq 'web_tt2' && $data->{nomenu}),
369 );
370
371 my $that = $self->{context};
372 my $robot_id =
373 (ref $that eq 'Sympa::List') ? $that->{'domain'}
374 : (ref $that eq 'Sympa::Family') ? $that->{'domain'}
375 : ($that and $that ne '*') ? $that
376 : '*';
377
378 return sub {
379 my $action = shift;
380
381 my %nomenu;
382 if ($action and $action =~ m{\Anomenu/(.*)\z}) {
383 $action = $1;
384 %nomenu = (nomenu => 1);
385 }
386 my $url = Sympa::get_url($robot_id, $action, %options, %nomenu);
387 $options{decode_html} ? Sympa::Tools::Text::encode_html($url) : $url;
388 };
389}
390
391sub parse {
392 my $self = shift;
393 my $data = shift;
394 my $tpl_string = shift;
395 my $output = shift;
396 my %options = @_;
397
398 my @include_path;
399 if (defined $self->{context}) {
400 push @include_path,
401 @{Sympa::get_search_path($self->{context}, %$self) || []};
402 }
403 if (@{$self->{include_path} || []}) {
404 push @include_path, @{$self->{include_path}};
405 }
406
407 my $config = {
408 ABSOLUTE => ($self->{allow_absolute} ? 1 : 0),
409 INCLUDE_PATH => [@include_path],
410 PLUGIN_BASE => 'Sympa::Template::Plugin',
411 # PRE_CHOMP => 1,
412 UNICODE => 0, # Prevent BOM auto-detection
413
414 FILTERS => {
415 unescape => \&CGI::Util::unescape,
416 l => [\&maketext, 1],
417 loc => [\&maketext, 1],
418 helploc => [\&maketext, 1],
419 locdt => [\&locdatetime, 1],
420 wrap => [\&wrap, 1],
421 mailbox => [\&_mailbox, 1],
422 mailto => [\&_mailto, 1],
423 mailtourl => [\&_mailtourl, 1],
424 obfuscate => [\&_obfuscate, 1],
425 optdesc => [sub { shift; $self->_optdesc_func(@_) }, 1],
426 qencode => [\&qencode, 0],
427 escape_cstr => [\&_escape_cstr, 0],
428 escape_xml => [\&_escape_xml, 0],
429 escape_url => [\&_escape_url, 0],
430 decode_utf8 => [\&decode_utf8, 0],
431 encode_utf8 => [\&encode_utf8, 0],
432 url_abs => [sub { shift; $self->_url_func(1, $data, @_) }, 1],
433 url_rel => [sub { shift; $self->_url_func(0, $data, @_) }, 1],
434 canonic_email => \&Sympa::Tools::Text::canonic_email,
435 }
436 };
437
438 #unless ($options->{'is_not_template'}) {
439 # $config->{'INCLUDE_PATH'} = $self->{include_path};
440 #}
441
442 # An array can be used as a template (instead of a filename)
443 if (ref $tpl_string eq 'ARRAY') {
444 $tpl_string = \join('', @$tpl_string);
445 }
446 # body is separated by an empty line.
447 if ($options{'has_header'}) {
448 if (ref $tpl_string) {
449 $tpl_string = \("\n" . $$tpl_string);
450 } else {
451 $tpl_string = \"\n[% PROCESS $tpl_string %]";
452 }
453 }
454
455 my $tt2 = Template->new($config)
456 or die "Template error: " . Template->error();
457
458 # Set language if possible: Must be restored later
459 $language->push_lang($data->{lang} || undef);
460
461 unless ($tt2->process($tpl_string, $data, $output)) {
462 $self->{last_error} = $tt2->error();
463
464 $language->pop_lang;
465 return undef;
466 } else {
467 delete $self->{last_error};
468
469 $language->pop_lang;
470 return 1;
471 }
472}
473
4741;
475__END__