← 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:11 2021

Filename/usr/local/libexec/sympa/Sympa/HTMLDecorator.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sSympa::HTMLDecorator::::BEGIN@27Sympa::HTMLDecorator::BEGIN@27
0000s0sSympa::HTMLDecorator::::BEGIN@28Sympa::HTMLDecorator::BEGIN@28
0000s0sSympa::HTMLDecorator::::BEGIN@30Sympa::HTMLDecorator::BEGIN@30
0000s0sSympa::HTMLDecorator::::BEGIN@31Sympa::HTMLDecorator::BEGIN@31
0000s0sSympa::HTMLDecorator::::BEGIN@32Sympa::HTMLDecorator::BEGIN@32
0000s0sSympa::HTMLDecorator::::BEGIN@34Sympa::HTMLDecorator::BEGIN@34
0000s0sSympa::HTMLDecorator::::__ANON__Sympa::HTMLDecorator::__ANON__ (xsub)
0000s0sSympa::HTMLDecorator::::_decorate_email_jsSympa::HTMLDecorator::_decorate_email_js
0000s0sSympa::HTMLDecorator::::_defaultSympa::HTMLDecorator::_default
0000s0sSympa::HTMLDecorator::::_endSympa::HTMLDecorator::_end
0000s0sSympa::HTMLDecorator::::_end_documentSympa::HTMLDecorator::_end_document
0000s0sSympa::HTMLDecorator::::_new_instanceSympa::HTMLDecorator::_new_instance
0000s0sSympa::HTMLDecorator::::_queue_clearSympa::HTMLDecorator::_queue_clear
0000s0sSympa::HTMLDecorator::::_queue_flushSympa::HTMLDecorator::_queue_flush
0000s0sSympa::HTMLDecorator::::_queue_pushSympa::HTMLDecorator::_queue_push
0000s0sSympa::HTMLDecorator::::_queue_shiftSympa::HTMLDecorator::_queue_shift
0000s0sSympa::HTMLDecorator::::_queue_tagnameSympa::HTMLDecorator::_queue_tagname
0000s0sSympa::HTMLDecorator::::_startSympa::HTMLDecorator::_start
0000s0sSympa::HTMLDecorator::::_start_documentSympa::HTMLDecorator::_start_document
0000s0sSympa::HTMLDecorator::::_textSympa::HTMLDecorator::_text
0000s0sSympa::HTMLDecorator::::decorateSympa::HTMLDecorator::decorate
0000s0sSympa::HTMLDecorator::::decorate_email_atSympa::HTMLDecorator::decorate_email_at
0000s0sSympa::HTMLDecorator::::decorate_email_concealedSympa::HTMLDecorator::decorate_email_concealed
0000s0sSympa::HTMLDecorator::::decorate_email_jsSympa::HTMLDecorator::decorate_email_js
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#
12# This program is free software; you can redistribute it and/or modify
13# it under the terms of the GNU General Public License as published by
14# the Free Software Foundation; either version 2 of the License, or
15# (at your option) any later version.
16#
17# This program is distributed in the hope that it will be useful,
18# but WITHOUT ANY WARRANTY; without even the implied warranty of
19# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20# GNU General Public License for more details.
21#
22# You should have received a copy of the GNU General Public License
23# along with this program. If not, see <http://www.gnu.org/licenses/>.
24
25package Sympa::HTMLDecorator;
26
27use strict;
28use warnings;
29
30use Sympa::Language;
31use Sympa::Regexps;
32use Sympa::Tools::Text;
33
34use base qw(HTML::Parser Class::Singleton);
35
36# Class::Singleton constructor.
37sub _new_instance {
38 return shift->SUPER::new(
39 api_version => 3,
40 default_h => [\&_default, 'self,text'],
41 end_h => [\&_end, 'self,event,tagname,text'],
42 end_document_h => [\&_end_document, 'self'],
43 start_h => [\&_start, 'self,event,tagname,attr,text'],
44 start_document_h => [\&_start_document, 'self'],
45 text_h => [\&_text, 'self,event,text'],
46 empty_element_tags => 1,
47 unbroken_text => 1,
48 );
49}
50
51sub _default {
52 my $self = shift;
53 my $text = shift;
54
55 $self->_queue_flush;
56 $self->{_shdOutput} .= $text;
57}
58
59sub _end {
60 my $self = shift;
61 my %options;
62 @options{qw(event tagname text)} = @_;
63
64 if ($self->_queue_tagname eq 'a') {
65 $self->_queue_push(%options);
66 if (lc $options{tagname} eq 'a') {
67 $self->_queue_flush;
68 }
69 return;
70 }
71
72 $self->_queue_flush;
73 $self->{_shdOutput} .= $options{text};
74}
75
76sub _end_document {
77 my $self = shift;
78
79 $self->_queue_flush;
80}
81
82sub _start {
83 my $self = shift;
84 my %options;
85 @options{qw(event tagname attr text)} = @_;
86
87 if ($self->_queue_tagname eq 'a') {
88 unless (grep { lc $options{tagname} eq $_ } qw(a script)) {
89 $self->_queue_push(%options);
90 return;
91 }
92 }
93
94 if ( lc $options{tagname} eq 'a'
95 and $options{attr}
96 and $options{attr}->{href}
97 and $options{attr}->{href} =~ /\Amailto:/i) {
98 $self->_queue_flush;
99 $self->_queue_push(%options);
100 return;
101 }
102
103 $self->_queue_flush;
104 $self->{_shdOutput} .= $options{text};
105}
106
107sub _start_document {
108 my $self = shift;
109
110 $self->{_shdOutput} = '';
111 $self->_queue_clear;
112}
113
114sub _text {
115 my $self = shift;
116 my %options;
117 @options{qw(event text)} = @_;
118
119 my $dtext = Sympa::Tools::Text::decode_html($options{text});
120 my $email_re = Sympa::Regexps::addrspec();
121
122 if ($self->_queue_tagname eq 'a' or $dtext =~ /\b$email_re\b/) {
123 $self->_queue_push(%options);
124 return;
125 }
126
127 $self->_queue_flush;
128 $self->{_shdOutput} .= $options{text};
129 return;
130}
131
132sub _queue_clear {
133 my $self = shift;
134
135 $self->{_shdEmailQueued} = [];
136}
137
138sub _queue_flush {
139 my $self = shift;
140
141 return unless @{$self->{_shdEmailQueued}};
142
143 if (my $func = $self->{_shdEmailFunc}) {
144 $self->{_shdOutput} .= $self->$func();
145 } else {
146 while (my $item = $self->_queue_shift) {
147 $self->{_shdOutput} .= $item->{text};
148 }
149 }
150 $self->_queue_clear;
151}
152
153sub _queue_push {
154 my $self = shift;
155 my %options = @_;
156
157 push @{$self->{_shdEmailQueued}}, {%options};
158}
159
160sub _queue_shift {
161 my $self = shift;
162
163 return shift @{$self->{_shdEmailQueued}};
164}
165
166sub _queue_tagname {
167 my $self = shift;
168
169 if ( @{$self->{_shdEmailQueued}}
170 and $self->{_shdEmailQueued}->[0]->{event} eq 'start'
171 and lc $self->{_shdEmailQueued}->[0]->{tagname} eq 'a') {
172 return 'a';
173 } else {
174 return '';
175 }
176}
177
178sub decorate {
179 my $self = shift;
180 my $html = shift;
181 my %options = @_;
182
183 return $html unless defined $html and length $html;
184
185 $self->{_shdEmailFunc} = {
186 at => \&decorate_email_at,
187 concealed => \&decorate_email_concealed,
188 gecos => \&decorate_email_concealed, # compat.<=6.2.61b
189 javascript => \&decorate_email_js
190 }->{$options{email} // ''};
191 # No decoration needed.
192 return $html unless $self->{_shdEmailFunc};
193
194 if ($html =~ /[<>]/) {
195 $self->parse($html);
196 $self->eof;
197 } else {
198 $self->_start_document;
199 $self->_text('text', $html);
200 $self->_end_document;
201 }
202 return $self->{_shdOutput};
203}
204
205sub decorate_email_at {
206 my $self = shift;
207
208 my $decorated = '';
209 my $email_re = Sympa::Regexps::addrspec();
210 while (my $item = $self->_queue_shift) {
211 if ($item->{event} eq 'text') {
212 my $dtext = Sympa::Tools::Text::decode_html($item->{text});
213 if ($dtext =~ s{\b($email_re)\b}{join ' AT ', split(/\@/, $1)}eg)
214 {
215 $decorated .= Sympa::Tools::Text::encode_html($dtext);
216 } else {
217 $decorated .= $item->{text};
218 }
219 } elsif ($item->{event} eq 'start') {
220 my $text = $item->{text};
221 if ($text =~ s{\b(href=\S+)}{join '%20AT%20', split(/\@/, $1)}egi)
222 {
223 $decorated .= $text;
224 } else {
225 $decorated .= $item->{text};
226 }
227 } else {
228 $decorated .= $item->{text};
229 }
230 }
231 return $decorated;
232}
233
234sub decorate_email_concealed {
235 my $self = shift;
236
237 my $decorated = '';
238 my $email_re = Sympa::Regexps::addrspec();
239 my $language = Sympa::Language->instance;
240 while (my $item = $self->_queue_shift) {
241 if ($item->{event} eq 'text') {
242 my $dtext = Sympa::Tools::Text::decode_html($item->{text});
243 my $replacement = $language->gettext('address@concealed');
244 if ($dtext =~ s{\b($email_re)\b}{$replacement}g) {
245 $decorated .= Sympa::Tools::Text::encode_html($dtext);
246 } else {
247 $decorated .= $item->{text};
248 }
249 } elsif ($item->{event} eq 'start'
250 and $item->{attr}
251 and 0 == index(lc($item->{attr}->{href} // ''), 'mailto:')) {
252 # Empties mailto URL in link target
253 my $text = $item->{text};
254 $text =~ s{(?<=\bhref=)[^\s>]+}{"mailto:"}gi;
255 $decorated .= $text;
256 } else {
257 $decorated .= $item->{text};
258 }
259 }
260
261 return $decorated;
262}
263
264sub decorate_email_js {
265 my $self = shift;
266
267 my $text = '';
268 while (my $item = $self->_queue_shift) {
269 $text .= $item->{text};
270 }
271
272 if (index($text, '<') == 0) {
273 return _decorate_email_js($text);
274 }
275
276 my $decorated = '';
277 my $email_re = Sympa::Regexps::addrspec();
278 my $dtext = Sympa::Tools::Text::decode_html($text);
279 pos $dtext = 0;
280 while ($dtext =~ /\G((?:\n|.)*?)\b($email_re)\b/cg) {
281 $decorated .=
282 Sympa::Tools::Text::encode_html($1)
283 . _decorate_email_js(Sympa::Tools::Text::encode_html($2));
284 }
285 if (pos $dtext) {
286 return $decorated
287 . Sympa::Tools::Text::encode_html(substr $dtext, pos $dtext);
288 }
289
290 return $text;
291}
292
293sub _decorate_email_js {
294 my $text = shift;
295
296 my @texts = map {
297 my $str = (defined $_) ? $_ : '';
298 $str =~ s/([\\\"])/\\$1/g;
299 $str =~ s/\r\n|\r|\n/\\n/g;
300 $str =~ s/\t/\\t/g;
301 $str;
302 } split /\b|(?=\@)|(?<=\@)/, $text;
303 return
304 sprintf '<script type="text/javascript">' . "\n" . '<!--' . "\n"
305 . 'document.write(%s)' . "\n"
306 . '// -->' . "\n"
307 . '</script>',
308 join(" +\n", map { '"' . $_ . '"' } @texts);
309}
310
3111;
312__END__