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

Filename/usr/local/libexec/sympa/Sympa/Log.pm
StatementsExecuted 1204696 statements in 2.05s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
354362671.81s7.00sSympa::Log::::syslogSympa::Log::syslog
708702198.2ms98.2msSympa::Log::::CORE:matchSympa::Log::CORE:match (opcode)
1206001175.6ms75.6msSympa::Log::::CORE:substcontSympa::Log::CORE:substcont (opcode)
708722153.0ms53.0msSympa::Log::::CORE:substSympa::Log::CORE:subst (opcode)
0000s0sSympa::Log::::BEGIN@30Sympa::Log::BEGIN@30
0000s0sSympa::Log::::BEGIN@31Sympa::Log::BEGIN@31
0000s0sSympa::Log::::BEGIN@32Sympa::Log::BEGIN@32
0000s0sSympa::Log::::BEGIN@33Sympa::Log::BEGIN@33
0000s0sSympa::Log::::BEGIN@34Sympa::Log::BEGIN@34
0000s0sSympa::Log::::BEGIN@35Sympa::Log::BEGIN@35
0000s0sSympa::Log::::BEGIN@36Sympa::Log::BEGIN@36
0000s0sSympa::Log::::BEGIN@38Sympa::Log::BEGIN@38
0000s0sSympa::Log::::BEGIN@40Sympa::Log::BEGIN@40
0000s0sSympa::Log::::__ANON__Sympa::Log::__ANON__ (xsub)
0000s0sSympa::Log::::_aggregate_dataSympa::Log::_aggregate_data
0000s0sSympa::Log::::_connectSympa::Log::_connect
0000s0sSympa::Log::::_daemon_nameSympa::Log::_daemon_name
0000s0sSympa::Log::::_new_instanceSympa::Log::_new_instance
0000s0sSympa::Log::::_warn_handlerSympa::Log::_warn_handler
0000s0sSympa::Log::::add_statSympa::Log::add_stat
0000s0sSympa::Log::::aggregate_daily_dataSympa::Log::aggregate_daily_data
0000s0sSympa::Log::::aggregate_statSympa::Log::aggregate_stat
0000s0sSympa::Log::::db_logSympa::Log::db_log
0000s0sSympa::Log::::get_first_db_logSympa::Log::get_first_db_log
0000s0sSympa::Log::::get_log_dateSympa::Log::get_log_date
0000s0sSympa::Log::::get_next_db_logSympa::Log::get_next_db_log
0000s0sSympa::Log::::openlogSympa::Log::openlog
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 The Sympa Community. See the AUTHORS.md file at the top-level
12# 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
28package Sympa::Log;
29
30use strict;
31use warnings;
32use English qw(-no_match_vars);
33use POSIX qw();
34use Scalar::Util;
35use Sys::Syslog qw();
36use Time::Local qw();
37
38use Sympa::Tools::Time;
39
40use base qw(Class::Singleton);
41
42# Constructor for Class::Singleton.
43sub _new_instance {
44 my $class = shift;
45
46 bless {} => $class;
47}
48
49# Old name: Log::do_openlog().
50sub openlog {
51 my $self = shift;
52 my $facility = shift;
53 my $socket_type = shift;
54 my %options = @_;
55
56 $self->{_facility} = $facility;
57 $self->{_socket_type} = $socket_type;
58 $self->{_service} = $options{service} || _daemon_name() || 'sympa';
59 $self->{_database_backend} =
60 (exists $options{database_backend})
61 ? $options{database_backend}
62 : 'Sympa::DatabaseManager';
63
64 return $self->_connect();
65}
66
67# When logs are not available, period of time to wait before sending another
68# warning to listmaster.
69my $warning_timeout = 600;
70# Date of the last time a message was sent to warn the listmaster that the
71# logs are unavailable.
72my $warning_date = 0;
73
74my %levels = (
75 err => 0,
76 info => 0,
77 notice => 0,
78 trace => 0,
79 debug => 1,
80 debug2 => 2,
81 debug3 => 3,
82);
83
84# Deprecated: No longer used.
85#sub fatal_err;
86
87# Old name: Log::do_log().
88
# spent 7.00s (1.81+5.20) within Sympa::Log::syslog which was called 35436 times, avg 198µs/call: # 5750 times (215ms+746ms) by Sympa::Task::_chk_line at line 330 of /usr/local/libexec/sympa/Sympa/Task.pm, avg 167µs/call # 3001 times (196ms+483ms) by Sympa::search_fullpath at line 89 of /usr/local/libexec/sympa/Sympa.pm, avg 226µs/call # 3001 times (156ms+454ms) by Sympa::search_fullpath at line 65 of /usr/local/libexec/sympa/Sympa.pm, avg 203µs/call # 3001 times (136ms+385ms) by Sympa::get_search_path at line 109 of /usr/local/libexec/sympa/Sympa.pm, avg 174µs/call # 2754 times (111ms+406ms) by Sympa::Database::do_prepared_query at line 320 of /usr/local/libexec/sympa/Sympa/Database.pm, avg 188µs/call # 2300 times (184ms+405ms) by Sympa::Spool::unmarshal_metadata at line 389 of /usr/local/libexec/sympa/Sympa/Spool.pm, avg 256µs/call # 2300 times (107ms+328ms) by Sympa::Spool::unmarshal_metadata at line 457 of /usr/local/libexec/sympa/Sympa/Spool.pm, avg 189µs/call # 2300 times (111ms+292ms) by Sympa::Task::_chk_cmd at line 414 of /usr/local/libexec/sympa/Sympa/Task.pm, avg 175µs/call # 1507 times (94.5ms+262ms) by Sympa::Robot::load_topics at line 186 of /usr/local/libexec/sympa/Sympa/Robot.pm, avg 236µs/call # 1494 times (111ms+233ms) by Sympa::List::_load_edit_list_conf at line 6151 of /usr/local/libexec/sympa/Sympa/List.pm, avg 230µs/call # 1494 times (75.2ms+230ms) by Sympa::List::load at line 603 of /usr/local/libexec/sympa/Sympa/List.pm, avg 204µs/call # 1494 times (63.7ms+237ms) by Sympa::List::new at line 108 of /usr/local/libexec/sympa/Sympa/List.pm, avg 202µs/call # 1377 times (66.0ms+219ms) by Sympa::Task::new at line 109 of /usr/local/libexec/sympa/Sympa/Task.pm, avg 207µs/call # 1343 times (77.4ms+187ms) by Sympa::List::_load_list_param at line 4869 of /usr/local/libexec/sympa/Sympa/List.pm, avg 197µs/call # 1150 times (53.7ms+157ms) by Sympa::Task::_parse at line 215 of /usr/local/libexec/sympa/Sympa/Task.pm, avg 183µs/call # 345 times (19.5ms+50.9ms) by Sympa::List::get_lists at line 4518 of /usr/local/libexec/sympa/Sympa/List.pm, avg 204µs/call # 345 times (12.7ms+57.2ms) by Sympa::List::get_lists at line 4256 of /usr/local/libexec/sympa/Sympa/List.pm, avg 203µs/call # 345 times (13.5ms+47.0ms) by Sympa::List::get_lists at line 4464 of /usr/local/libexec/sympa/Sympa/List.pm, avg 175µs/call # 115 times (2.38ms+13.8ms) by Sympa::List::get_robots at line 4706 of /usr/local/libexec/sympa/Sympa/List.pm, avg 141µs/call # 13 times (644µs+1.71ms) by Sympa::List::_load_list_config_file at line 4982 of /usr/local/libexec/sympa/Sympa/List.pm, avg 181µs/call # 2 times (54µs+236µs) by Sympa::Database::do_prepared_query at line 325 of /usr/local/libexec/sympa/Sympa/Database.pm, avg 145µs/call # once (201µs+489µs) by main::RUNTIME at line 137 of /usr/local/libexec/sympa/task_manager-debug.pl # once (62µs+188µs) by main::sigterm at line 221 of /usr/local/libexec/sympa/task_manager-debug.pl # once (50µs+199µs) by Sympa::Database::connect at line 102 of /usr/local/libexec/sympa/Sympa/Database.pm # once (44µs+197µs) by Sympa::Database::connect at line 185 of /usr/local/libexec/sympa/Sympa/Database.pm # once (38µs+141µs) by main::RUNTIME at line 159 of /usr/local/libexec/sympa/task_manager-debug.pl
sub syslog {
89354367.22ms my $self = shift;
90354367.19ms my $level = shift;
91354366.83ms my $message = shift;
9235436183ms my $errno = $ERRNO;
93
943543611.9ms unless (exists $levels{$level}) {
95 $self->syslog('err', 'Invalid $level: "%s"', $level);
96 $level = 'info';
97 }
98
99 # do not log if log level is too high regarding the log requested by user
1003543620.0ms return if defined $self->{level} and $levels{$level} > $self->{level};
101354369.48ms return if !defined $self->{level} and $levels{$level} > 0;
102
103 # Skip stack frame when warnings are issued.
1043543659.1ms local $SIG{__WARN__} = \&_warn_handler;
105
106 ## Do not display variables which are references.
107354368.70ms my @param = ();
10835436159ms3543668.4ms foreach my $fstring (($message =~ /(%.)/g)) {
# spent 68.4ms making 35436 calls to Sympa::Log::CORE:match, avg 2µs/call
1098528019.7ms next if $fstring eq '%%' or $fstring eq '%m';
110
1118528023.4ms my $p = shift @_;
11285280342ms9116966.8ms unless (defined $p) {
# spent 34.0ms making 69147 calls to Scalar::Util::blessed, avg 492ns/call # spent 16.6ms making 8709 calls to Sympa::List::get_id, avg 2µs/call # spent 12.3ms making 12161 calls to UNIVERSAL::can, avg 1µs/call # spent 3.81ms making 1150 calls to Sympa::Task::get_id, avg 3µs/call # spent 75µs making 2 calls to Sympa::Database::get_id, avg 38µs/call
113 # prevent 'Use of uninitialized value' warning
114 push @param, '';
115 } elsif (ref $p eq 'Template::Exception') {
116 push @param, $p->as_string;
117 } elsif (Scalar::Util::blessed($p) and $p->can('get_id')) {
118 push @param, sprintf('%s <%s>', ref $p, $p->get_id);
119 } elsif (ref $p eq 'Regexp') {
120 push @param, "qr<$p>";
121 } elsif (ref $p) {
122 push @param, ref $p;
123 } else {
1245271517.6ms push @param, $p;
125 }
126 }
12735436491ms156036114ms $message =~ s/(%.)/($1 eq '%m') ? '%%%%errno%%%%' : $1/eg;
# spent 75.6ms making 120600 calls to Sympa::Log::CORE:substcont, avg 627ns/call # spent 38.1ms making 35436 calls to Sympa::Log::CORE:subst, avg 1µs/call
1283543644.4ms $message = sprintf $message, @param;
1293543684.2ms3543614.9ms $message =~ s/%%errno%%/$errno/g;
# spent 14.9ms making 35436 calls to Sympa::Log::CORE:subst, avg 421ns/call
130
131 ## If in 'err' level, build a stack trace,
132 ## except if syslog has not been setup yet.
1333543617.9ms if (defined $self->{level} and $level eq 'err') {
134 my $go_back = 0;
135 my @calls;
136
137 my @f = caller($go_back);
138 #if ($f[3] and $f[3] =~ /wwslog$/) {
139 # ## If called via wwslog, go one step ahead
140 # @f = caller(++$go_back);
141 #}
142 @calls = '#' . $f[2];
143 while (@f = caller(++$go_back)) {
144 if ($f[3] and $f[3] =~ /\ASympa::Crash::/) {
145 # Discard trace inside crash handler.
146 @calls = '#' . $f[2];
147 } else {
148 $calls[0] = ($f[3] || '') . $calls[0];
149 unshift @calls, '#' . $f[2];
150 }
151 }
152 $calls[0] = 'main::' . $calls[0];
153
154 my $caller_string = join ' > ', @calls;
155 $message = "$caller_string $message";
156 } else {
1573543697.9ms my @call = caller(1);
158 ## If called via wwslog, go one step ahead
159 #if ($call[3] and $call[3] =~ /wwslog$/) {
160 # @call = caller(2);
161 #}
162
163354368.59ms my $caller_string = $call[3];
1643543636.6ms if (defined $caller_string and length $caller_string) {
16535434137ms3543429.8ms if ($message =~ /\A[(].*[)]/) {
# spent 29.8ms making 35434 calls to Sympa::Log::CORE:match, avg 841ns/call
166 $message = "$caller_string$message";
167 } else {
168102419.28ms $message = "$caller_string() $message";
169 }
170 } else {
17122µs $message = "main:: $message";
172 }
173 }
174
175 ## Add facility to log entry
1763543615.6ms $message = "$level $message";
177
178 # map to standard syslog facility if needed
1793543618.7ms if ($level eq 'trace') {
180 $message = "###### TRACE MESSAGE ######: " . $message;
181 $level = 'notice';
182 } elsif ($level eq 'debug2' or $level eq 'debug3') {
183 $level = 'debug';
184 }
185
186 ## Output to STDERR if needed
1873543613.8ms if (not defined $self->{level}
188 or ($self->{log_to_stderr}
189 and ($self->{log_to_stderr} eq 'all'
190 or 0 <= index($self->{log_to_stderr}, $level))
191 )
192 ) {
193 print STDERR "$message\n";
194 }
195354366.90ms return unless defined $self->{level};
196
197 # Output to syslog
198 # Note: Sys::Syslog <= 0.07 which are bundled in Perl <= 5.8.7 pass
199 # $message to sprintf() even when no arguments are given. As a
200 # workaround, always pass format string '%s' along with $message.
2013543611.2ms eval {
2023543639.9ms354364.90s unless (Sys::Syslog::syslog($level, '%s', $message)) {
# spent 4.90s making 35436 calls to Sys::Syslog::syslog, avg 138µs/call
203 $self->_connect();
204 Sys::Syslog::syslog($level, '%s', $message);
205 }
206 };
20735436146ms if ($EVAL_ERROR and $warning_date < time - $warning_timeout) {
208 warn sprintf 'No logs available: %s', $EVAL_ERROR;
209 $warning_date = time + $warning_timeout;
210 }
211}
212
213# Old names: Log::set_daemon(), Sympa::Tools::Daemon::get_daemon_name().
214sub _daemon_name {
215 my @path = split /\//, $PROGRAM_NAME;
216 my $service = $path[$#path];
217 $service =~ s/(\.[^\.]+)$//;
218 return $service;
219}
220
221# Old name: Log::do_connect().
222sub _connect {
223 my $self = shift;
224
225 if ($self->{_socket_type} =~ /^(unix|inet)$/i) {
226 Sys::Syslog::setlogsock(lc($self->{_socket_type}));
227 }
228 # Close log may be useful: If parent processus did open log child
229 # process inherit the openlog with parameters from parent process.
230 Sys::Syslog::closelog;
231 eval {
232 Sys::Syslog::openlog(sprintf('%s[%s]', $self->{_service}, $PID),
233 'ndelay,nofatal', $self->{_facility});
234 };
235 if ($EVAL_ERROR && ($warning_date < time - $warning_timeout)) {
236 warn sprintf 'No logs available: %s', $EVAL_ERROR;
237 $warning_date = time + $warning_timeout;
238 return undef;
239 }
240
241 return $self;
242}
243
244sub _warn_handler {
245 my $message = shift;
246
247 my $go_back = 0;
248 my @f;
249 do { @f = caller(++$go_back) } while @f and $f[0] eq __PACKAGE__;
250 $message =~ s/ at \S+ line \S+\n*\z/ at $f[1] line $f[2]\n/ if @f;
251 print STDERR $message;
252}
253
254sub get_log_date {
255 my $self = shift;
256
257 my $sdm;
258 unless ($self->{_database_backend}
259 and $sdm = $self->{_database_backend}->instance) {
260 $self->syslog('err', 'Database backend is not available');
261 return;
262 }
263
264 my $sth;
265 my @dates;
266 foreach my $query ('MIN', 'MAX') {
267 unless ($sth =
268 $sdm->do_query("SELECT $query(date_logs) FROM logs_table")) {
269 $self->syslog('err', 'Unable to get %s date from logs_table',
270 $query);
271 return;
272 }
273 while (my $d = ($sth->fetchrow_array)[0]) {
274 push @dates, $d;
275 }
276 }
277
278 return @dates;
279}
280
281# add log in RDBMS
282sub db_log {
283 my $self = shift;
284 my %options = @_;
285
286 my $sdm;
287 unless ($self->{_database_backend}
288 and $sdm = $self->{_database_backend}->instance) {
289 $self->syslog('err', 'Database backend is not available');
290 return undef;
291 }
292
293 my $list = $options{'list'};
294 my $robot = $options{'robot'};
295 my $action = $options{'action'};
296 my $parameters = $options{'parameters'};
297 my $target_email = $options{'target_email'};
298 my $msg_id = $options{'msg_id'};
299 my $status = $options{'status'};
300 my $error_type = $options{'error_type'};
301 my $user_email = $options{'user_email'};
302 my $client = $options{'client'};
303 my $daemon = $self->{_service} || 'sympa';
304 my ($date, $usec) = Sympa::Tools::Time::gettimeofday();
305
306 unless ($user_email) {
307 $user_email = 'anonymous';
308 }
309 unless (defined $list and length $list) {
310 $list = '';
311 } elsif ($list =~ /(.+)\@(.+)/) {
312 #remove the robot name of the list name
313 $list = $1;
314 unless ($robot) {
315 $robot = $2;
316 }
317 }
318
319 # Insert in log_table
320 unless (
321 $sdm->do_prepared_query(
322 q{INSERT INTO logs_table
323 (date_logs, usec_logs, robot_logs, list_logs, action_logs,
324 parameters_logs,
325 target_email_logs, msg_id_logs, status_logs, error_type_logs,
326 user_email_logs, client_logs, daemon_logs)
327 VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)},
328 $date, $usec, $robot, $list, $action,
329 substr($parameters || '', 0, 100),
330 $target_email, $msg_id, $status, $error_type,
331 $user_email, $client, $daemon
332 )
333 ) {
334 $self->syslog('err',
335 'Unable to insert new db_log entry in the database');
336 return undef;
337 }
338
339 return 1;
340}
341
342#insert data in stats table
343# Old name: Log::db_stat_log().
344sub add_stat {
345 my $self = shift;
346 my %options = @_;
347
348 my $sdm;
349 unless ($self->{_database_backend}
350 and $sdm = $self->{_database_backend}->instance) {
351 $self->syslog('err', 'Database backend is not available');
352 return undef;
353 }
354
355 my $list = $options{'list'};
356 my $operation = $options{'operation'};
357 my $date = time;
358 my $mail = $options{'mail'};
359 my $daemon = $self->{_service} || 'sympa';
360 my $ip = $options{'client'};
361 my $robot = $options{'robot'};
362 my $parameter = $options{'parameter'};
363 my $read = 0;
364
365 if (ref $list eq 'Sympa::List') {
366 $list = $list->{'name'};
367 } elsif ($list and $list =~ /(.+)\@(.+)/) {
368 #remove the robot name of the list name
369 $list = $1;
370 unless ($robot) {
371 $robot = $2;
372 }
373 }
374
375 ##insert in stat table
376 unless (
377 $sdm->do_prepared_query(
378 q{INSERT INTO stat_table
379 (date_stat, email_stat, operation_stat, list_stat,
380 daemon_stat, user_ip_stat, robot_stat, parameter_stat,
381 read_stat)
382 VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)},
383 $date, $mail, $operation, $list,
384 $daemon, $ip, $robot, $parameter,
385 $read
386 )
387 ) {
388 $self->syslog('err',
389 'Unable to insert new stat entry in the database');
390 return undef;
391 }
392 return 1;
393}
394
395# delete logs in RDBMS
396# MOVED to _db_log_del() in task_manager.pl.
397#sub db_log_del;
398
399# Scan log_table with appropriate select
400sub get_first_db_log {
401 my $self = shift;
402 my $select = shift;
403
404 my $sdm;
405 unless ($self->{_database_backend}
406 and $sdm = $self->{_database_backend}->instance) {
407 $self->syslog('err', 'Database backend is not available');
408 return undef;
409 }
410
411 # Clear state.
412 if ($self->{_sth}) {
413 eval { $self->{_sth}->finish; };
414 delete $self->{_sth};
415 }
416
417 my %action_type = (
418 'message' => [
419 'reject', 'distribute', 'arc_delete', 'arc_download',
420 'sendMessage', 'remove', 'record_email', 'send_me',
421 'd_remove_arc', 'rebuildarc', 'remind', 'send_mail',
422 'DoFile', 'sendMessage', 'DoForward', 'DoMessage',
423 'DoCommand', 'SendDigest'
424 ],
425 'authentication' => [
426 'login', 'logout',
427 'loginrequest', 'requestpasswd',
428 'ssologin', 'ssologin_succeses',
429 'remindpasswd', 'choosepasswd'
430 ],
431 'subscription' =>
432 ['subscribe', 'signoff', 'add', 'del', 'ignoresub', 'subindex'],
433 'list_management' => [
434 'create_list', 'rename_list',
435 'close_list', 'edit_list',
436 'admin', 'blocklist',
437 'install_pending_list', 'purge_list',
438 'edit_template', 'copy_template',
439 'remove_template'
440 ],
441 'bounced' => ['resetbounce', 'get_bounce'],
442 'preferences' => [
443 'set', 'setpref', 'pref', 'change_email',
444 'setpasswd', 'editsubscriber'
445 ],
446 'shared' => [
447 'd_unzip', 'd_upload',
448 'd_read', 'd_delete',
449 'd_savefile', 'd_overwrite',
450 'd_create_dir', 'd_set_owner',
451 'd_change_access', 'd_describe',
452 'd_rename', 'd_editfile',
453 'd_admin', 'd_install_shared',
454 'd_reject_shared', 'd_properties',
455 'creation_shared_file', 'd_unzip_shared_file',
456 'install_file_hierarchy', 'd_copy_rec_dir',
457 'd_copy_file', 'change_email',
458 'set_lang', 'new_d_read',
459 'd_control'
460 ],
461 );
462
463 my $statement = sprintf q{SELECT date_logs, usec_logs AS usec,
464 robot_logs AS robot, list_logs AS list,
465 action_logs AS action,
466 parameters_logs AS parameters,
467 target_email_logs AS target_email,
468 msg_id_logs AS msg_id, status_logs AS status,
469 error_type_logs AS error_type,
470 user_email_logs AS user_email,
471 client_logs AS client, daemon_logs AS daemon
472 FROM logs_table
473 WHERE robot_logs = %s }, $sdm->quote($select->{'robot'});
474
475 if ( $select->{target_type}
476 and $select->{target_type} ne 'none'
477 and $select->{target_type} =~ /\A\w+\z/
478 and $select->{target}) {
479 # If a type of target and a target are specified:
480 $statement .= sprintf 'AND %s_logs = %s ',
481 lc $select->{target_type}, $sdm->quote(lc $select->{target});
482 } elsif ($select->{type}
483 and $select->{type} ne 'none'
484 and $select->{type} ne 'all_actions'
485 and $action_type{$select->{type}}) {
486 # If the search is on a precise type:
487 $statement .= sprintf 'AND (%s) ',
488 join ' OR ',
489 map { sprintf "logs_table.action_logs = '%s'", $_ }
490 @{$action_type{$select->{'type'}}};
491 }
492
493 #if the search is between two date
494 if ($select->{'date_from'}) {
495 my ($yyyy, $mm, $dd) = split /[^\da-z]/i, $select->{'date_from'};
496 ($dd, $mm, $yyyy) = ($yyyy, $mm, $dd) if 31 < $dd;
497 $yyyy += ($yyyy < 50 ? 2000 : $yyyy < 100 ? 1900 : 0);
498
499 my $date_from = POSIX::mktime(0, 0, -1, $dd, $mm - 1, $yyyy - 1900);
500 unless ($select->{'date_to'}) {
501 my $date_from2 =
502 POSIX::mktime(0, 0, 25, $dd, $mm - 1, $yyyy - 1900);
503 $statement .= sprintf "AND date_logs >= %s AND date_logs <= %s ",
504 $date_from, $date_from2;
505 } else {
506 my ($yyyy, $mm, $dd) = split /[^\da-z]/i, $select->{'date_to'};
507 ($dd, $mm, $yyyy) = ($yyyy, $mm, $dd) if 31 < $dd;
508 $yyyy += ($yyyy < 50 ? 2000 : $yyyy < 100 ? 1900 : 0);
509
510 my $date_to = POSIX::mktime(0, 0, 25, $dd, $mm - 1, $yyyy - 1900);
511 $statement .= sprintf "AND date_logs >= %s AND date_logs <= %s ",
512 $date_from, $date_to;
513 }
514 }
515
516 # if the listmaster want to make a search by an IP address.
517 if ($select->{'ip'}) {
518 $statement .= sprintf ' AND client_logs = %s ',
519 $sdm->quote($select->{'ip'});
520 }
521
522 ## Currently not used
523 #if the search is on the actor of the action
524 if ($select->{'user_email'}) {
525 $select->{'user_email'} = lc($select->{'user_email'});
526 $statement .= sprintf "AND user_email_logs = '%s' ",
527 $select->{'user_email'};
528 }
529
530 #if a list is specified -just for owner or above-
531 if ($select->{'list'}) {
532 $select->{'list'} = lc($select->{'list'});
533 $statement .= sprintf "AND list_logs = '%s' ", $select->{'list'};
534 }
535
536 # Unknown sort key as 'date'.
537 my $sortby = $select->{'sortby'};
538 unless (
539 $sortby
540 and grep { $sortby eq $_ }
541 qw(date robot list action parameters target_email msg_id
542 status error_type user_email client daemon)
543 ) {
544 $sortby = 'date';
545 }
546 $statement .= sprintf 'ORDER BY %s ',
547 ($sortby eq 'date' ? 'date_logs, usec_logs' : $sortby . '_logs');
548
549 my $sth;
550 unless ($sth = $sdm->do_query($statement)) {
551 $self->syslog('err',
552 'Unable to retrieve logs entry from the database');
553 return undef;
554 }
555 $self->{_sth} = $sth;
556
557 my $row = $sth->fetchrow_hashref('NAME_lc');
558
559 ## If no rows returned, return an empty hash
560 ## Required to differenciate errors and empty results
561 unless ($row) {
562 return {};
563 }
564
565 ## We can't use the "AS date" directive in the SELECT statement because
566 ## "date" is a reserved keywork with Oracle
567 $row->{date} = $row->{date_logs} if defined $row->{date_logs};
568 return $row;
569
570}
571
572sub get_next_db_log {
573 my $self = shift;
574
575 my $sth = $self->{_sth};
576 die 'Bug in logic. Ask developer' unless $sth;
577
578 my $row = $sth->fetchrow_hashref('NAME_lc');
579
580 unless (defined $row) {
581 $sth->finish;
582 delete $self->{_sth};
583 }
584
585 ## We can't use the "AS date" directive in the SELECT statement because
586 ## "date" is a reserved keywork with Oracle
587 $row->{date} = $row->{date_logs} if defined $row->{date_logs};
588
589 return $row;
590}
591
592# Data aggregation, to make statistics.
593sub aggregate_stat {
594 my $self = shift;
595
596 my $sdm;
597 unless ($self->{_database_backend}
598 and $sdm = $self->{_database_backend}->instance) {
599 $self->syslog('err', 'Database backend is not available');
600 return undef;
601 }
602
603 my (@time, $sth);
604
605 @time = localtime time;
606 $time[0] = $time[1] = 0;
607 my $date_end = Time::Local::timelocal(@time);
608
609 unless (
610 $sth = $sdm->do_prepared_query(
611 q{SELECT date_stat
612 FROM stat_table
613 WHERE read_stat = 0
614 ORDER BY date_stat ASC}
615 )
616 ) {
617 $self->syslog('err', 'Unable to retrieve oldest non processed stat');
618 return undef;
619 }
620 my @res = $sth->fetchrow_array;
621 $sth->finish; # Fetch only the oldest row.
622
623 # If the array is emty, then we don't have anything to aggregate.
624 # Simply return and carry on.
625 unless (@res) {
626 return 0;
627 }
628 my $date_deb = $res[0] - ($res[0] % 3600);
629
630 # Hour to hour
631 my @slots;
632 for (my $i = $date_deb; $i <= $date_end; $i = $i + 3600) {
633 push @slots, $i;
634 }
635
636 for (my $j = 1; $j <= scalar(@slots); $j++) {
637 $self->_aggregate_data($slots[$j - 1] || $date_deb,
638 $slots[$j] || $date_end);
639 }
640
641 return 1;
642}
643
644# Aggregate data from stat_table to stat_counter_table.
645# Dates must be in epoch format.
646my @robot_operations = qw{close_list copy_list create_list list_rejected
647 login logout purge_list restore_list};
648
649# Old name: Log::aggregate_data().
650sub _aggregate_data {
651 my $self = shift;
652 my ($begin_date, $end_date) = @_;
653
654 my $sdm;
655 unless ($self->{_database_backend}
656 and $sdm = $self->{_database_backend}->instance) {
657 $self->syslog('err', 'Database backend is not available');
658 return;
659 }
660
661 # Store reslults in stat_counter_table.
662 my $cond;
663
664 # Store data by each list.
665 $cond = join ' AND ', map {"operation_stat <> '$_'"} @robot_operations;
666 $sdm->do_prepared_query(
667 sprintf(
668 q{INSERT INTO stat_counter_table
669 (beginning_date_counter, end_date_counter, data_counter,
670 robot_counter, list_counter, count_counter)
671 SELECT ?, ?, operation_stat, robot_stat, list_stat, COUNT(*)
672 FROM stat_table
673 WHERE ? <= date_stat AND date_stat < ?
674 AND list_stat IS NOT NULL AND list_stat <> ''
675 AND read_stat = 0 AND %s
676 GROUP BY robot_stat, list_stat, operation_stat},
677 $cond
678 ),
679 $begin_date,
680 $end_date,
681 $begin_date,
682 $end_date
683 );
684
685 # Store data by each robot.
686 $cond = join ' OR ', map {"operation_stat = '$_'"} @robot_operations;
687 $sdm->do_prepared_query(
688 sprintf(
689 q{INSERT INTO stat_counter_table
690 (beginning_date_counter, end_date_counter, data_counter,
691 robot_counter, list_counter, count_counter)
692 SELECT ?, ?, operation_stat, robot_stat, '', COUNT(*)
693 FROM stat_table
694 WHERE ? <= date_stat AND date_stat < ?
695 AND read_stat = 0 AND (%s)
696 GROUP BY robot_stat, operation_stat},
697 $cond
698 ),
699 $begin_date,
700 $end_date,
701 $begin_date,
702 $end_date
703 );
704
705 # Update subscriber_table about messages sent, upgrade field
706 # number_messages_subscriber.
707 my $sth;
708 my $row;
709 if ($sth = $sdm->do_prepared_query(
710 q{SELECT COUNT(*) AS "count",
711 robot_stat AS robot, list_stat AS list,
712 email_stat AS email
713 FROM stat_table
714 WHERE ? <= date_stat AND date_stat < ?
715 AND read_stat = 0 AND operation_stat = 'send_mail'
716 GROUP BY robot_stat, list_stat, email_stat},
717 $begin_date, $end_date
718 )
719 ) {
720 while ($row = $sth->fetchrow_hashref('NAME_lc')) {
721 $sdm->do_prepared_query(
722 q{UPDATE subscriber_table
723 SET number_messages_subscriber =
724 number_messages_subscriber + ?
725 WHERE robot_subscriber = ? AND list_subscriber = ? AND
726 user_subscriber = ?},
727 $row->{'count'},
728 $row->{'robot'}, $row->{'list'},
729 $row->{'email'}
730 );
731 }
732 $sth->finish;
733 }
734
735 # The rows were read, so update the read_stat from 0 to 1.
736 unless (
737 $sth = $sdm->do_prepared_query(
738 q{UPDATE stat_table
739 SET read_stat = 1
740 WHERE ? <= date_stat AND date_stat < ?},
741 $begin_date, $end_date
742 )
743 ) {
744 $self->syslog('err',
745 'Unable to set stat entries between date % and date %s as read',
746 $begin_date, $end_date);
747 return undef;
748 }
749
750 my $d_deb = localtime($begin_date);
751 my $d_fin = localtime($end_date) if defined $end_date;
752 $self->syslog('debug2', 'data aggregated from %s to %s', $d_deb, $d_fin);
753}
754
755#get date of the last time we have aggregated data
756# Never used.
757#sub get_last_date_aggregation;
758
759sub aggregate_daily_data {
760 my $self = shift;
761 $self->syslog('debug2', '(%s, %s)', @_);
762 my $list = shift;
763 my $operation = shift;
764
765 my $sdm;
766 unless ($self->{_database_backend}
767 and $sdm = $self->{_database_backend}->instance) {
768 $self->syslog('err', 'Database backend is not available');
769 return;
770 }
771
772 my $result;
773
774 my $sth;
775 my $row;
776 unless (
777 $sth = $sdm->do_prepared_query(
778 q{SELECT beginning_date_counter AS "date",
779 count_counter AS "count"
780 FROM stat_counter_table
781 WHERE data_counter = ? AND
782 robot_counter = ? AND list_counter = ?},
783 $operation,
784 $list->{'domain'}, $list->{'name'}
785 )
786 ) {
787 $self->syslog('err', 'Unable to get stat data %s for list %s',
788 $operation, $list);
789 return;
790 }
791 while ($row = $sth->fetchrow_hashref('NAME_lc')) {
792 my $midnight = Sympa::Tools::Time::get_midnight_time($row->{'date'});
793 $result->{$midnight} = 0 unless defined $result->{$midnight};
794 $result->{$midnight} += $row->{'count'};
795 }
796 $sth->finish;
797
798 my @dates = sort { $a <=> $b } keys %$result;
799 return {} unless @dates;
800
801 for (my $date = $dates[0]; $date < $dates[-1]; $date += 86400) {
802 my $midnight = Sympa::Tools::Time::get_midnight_time($date);
803 $result->{$midnight} = 0 unless defined $result->{$midnight};
804 }
805 return $result;
806}
807
8081;
809__END__
 
# spent 98.2ms within Sympa::Log::CORE:match which was called 70870 times, avg 1µs/call: # 35436 times (68.4ms+0s) by Sympa::Log::syslog at line 108, avg 2µs/call # 35434 times (29.8ms+0s) by Sympa::Log::syslog at line 165, avg 841ns/call
sub Sympa::Log::CORE:match; # opcode
# spent 53.0ms within Sympa::Log::CORE:subst which was called 70872 times, avg 748ns/call: # 35436 times (38.1ms+0s) by Sympa::Log::syslog at line 127, avg 1µs/call # 35436 times (14.9ms+0s) by Sympa::Log::syslog at line 129, avg 421ns/call
sub Sympa::Log::CORE:subst; # opcode
# spent 75.6ms within Sympa::Log::CORE:substcont which was called 120600 times, avg 627ns/call: # 120600 times (75.6ms+0s) by Sympa::Log::syslog at line 127, avg 627ns/call
sub Sympa::Log::CORE:substcont; # opcode