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