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::Spindle::ProcessDigest; 29 30use strict; 31use warnings; 32use POSIX qw(); 33use Time::HiRes qw(); 34use Time::Local qw(); 35 36use Sympa; 37use Conf; 38use Sympa::Language; 39use Sympa::Log; 40use Sympa::Spindle::ProcessTemplate; 41 42use base qw(Sympa::Spindle); 43 44my $language = Sympa::Language->instance; 45my $log = Sympa::Log->instance; 46 47use constant _distaff => 'Sympa::Spool::Digest::Collection'; 48use constant _on_failure => 1; 49use constant _on_garbage => 1; 50use constant _on_skip => 1; 51use constant _on_success => 1; 52 53sub _twist { 54 my $self = shift; 55 my $spool_digest = shift; 56 57 return 0 58 unless $self->{send_now} 59 or _may_distribute_digest($spool_digest); 60 61 my $list = $spool_digest->{context}; 62 63 $language->set_lang( 64 $list->{'admin'}{'lang'}, 65 Conf::get_robot_conf($list->{'domain'}, 'lang'), 66 $Conf::Conf{'lang'}, 'en' 67 ); 68 69 # Blindly send the message to all users. 70 $log->syslog('info', 'Sending digest to list %s', $list); 71 $self->_distribute_digest($spool_digest); 72 73 $log->syslog( 74 'info', 'Digest of the list %s sent (%.2f seconds)', 75 $list, Time::HiRes::time() - $self->{start_time} 76 ); 77 $log->db_log( 78 'robot' => $list->{'domain'}, 79 'list' => $list->{'name'}, 80 'action' => 'SendDigest', 81 'parameters' => "", 82 'target_email' => '', 83 'msg_id' => '', 84 'status' => 'success', 85 'error_type' => '', 86 'user_email' => '' 87 ); 88 89 # Always succeeds. 90 return 1; 91} 92 93## Private subroutines. 94 95# Prepare and distribute digest message(s) to the subscribers with 96# reception digest, digestplain or summary. 97# Old name: List::send_msg_digest(), Sympa::List::distribute_digest(). 98sub _distribute_digest { 99 $log->syslog('debug3', '(%s, %s)', @_); 100 my $self = shift; 101 my $spool_digest = shift; 102 103 my $list = $spool_digest->{context}; 104 105 my $available_recipients = $list->get_digest_recipients_per_mode; 106 unless ($available_recipients) { 107 $log->syslog('info', 'No subscriber for sending digest in list %s', 108 $list); 109 110 unless ($self->{keep_digest}) { 111 while (1) { 112 my ($message, $handle) = $spool_digest->next; 113 if ($message and $handle) { 114 $spool_digest->remove($handle); 115 } elsif ($handle) { 116 $log->syslog('err', 'Cannot parse message <%s>', 117 $handle->basename); 118 $spool_digest->quarantine($handle); 119 } else { 120 last; 121 } 122 } 123 } 124 125 return 0; 126 } 127 128 my $time = time; 129 130 # Digest index. 131 my @all_msg; 132 my $i = 0; 133 while (1) { 134 my ($message, $handle) = $spool_digest->next; 135 last unless $handle; # No more messages. 136 unless ($message) { 137 $log->syslog('err', 'Cannot parse message <%s>', 138 $handle->basename); 139 $spool_digest->quarantine($handle); 140 next; 141 } 142 143 $i++; 144 145 # Commented because one Spam made Sympa die (MIME::tools 5.413) 146 #$entity->remove_sig; 147 my $msg = { 148 'id' => $i, 149 'subject' => $message->{'decoded_subject'}, 150 'from' => $message->get_decoded_header('From'), 151 'date' => $message->get_decoded_header('Date'), 152 'full_msg' => $message->as_string, 153 'body' => $message->body_as_string, 154 'plain_body' => $message->get_plaindigest_body, 155 #FIXME: Might be extracted from Date:. 156 'month' => POSIX::strftime("%Y-%m", localtime $time), 157 'message_id' => $message->{'message_id'}, 158 }; 159 push @all_msg, $msg; 160 161 $spool_digest->remove($handle) unless $self->{keep_digest}; 162 } 163 164 my $param = { 165 'replyto' => Sympa::get_address($list, 'owner'), 166 'to' => Sympa::get_address($list), 167 'boundary1' => '----------=_' . Sympa::unique_message_id($list), 168 'boundary2' => '----------=_' . Sympa::unique_message_id($list), 169 }; 170 # Compat. to 6.2a or earlier 171 $param->{'table_of_content'} = $language->gettext("Table of contents:"); 172 173 if ($list->get_reply_to() =~ /^list$/io) { 174 $param->{'replyto'} = "$param->{'to'}"; 175 } 176 177 $param->{'datetime'} = 178 $language->gettext_strftime("%a, %d %b %Y %H:%M:%S", localtime $time); 179 $param->{'date'} = 180 $language->gettext_strftime("%a, %d %b %Y", localtime $time); 181 182 ## Split messages into groups of digest_max_size size 183 my @group_of_msg; 184 while (@all_msg) { 185 my @group = splice @all_msg, 0, $list->{'admin'}{'digest_max_size'}; 186 push @group_of_msg, \@group; 187 } 188 189 $param->{'current_group'} = 0; 190 $param->{'total_group'} = scalar @group_of_msg; 191 ## Foreach set of digest_max_size messages... 192 foreach my $group (@group_of_msg) { 193 $param->{'current_group'}++; 194 $param->{'msg_list'} = $group; 195 $param->{'auto_submitted'} = 'auto-generated'; 196 197 # Prepare and send MIME digest, plain digest and summary. 198 foreach my $mode (qw{digest digestplain summary}) { 199 next unless exists $available_recipients->{$mode}; 200 201 my $spindle = Sympa::Spindle::ProcessTemplate->new( 202 context => $list, 203 template => $mode, 204 rcpt => $available_recipients->{$mode}, 205 data => $param, 206 207 splicing_to => [ 208 'Sympa::Spindle::TransformDigestFinal', 209 'Sympa::Spindle::ToOutgoing' 210 ], 211 add_list_statistics => 1 212 ); 213 unless ($spindle 214 and $spindle->spin 215 and $spindle->{finish} eq 'success') { 216 $log->syslog('notice', 217 'Unable to send template "%s" to %s list subscribers', 218 $mode, $list); 219 next; 220 } 221 } 222 } 223 224 return 1; 225} 226 227# Returns 1 if the digest must be sent. 228# Old name: Sympa::List::get_nextdigest(), 229# Sympa::List::may_distribute_digest(). 230sub _may_distribute_digest { 231 $log->syslog('debug3', '(%s)', @_); 232 my $spool_digest = shift; 233 234 my $list = $spool_digest->{context}; 235 236 return undef unless defined $spool_digest->{time}; 237 return undef unless $list->is_digest; 238 239 my @days = @{$list->{'admin'}{'digest'}->{'days'} || []}; 240 my $hh = $list->{'admin'}{'digest'}->{'hour'} || 0; 241 my $mm = $list->{'admin'}{'digest'}->{'minute'} || 0; 242 243 my @now = localtime time; 244 my $today = $now[6]; # current day 245 my @timedigest = localtime $spool_digest->{time}; 246 247 ## Should we send a digest today 248 my $send_digest = 0; 249 foreach my $d (@days) { 250 if ($d == $today) { 251 $send_digest = 1; 252 last; 253 } 254 } 255 return undef unless $send_digest; 256 257 if ($hh * 60 + $mm <= $now[2] * 60 + $now[1] 258 and Time::Local::timelocal(0, @timedigest[1 .. 5]) < 259 Time::Local::timelocal(0, $mm, $hh, @now[3 .. 5])) { 260 return 1; 261 } 262 263 return undef; 264} 265 2661; 267__END__ 268 269=encoding utf-8 270 271=head1 NAME 272 273Sympa::Spindle::ProcessDigest - Workflow of digest sending 274 275=head1 SYNOPSIS 276 277 use Sympa::Spindle::ProcessDigest; 278 279 my $spindle = Sympa::Spindle::ProcessDigest->new; 280 $spindle->spin; 281 282=head1 DESCRIPTION 283 284L<Sympa::Spindle::ProcessDigest> defines workflow to distribute digest 285messages. 286 287When spin() method is invoked, messages kept in digest spool of each list are 288compiled into digest messages (MIME digest, plain text digest or summary) and 289stored into outgoing spool. 290Lists not reaching the time to distribute digest are omitted. 291 292=head2 Public methods 293 294See also L<Sympa::Spindle/"Public methods">. 295 296=over 297 298=item new ( [ send_now =E<gt> 1 ], [ keep_digest =E<gt> 1 ] ) 299 300=item spin ( ) 301 302If C<send_now> is set, spin() stores digests of all lists keeping unsent 303digests into outgoing spool, including the lists not reaching time to 304distribute. 305If C<keep_digest> is set, won't remove compiled messages from digest spool. 306 307=back 308 309=head2 Properties 310 311See also L<Sympa::Spindle/"Properties">. 312 313=over 314 315=item {distaff} 316 317Instance of L<Sympa::Spool::Digest::Collection> class. 318 319=back 320 321=head1 SEE ALSO 322 323L<Sympa::Spindle>, 324L<Sympa::Spool::Digest>, L<Sympa::Spool::Digest::Collection>. 325 326=head1 HISTORY 327 328L<Sympa::Spindle::SendDigest> appeared on Sympa 6.2.10. 329It was renamed to L<Sympa::Spindle::ProcessDigest> on Sympa 6.2.13. 330 331=cut 332