Filename | /usr/local/libexec/sympa/Sympa/Task.pm |
Statements | Executed 219829 statements in 316ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
5750 | 1 | 1 | 102ms | 1.08s | _chk_line | Sympa::Task::
1150 | 1 | 1 | 94.2ms | 2.05s | _parse | Sympa::Task::
2300 | 1 | 1 | 52.4ms | 477ms | _chk_cmd | Sympa::Task::
2527 | 2 | 2 | 47.4ms | 2.38s | new | Sympa::Task::
34842 | 8 | 1 | 28.3ms | 28.3ms | CORE:match (opcode) | Sympa::Task::
4715 | 2 | 1 | 11.8ms | 11.8ms | CORE:regcomp (opcode) | Sympa::Task::
1150 | 1 | 1 | 3.81ms | 3.81ms | get_id | Sympa::Task::
2415 | 1 | 1 | 3.13ms | 3.13ms | CORE:subst (opcode) | Sympa::Task::
0 | 0 | 0 | 0s | 0s | BEGIN@30 | Sympa::Task::
0 | 0 | 0 | 0s | 0s | BEGIN@31 | Sympa::Task::
0 | 0 | 0 | 0s | 0s | BEGIN@32 | Sympa::Task::
0 | 0 | 0 | 0s | 0s | BEGIN@33 | Sympa::Task::
0 | 0 | 0 | 0s | 0s | BEGIN@35 | Sympa::Task::
0 | 0 | 0 | 0s | 0s | BEGIN@36 | Sympa::Task::
0 | 0 | 0 | 0s | 0s | BEGIN@37 | Sympa::Task::
0 | 0 | 0 | 0s | 0s | BEGIN@38 | Sympa::Task::
0 | 0 | 0 | 0s | 0s | BEGIN@39 | Sympa::Task::
0 | 0 | 0 | 0s | 0s | BEGIN@45 | Sympa::Task::
0 | 0 | 0 | 0s | 0s | BEGIN@52 | Sympa::Task::
0 | 0 | 0 | 0s | 0s | __ANON__ (xsub) | Sympa::Task::
0 | 0 | 0 | 0s | 0s | dup | Sympa::Task::
0 | 0 | 0 | 0s | 0s | get_tasks | Sympa::Task::
0 | 0 | 0 | 0s | 0s | lines | Sympa::Task::
0 | 0 | 0 | 0s | 0s | to_string | Sympa::Task::
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 2018 The Sympa Community. See the AUTHORS.md file at the | ||||
12 | # 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 | package Sympa::Task; | ||||
29 | |||||
30 | use strict; | ||||
31 | use warnings; | ||||
32 | use Scalar::Util; | ||||
33 | use Template; | ||||
34 | |||||
35 | use Sympa; | ||||
36 | use Conf; | ||||
37 | use Sympa::Language; | ||||
38 | use Sympa::Log; | ||||
39 | use Sympa::Tools::Data; | ||||
40 | |||||
41 | my $language = Sympa::Language->instance; | ||||
42 | my $log = Sympa::Log->instance; | ||||
43 | |||||
44 | # List of list task models. FIXME:Refer Sympa::ListDef. | ||||
45 | use constant list_models => { | ||||
46 | #expire => 'expire_task', # Not yet implemented. | ||||
47 | remind => 'remind_task', | ||||
48 | sync_include => '', | ||||
49 | }; | ||||
50 | |||||
51 | # List of global task models. FIXME:Refer Sympa::ConfDef. | ||||
52 | use constant site_models => { | ||||
53 | expire_bounce => 'expire_bounce_task', | ||||
54 | purge_user_table => 'purge_user_table_task', | ||||
55 | purge_logs_table => 'purge_logs_table_task', | ||||
56 | purge_session_table => 'purge_session_table_task', | ||||
57 | purge_spools => 'purge_spools_task', | ||||
58 | purge_tables => 'purge_tables_task', | ||||
59 | purge_one_time_ticket_table => 'purge_one_time_ticket_table_task', | ||||
60 | purge_orphan_bounces => 'purge_orphan_bounces_task', | ||||
61 | eval_bouncers => 'eval_bouncers_task', | ||||
62 | process_bouncers => 'process_bouncers_task', | ||||
63 | }; | ||||
64 | |||||
65 | # Creates a new Sympa::Task object. | ||||
66 | # Old name: create() in task_manager.pl, entirely rewritten. | ||||
67 | # spent 2.38s (47.4ms+2.34) within Sympa::Task::new which was called 2527 times, avg 943µs/call:
# 1377 times (25.3ms+286ms) by Sympa::Spool::Task::_create_all_tasks at line 107 of /usr/local/libexec/sympa/Sympa/Spool/Task.pm, avg 226µs/call
# 1150 times (22.0ms+2.05s) by Sympa::Spool::next at line 162 of /usr/local/libexec/sympa/Sympa/Spool.pm, avg 1.80ms/call | ||||
68 | 2527 | 704µs | my $class = shift; | ||
69 | # Optional serialized content. | ||||
70 | 2527 | 530µs | my $serialized; | ||
71 | 2527 | 8.22ms | 2527 | 2.19ms | if (@_ and ($_[0] eq '' or $_[0] =~ /\n/)) { # spent 2.19ms making 2527 calls to Sympa::Task::CORE:match, avg 868ns/call |
72 | $serialized = shift; | ||||
73 | } | ||||
74 | 2527 | 4.82ms | my %options = @_; | ||
75 | |||||
76 | die 'bug in logic. Ask developer' | ||||
77 | 2527 | 1.70ms | unless defined $options{model} and length $options{model}; | ||
78 | $options{context} = '*' | ||||
79 | 2527 | 1.67ms | unless ref $options{context} eq 'Sympa::List'; #FIXME | ||
80 | $options{date} = time | ||||
81 | 2527 | 663µs | unless defined $options{date}; | ||
82 | $options{label} = ($options{model} eq 'sync_include') ? 'INIT' : '' | ||||
83 | 2527 | 1.50ms | unless defined $options{label}; | ||
84 | |||||
85 | 2527 | 7.20ms | my $self = bless {%options} => $class; | ||
86 | |||||
87 | 2527 | 561µs | unless (defined $serialized) { | ||
88 | 1377 | 522µs | my $that = $self->{context}; | ||
89 | 1377 | 465µs | my $model = $self->{model}; | ||
90 | 1377 | 298µs | my $name; | ||
91 | my $pname; | ||||
92 | |||||
93 | 1377 | 3.13ms | if (defined $self->{name} and length $self->{name}) { | ||
94 | die 'bug in logic. Ask developer' | ||||
95 | unless $self->{name} =~ /\A\w+\z/; | ||||
96 | $name = $self->{name}; | ||||
97 | } elsif (ref $that eq 'Sympa::List' and $model eq 'sync_include') { | ||||
98 | $name = 'ttl'; | ||||
99 | } elsif (ref $that eq 'Sympa::List' | ||||
100 | and $pname = ${list_models()}{$model}) { | ||||
101 | $name = $that->{'admin'}{$pname}->{'name'}; | ||||
102 | } elsif ($that eq '*' and $pname = ${site_models()}{$model}) { | ||||
103 | $name = Conf::get_robot_conf($that, $pname); | ||||
104 | } else { | ||||
105 | $log->syslog('err', 'Unknown task %s for %s', $model, $that); | ||||
106 | return undef; | ||||
107 | } | ||||
108 | 1377 | 330µs | unless ($name) { | ||
109 | 1377 | 1.79ms | 1377 | 285ms | $log->syslog('debug3', 'Inactive task %s for %s', $model, $that); # spent 285ms making 1377 calls to Sympa::Log::syslog, avg 207µs/call |
110 | 1377 | 10.1ms | return undef; | ||
111 | } | ||||
112 | |||||
113 | my $model_name = sprintf '%s.%s.task', $model, $name; | ||||
114 | my $model_file = | ||||
115 | Sympa::search_fullpath($that, $model_name, subdir => 'tasks'); | ||||
116 | unless ($model_file) { | ||||
117 | $log->syslog('err', 'Unable to find task file %s for %s', | ||||
118 | $model_name, $that); | ||||
119 | return undef; | ||||
120 | } | ||||
121 | |||||
122 | # creation | ||||
123 | my $data = { | ||||
124 | creation_date => $self->{date}, # Compat., has never used | ||||
125 | execution_date => 'execution_date', # Compat. | ||||
126 | }; | ||||
127 | if (ref $that eq 'Sympa::List') { | ||||
128 | $data->{domain} = $that->{'domain'}; # New on 6.2.37b | ||||
129 | $data->{list} = { | ||||
130 | name => $that->{'name'}, | ||||
131 | robot => $that->{'domain'}, # Compat., has never used | ||||
132 | ttl => $that->{'admin'}{'ttl'}, | ||||
133 | }; | ||||
134 | } | ||||
135 | my $tt2 = Template->new( | ||||
136 | { 'START_TAG' => quotemeta('['), | ||||
137 | 'END_TAG' => quotemeta(']'), | ||||
138 | 'ABSOLUTE' => 1 | ||||
139 | } | ||||
140 | ); | ||||
141 | unless ($tt2 and $tt2->process($model_file, $data, \$serialized)) { | ||||
142 | $log->syslog('err', 'Failed to parse task template "%s": %s', | ||||
143 | $model_file, $tt2->error); | ||||
144 | return undef; | ||||
145 | } | ||||
146 | } | ||||
147 | |||||
148 | 1150 | 1.71ms | 1150 | 2.05s | unless ($self->_parse($serialized)) { # spent 2.05s making 1150 calls to Sympa::Task::_parse, avg 1.78ms/call |
149 | $log->syslog('err', 'Syntax error in task file. You should check %s', | ||||
150 | $self); | ||||
151 | return undef; | ||||
152 | } | ||||
153 | 1150 | 3.68ms | $self; | ||
154 | } | ||||
155 | |||||
156 | ### DEFINITION OF AVAILABLE COMMANDS FOR TASKS ### | ||||
157 | |||||
158 | my $date_arg_regexp1 = '\d+|execution_date'; | ||||
159 | my $date_arg_regexp2 = '(\d\d\d\dy)(\d+m)?(\d+d)?(\d+h)?(\d+min)?(\d+sec)?'; | ||||
160 | my $date_arg_regexp3 = | ||||
161 | '(\d+|execution_date)(\+|\-)(\d+y)?(\d+m)?(\d+w)?(\d+d)?(\d+h)?(\d+min)?(\d+sec)?'; | ||||
162 | my $delay_regexp = '(\d+y)?(\d+m)?(\d+w)?(\d+d)?(\d+h)?(\d+min)?(\d+sec)?'; | ||||
163 | my $var_regexp = '@\w+'; | ||||
164 | my $subarg_regexp = '(\w+)(|\((.*)\))'; | ||||
165 | |||||
166 | # commands which use a variable. If you add such a command, the first | ||||
167 | # parameter must be the variable | ||||
168 | my %var_commands = ( | ||||
169 | 'delete_subs' => ['var'], | ||||
170 | # variable | ||||
171 | 'send_msg' => ['var', '\w+'], | ||||
172 | #variable template | ||||
173 | 'rm_file' => ['var'], | ||||
174 | # variable | ||||
175 | ); | ||||
176 | |||||
177 | # commands which are used for assignments | ||||
178 | my %asgn_commands = ( | ||||
179 | 'select_subs' => ['subarg'], | ||||
180 | # condition | ||||
181 | 'delete_subs' => ['var'], | ||||
182 | # variable | ||||
183 | ); | ||||
184 | |||||
185 | # regular commands | ||||
186 | my %commands = ( | ||||
187 | 'next' => ['date', '\w*'], | ||||
188 | # date label | ||||
189 | 'stop' => [], | ||||
190 | 'create' => ['subarg', '\w+', '\w+'], | ||||
191 | #object model model choice | ||||
192 | 'exec' => ['.+'], | ||||
193 | #file #delay | ||||
194 | 'expire_bounce' => ['\d+'], | ||||
195 | #template date | ||||
196 | 'sync_include' => [], | ||||
197 | 'purge_user_table' => [], | ||||
198 | 'purge_logs_table' => [], | ||||
199 | 'purge_session_table' => [], | ||||
200 | 'purge_spools' => [], | ||||
201 | 'purge_tables' => [], | ||||
202 | 'purge_one_time_ticket_table' => [], | ||||
203 | 'purge_orphan_bounces' => [], | ||||
204 | 'eval_bouncers' => [], | ||||
205 | 'process_bouncers' => [], | ||||
206 | %var_commands, | ||||
207 | %asgn_commands, | ||||
208 | ); | ||||
209 | |||||
210 | ### SYNTAX CHECKING SUBROUTINES ### | ||||
211 | |||||
212 | # Check the syntax of a task. | ||||
213 | # Old name: check() in task_manager.pl. | ||||
214 | # spent 2.05s (94.2ms+1.95) within Sympa::Task::_parse which was called 1150 times, avg 1.78ms/call:
# 1150 times (94.2ms+1.95s) by Sympa::Task::new at line 148, avg 1.78ms/call | ||||
215 | 1150 | 1.30ms | 1150 | 210ms | $log->syslog('debug2', '(%s, ...)', @_); # spent 210ms making 1150 calls to Sympa::Log::syslog, avg 183µs/call |
216 | 1150 | 344µs | my $self = shift; | ||
217 | 1150 | 261µs | my $serialized = shift; | ||
218 | |||||
219 | 1150 | 296µs | my $lnb = 0; # line number | ||
220 | 1150 | 215µs | my %used_labels; # list of labels used as parameter in commands | ||
221 | my %labels; # list of declared labels | ||||
222 | my %used_vars; # list of vars used as parameter in commands | ||||
223 | my %vars; # list of declared vars | ||||
224 | |||||
225 | 1150 | 298µs | return undef unless defined $serialized; | ||
226 | 1150 | 728µs | $self->{_source} = $serialized; | ||
227 | 1150 | 854µs | $self->{_title} = {}; | ||
228 | 1150 | 1.52ms | $self->{_parsed} = []; | ||
229 | |||||
230 | 1150 | 6.98ms | foreach my $line (split /\r\n|\r|\n/, $serialized) { | ||
231 | 5750 | 762µs | $lnb++; | ||
232 | 5750 | 32.7ms | 5750 | 2.03ms | next if $line =~ /^\s*\#/; # spent 2.03ms making 5750 calls to Sympa::Task::CORE:match, avg 354ns/call |
233 | |||||
234 | 5750 | 978µs | my %result; | ||
235 | |||||
236 | 5750 | 5.90ms | 5750 | 1.08s | unless (_chk_line($line, \%result)) { # spent 1.08s making 5750 calls to Sympa::Task::_chk_line, avg 188µs/call |
237 | $log->syslog('err', 'Error at line %s: %s', $lnb, $line); | ||||
238 | $log->syslog('err', '%s', $result{'error'}); | ||||
239 | return undef; | ||||
240 | } | ||||
241 | |||||
242 | 5750 | 7.84ms | 2300 | 477ms | if ($result{'nature'} eq 'assignment') { # spent 477ms making 2300 calls to Sympa::Task::_chk_cmd, avg 207µs/call |
243 | if (_chk_cmd( | ||||
244 | $result{'command'}, $lnb, | ||||
245 | $result{'Rarguments'}, \%used_labels, | ||||
246 | \%used_vars | ||||
247 | ) | ||||
248 | ) { | ||||
249 | $vars{$result{'var'}} = 1; | ||||
250 | } else { | ||||
251 | return undef; | ||||
252 | } | ||||
253 | } elsif ($result{'nature'} eq 'command') { | ||||
254 | return undef | ||||
255 | unless _chk_cmd($result{'command'}, $lnb, | ||||
256 | $result{'Rarguments'}, \%used_labels, \%used_vars); | ||||
257 | } elsif ($result{'nature'} eq 'label') { | ||||
258 | $labels{$result{'label'}} = 1; | ||||
259 | } elsif ($result{'nature'} eq 'title') { | ||||
260 | 1150 | 1.09ms | $self->{_title}->{$result{'lang'}} = $result{'title'}; | ||
261 | 1150 | 1.21ms | next; | ||
262 | } else { | ||||
263 | 1150 | 821µs | next; | ||
264 | } | ||||
265 | |||||
266 | 3450 | 11.2ms | push @{$self->{_parsed}}, {%result, line => $lnb}; | ||
267 | } | ||||
268 | |||||
269 | # are all labels used ? | ||||
270 | 1150 | 1.05ms | foreach my $label (keys %labels) { | ||
271 | $log->syslog('debug3', 'Warning: Label %s exists but is not used', | ||||
272 | $label) | ||||
273 | 1150 | 529µs | unless $used_labels{$label}; | ||
274 | } | ||||
275 | |||||
276 | # do all used labels exist ? | ||||
277 | 1150 | 625µs | foreach my $label (keys %used_labels) { | ||
278 | 1150 | 365µs | unless ($labels{$label}) { | ||
279 | $log->syslog('err', 'Label %s is used but does not exist', | ||||
280 | $label); | ||||
281 | return undef; | ||||
282 | } | ||||
283 | } | ||||
284 | |||||
285 | # are all variables used ? | ||||
286 | 1150 | 531µs | foreach my $var (keys %vars) { | ||
287 | $log->syslog('notice', 'Warning: Var %s exists but is not used', $var) | ||||
288 | unless $used_vars{$var}; | ||||
289 | } | ||||
290 | |||||
291 | # do all used variables exist ? | ||||
292 | 1150 | 469µs | foreach my $var (keys %used_vars) { | ||
293 | unless ($vars{$var}) { | ||||
294 | $log->syslog('err', 'Var %s is used but does not exist', $var); | ||||
295 | return undef; | ||||
296 | } | ||||
297 | } | ||||
298 | |||||
299 | # Set the title in the current language. | ||||
300 | 1150 | 600µs | my $titles = $self->{_title} || {}; | ||
301 | 1150 | 3.44ms | 2300 | 40.3ms | foreach my $lang (Sympa::Language::implicated_langs($language->get_lang)) # spent 38.5ms making 1150 calls to Sympa::Language::implicated_langs, avg 34µs/call
# spent 1.78ms making 1150 calls to Sympa::Language::get_lang, avg 2µs/call |
302 | { | ||||
303 | 1150 | 623µs | if (exists $titles->{$lang}) { | ||
304 | $self->{title} = $titles->{$lang}; | ||||
305 | last; | ||||
306 | } | ||||
307 | } | ||||
308 | 1150 | 2.92ms | 1150 | 144ms | if ($self->{title}) { # spent 144ms making 1150 calls to Sympa::Language::gettext, avg 125µs/call |
309 | ; | ||||
310 | } elsif (exists $titles->{gettext}) { | ||||
311 | $self->{title} = $language->gettext($titles->{gettext}); | ||||
312 | } elsif (exists $titles->{default}) { | ||||
313 | $self->{title} = $titles->{default}; | ||||
314 | } else { | ||||
315 | $self->{title} = $self->{name} || $self->{model}; | ||||
316 | } | ||||
317 | |||||
318 | 1150 | 7.30ms | return 1; | ||
319 | } | ||||
320 | |||||
321 | # Check a task line. | ||||
322 | # Old name: chk_line() in task_manager.pl. | ||||
323 | # spent 1.08s (102ms+978ms) within Sympa::Task::_chk_line which was called 5750 times, avg 188µs/call:
# 5750 times (102ms+978ms) by Sympa::Task::_parse at line 236, avg 188µs/call | ||||
324 | 5750 | 1.58ms | my $line = shift; | ||
325 | 5750 | 846µs | my $Rhash = shift; | ||
326 | |||||
327 | ## just in case... | ||||
328 | 5750 | 1.68ms | chomp $line; | ||
329 | |||||
330 | 5750 | 9.31ms | 5750 | 961ms | $log->syslog('debug2', '(%s, %s)', $line, $Rhash->{'nature'}); # spent 961ms making 5750 calls to Sympa::Log::syslog, avg 167µs/call |
331 | |||||
332 | 5750 | 2.52ms | $Rhash->{'nature'} = undef; | ||
333 | |||||
334 | # empty line | ||||
335 | 5750 | 1.38ms | unless (length $line) { | ||
336 | 1150 | 481µs | $Rhash->{'nature'} = 'empty line'; | ||
337 | 1150 | 1.50ms | return 1; | ||
338 | } | ||||
339 | |||||
340 | # comment | ||||
341 | 4600 | 12.6ms | 4600 | 2.02ms | if ($line =~ /^\s*\#.*/) { # spent 2.02ms making 4600 calls to Sympa::Task::CORE:match, avg 439ns/call |
342 | $Rhash->{'nature'} = 'comment'; | ||||
343 | return 1; | ||||
344 | } | ||||
345 | |||||
346 | # title | ||||
347 | #FIXME:Currently not used. | ||||
348 | 4600 | 16.4ms | 11500 | 6.40ms | if ($line =~ /^\s*title\.gettext\s+(.*)\s*$/i) { # spent 6.40ms making 11500 calls to Sympa::Task::CORE:match, avg 556ns/call |
349 | 1150 | 2.58ms | @{$Rhash}{qw(nature title lang)} = ('title', $1, 'gettext'); | ||
350 | 1150 | 2.01ms | return 1; | ||
351 | } elsif ($line =~ /^\s*title\.(\S+)\s+(.*)\s*$/i) { | ||||
352 | my ($lang, $title) = ($1, $2); | ||||
353 | # canonicalize lang if possible. | ||||
354 | $lang = Sympa::Language::canonic_lang($lang) || $lang; | ||||
355 | @{$Rhash}{qw(nature title lang)} = ('title', $title, $lang); | ||||
356 | return 1; | ||||
357 | } elsif ($line =~ /^\s*title\s+(.*)\s*$/i) { | ||||
358 | @{$Rhash}{qw(nature title lang)} = ('title', $1, 'default'); | ||||
359 | return 1; | ||||
360 | } | ||||
361 | |||||
362 | # label | ||||
363 | 3450 | 5.96ms | 3450 | 2.28ms | if ($line =~ /^\s*\/\s*(.*)/) { # spent 2.28ms making 3450 calls to Sympa::Task::CORE:match, avg 660ns/call |
364 | 1150 | 529µs | $Rhash->{'nature'} = 'label'; | ||
365 | 1150 | 950µs | $Rhash->{'label'} = $1; | ||
366 | 1150 | 1.63ms | return 1; | ||
367 | } | ||||
368 | |||||
369 | # command | ||||
370 | 2300 | 6.12ms | 2300 | 3.63ms | if ($line =~ /^\s*(\w+)\s*\((.*)\)\s*/i) { # spent 3.63ms making 2300 calls to Sympa::Task::CORE:match, avg 2µs/call |
371 | |||||
372 | 2300 | 2.19ms | my $command = lc($1); | ||
373 | 2300 | 2.60ms | my @args = split(/,/, $2); | ||
374 | 4715 | 13.5ms | 2415 | 3.13ms | foreach (@args) { s/\s//g; } # spent 3.13ms making 2415 calls to Sympa::Task::CORE:subst, avg 1µs/call |
375 | |||||
376 | 2300 | 1.13ms | unless ($commands{$command}) { | ||
377 | $Rhash->{'nature'} = 'error'; | ||||
378 | $Rhash->{'error'} = "unknown command $command"; | ||||
379 | return 0; | ||||
380 | } | ||||
381 | |||||
382 | 2300 | 795µs | $Rhash->{'nature'} = 'command'; | ||
383 | 2300 | 934µs | $Rhash->{'command'} = $command; | ||
384 | |||||
385 | # arguments recovery. no checking of their syntax !!! | ||||
386 | 2300 | 1.13ms | $Rhash->{'Rarguments'} = \@args; | ||
387 | 2300 | 3.89ms | return 1; | ||
388 | } | ||||
389 | |||||
390 | # assignment | ||||
391 | if ($line =~ /^\s*(@\w+)\s*=\s*(.+)/) { | ||||
392 | my %hash2; | ||||
393 | _chk_line($2, \%hash2); | ||||
394 | unless ($asgn_commands{$hash2{'command'}}) { | ||||
395 | $Rhash->{'nature'} = 'error'; | ||||
396 | $Rhash->{'error'} = "non valid assignment $2"; | ||||
397 | return 0; | ||||
398 | } | ||||
399 | $Rhash->{'nature'} = 'assignment'; | ||||
400 | $Rhash->{'var'} = $1; | ||||
401 | $Rhash->{'command'} = $hash2{'command'}; | ||||
402 | $Rhash->{'Rarguments'} = $hash2{'Rarguments'}; | ||||
403 | return 1; | ||||
404 | } | ||||
405 | |||||
406 | $Rhash->{'nature'} = 'error'; | ||||
407 | $Rhash->{'error'} = 'syntax error'; | ||||
408 | return 0; | ||||
409 | } | ||||
410 | |||||
411 | # Check the arguments of a command. | ||||
412 | # Old name: chk_cmd() in task_manager.pl. | ||||
413 | # spent 477ms (52.4+424) within Sympa::Task::_chk_cmd which was called 2300 times, avg 207µs/call:
# 2300 times (52.4ms+424ms) by Sympa::Task::_parse at line 242, avg 207µs/call | ||||
414 | 2300 | 2.55ms | 2300 | 403ms | $log->syslog('debug2', '(%s, %d, %s)', @_); # spent 403ms making 2300 calls to Sympa::Log::syslog, avg 175µs/call |
415 | 2300 | 824µs | my $cmd = shift; # command name | ||
416 | 2300 | 371µs | my $lnb = shift; # line number | ||
417 | 2300 | 373µs | my $Rargs = shift; # argument list | ||
418 | 2300 | 351µs | my $Rused_labels = shift; | ||
419 | 2300 | 354µs | my $Rused_vars = shift; | ||
420 | |||||
421 | 2300 | 1.16ms | if (defined $commands{$cmd}) { | ||
422 | 2300 | 1.67ms | my @expected_args = @{$commands{$cmd}}; | ||
423 | |||||
424 | 2300 | 857µs | unless (scalar(@expected_args) == scalar(@$Rargs)) { | ||
425 | $log->syslog('err', | ||||
426 | 'Error at line %s: wrong number of arguments for %s', | ||||
427 | $lnb, $cmd); | ||||
428 | $log->syslog( | ||||
429 | 'err', | ||||
430 | 'Args = %s; expected_args = %s', | ||||
431 | join(',', @$Rargs), | ||||
432 | join(',', @expected_args) | ||||
433 | ); | ||||
434 | return undef; | ||||
435 | } | ||||
436 | |||||
437 | 2300 | 1.45ms | foreach my $arg (@$Rargs) { | ||
438 | 2415 | 324µs | my $error; | ||
439 | 2415 | 733µs | my $regexp = shift @expected_args; | ||
440 | |||||
441 | 2415 | 1.63ms | if ($regexp eq 'date') { | ||
442 | 1150 | 30.2ms | 6900 | 12.0ms | $error = 1 # spent 8.55ms making 3450 calls to Sympa::Task::CORE:match, avg 2µs/call
# spent 3.43ms making 3450 calls to Sympa::Task::CORE:regcomp, avg 993ns/call |
443 | unless $arg =~ /^$date_arg_regexp1$/i | ||||
444 | or $arg =~ /^$date_arg_regexp2$/i | ||||
445 | or $arg =~ /^$date_arg_regexp3$/i; | ||||
446 | } elsif ($regexp eq 'delay') { | ||||
447 | $error = 1 unless $arg =~ /^$delay_regexp$/i; | ||||
448 | } elsif ($regexp eq 'var') { | ||||
449 | $error = 1 unless $arg =~ /^$var_regexp$/i; | ||||
450 | } elsif ($regexp eq 'subarg') { | ||||
451 | $error = 1 unless $arg =~ /^$subarg_regexp$/i; | ||||
452 | } else { | ||||
453 | 1265 | 23.1ms | 2530 | 9.53ms | $error = 1 unless $arg =~ /^$regexp$/i; # spent 8.37ms making 1265 calls to Sympa::Task::CORE:regcomp, avg 7µs/call
# spent 1.16ms making 1265 calls to Sympa::Task::CORE:match, avg 916ns/call |
454 | } | ||||
455 | |||||
456 | 2415 | 427µs | if ($error) { | ||
457 | $log->syslog('err', | ||||
458 | 'Error at line %s: argument %s is not valid', | ||||
459 | $lnb, $arg); | ||||
460 | return undef; | ||||
461 | } | ||||
462 | |||||
463 | 2415 | 2.18ms | $Rused_labels->{$Rargs->[1]} = 1 | ||
464 | if $cmd eq 'next' and $Rargs->[1]; | ||||
465 | $Rused_vars->{$Rargs->[0]} = 1 | ||||
466 | 2415 | 1.32ms | if $var_commands{$cmd}; | ||
467 | } | ||||
468 | } | ||||
469 | 2300 | 3.76ms | return 1; | ||
470 | } | ||||
471 | |||||
472 | sub dup { | ||||
473 | my $self = shift; | ||||
474 | |||||
475 | my $clone = {}; | ||||
476 | foreach my $key (sort keys %$self) { | ||||
477 | my $val = $self->{$key}; | ||||
478 | next unless defined $val; | ||||
479 | |||||
480 | unless (Scalar::Util::blessed($val)) { | ||||
481 | $clone->{$key} = Sympa::Tools::Data::dup_var($val); | ||||
482 | } elsif ($val->can('dup') and !$val->isa('Sympa::List')) { | ||||
483 | $clone->{$key} = $val->dup; | ||||
484 | } else { | ||||
485 | $clone->{$key} = $val; | ||||
486 | } | ||||
487 | } | ||||
488 | |||||
489 | return bless $clone => ref($self); | ||||
490 | } | ||||
491 | |||||
492 | sub to_string { | ||||
493 | shift->{_source}; | ||||
494 | } | ||||
495 | |||||
496 | sub lines { | ||||
497 | @{shift->{_parsed} || []}; | ||||
498 | } | ||||
499 | |||||
500 | # Old name: Sympa::List::load_task_list() which returned hashref. | ||||
501 | sub get_tasks { | ||||
502 | $log->syslog('debug2', '(%s, %s)', @_); | ||||
503 | my $that = shift; | ||||
504 | my $model = shift; | ||||
505 | |||||
506 | my %tasks; | ||||
507 | |||||
508 | foreach my $dir (@{Sympa::get_search_path($that, subdir => 'tasks')}) { | ||||
509 | my $dh; | ||||
510 | opendir $dh, $dir or next; | ||||
511 | foreach my $file (readdir $dh) { | ||||
512 | next unless $file =~ /\A$model[.](\w+)[.]task\z/; | ||||
513 | my $name = $1; | ||||
514 | next if $tasks{$name}; | ||||
515 | |||||
516 | my $task = Sympa::Task->new( | ||||
517 | context => $that, | ||||
518 | model => $model, | ||||
519 | name => $name | ||||
520 | ); | ||||
521 | next unless $task; | ||||
522 | |||||
523 | $tasks{$name} = $task; | ||||
524 | } | ||||
525 | closedir $dh; | ||||
526 | } | ||||
527 | |||||
528 | return [map { $tasks{$_} } sort keys %tasks]; | ||||
529 | } | ||||
530 | |||||
531 | ## Build all Sympa::Task objects | ||||
532 | # No longer used. Use Sympa::Spool::Task::next(). | ||||
533 | #sub list_tasks; | ||||
534 | |||||
535 | ## Return a list tasks for the given list | ||||
536 | # No longer used. Use Sympa::Spool::Task::next(). | ||||
537 | #sub get_tasks_by_list; | ||||
538 | |||||
539 | # No longer used. | ||||
540 | #sub get_used_models; | ||||
541 | |||||
542 | # No longer used. Use Sympa::Spool::Task::next(). | ||||
543 | #sub get_task_list; | ||||
544 | |||||
545 | ## sort task name by their epoch date | ||||
546 | # No longer used. | ||||
547 | #sub epoch_sort; | ||||
548 | |||||
549 | # spent 3.81ms within Sympa::Task::get_id which was called 1150 times, avg 3µs/call:
# 1150 times (3.81ms+0s) by Sympa::Log::syslog at line 112 of /usr/local/libexec/sympa/Sympa/Log.pm, avg 3µs/call | ||||
550 | 1150 | 335µs | my $self = shift; | ||
551 | sprintf 'date=%s;label=%s;model=%s;context=%s', | ||||
552 | @{$self}{qw(date label model)}, | ||||
553 | 1150 | 4.18ms | (ref $self->{context} ? $self->{context}->get_id : '*'); | ||
554 | } | ||||
555 | |||||
556 | 1; | ||||
557 | __END__ | ||||
# spent 28.3ms within Sympa::Task::CORE:match which was called 34842 times, avg 811ns/call:
# 11500 times (6.40ms+0s) by Sympa::Task::_chk_line at line 348, avg 556ns/call
# 5750 times (2.03ms+0s) by Sympa::Task::_parse at line 232, avg 354ns/call
# 4600 times (2.02ms+0s) by Sympa::Task::_chk_line at line 341, avg 439ns/call
# 3450 times (8.55ms+0s) by Sympa::Task::_chk_cmd at line 442, avg 2µs/call
# 3450 times (2.28ms+0s) by Sympa::Task::_chk_line at line 363, avg 660ns/call
# 2527 times (2.19ms+0s) by Sympa::Task::new at line 71, avg 868ns/call
# 2300 times (3.63ms+0s) by Sympa::Task::_chk_line at line 370, avg 2µs/call
# 1265 times (1.16ms+0s) by Sympa::Task::_chk_cmd at line 453, avg 916ns/call | |||||
sub Sympa::Task::CORE:regcomp; # opcode | |||||
# spent 3.13ms within Sympa::Task::CORE:subst which was called 2415 times, avg 1µs/call:
# 2415 times (3.13ms+0s) by Sympa::Task::_chk_line at line 374, avg 1µs/call |