Commit 35c7f52a authored by sikeda's avatar sikeda
Browse files

[dev] Introducing Sympa::Spindle::SendDigest class to define workflow to...

[dev] Introducing Sympa::Spindle::SendDigest class to define workflow to distribute digests, and its super-class Sympa::Spindle.


git-svn-id: https://subversion.renater.fr/sympa/branches/sympa-6.2-branch@12469 05aa8bb8-cd2b-0410-b1d7-8918dfa770ce
parent cdcb0e52
......@@ -76,6 +76,8 @@ nobase_modules_DATA = \
Sympa/Session.pm \
Sympa/SOAP.pm \
Sympa/SOAP/Transport.pm \
Sympa/Spindle.pm \
Sympa/Spindle/SendDigest.pm \
Sympa/Spool.pm \
Sympa/Spool/Archive.pm \
Sympa/Spool/Automatic.pm \
......
......@@ -36,7 +36,6 @@ use MIME::Charset;
use MIME::EncWords;
use POSIX qw();
use Storable qw();
use Time::Local qw();
use URI::Escape qw();
use Sympa;
......@@ -2086,169 +2085,9 @@ sub _mail_message {
|| undef;
}
####################################################
# distribute_digest
####################################################
# Prepare and distribute digest message(s) to the subscribers with
# reception digest, digestplain or summary
#
# IN : -$self(+) : ref(List)
#
# OUT : 1 : ok
# | 0 if no subscriber for sending digest
# | undef
####################################################
# Old name: List::send_msg_digest().
# Note: This would be moved to Pipeline package.
sub distribute_digest {
$log->syslog('debug2', '(%s, ...)', @_);
my $collection = shift;
my $spool = shift;
my $spool_handle = shift;
my %options = @_;
my $list = $spool->{context};
my $available_recipients = $list->get_digest_recipients_per_mode;
unless ($available_recipients) {
$log->syslog('info', 'No subscriber for sending digest in list %s',
$list);
unless ($options{keep_digest}) {
while (1) {
my ($message, $handle) = $spool->next;
if ($message and $handle) {
$spool->remove($handle);
} elsif ($handle) {
$log->syslog('err', 'Cannot parse message <%s>',
$handle->basename);
$spool->quarantine($handle);
} else {
last;
}
}
}
return 0;
}
my $time = time;
# Digest index.
my @all_msg;
my $i = 0;
while (1) {
my ($message, $handle) = $spool->next;
last unless $handle; # No more messages.
unless ($message) {
$log->syslog('err', 'Cannot parse message <%s>',
$handle->basename);
$spool->quarantine($handle);
next;
}
$i++;
# Commented because one Spam made Sympa die (MIME::tools 5.413)
#$entity->remove_sig;
my $msg = {
'id' => $i,
'subject' => $message->{'decoded_subject'},
'from' => $message->get_decoded_header('From'),
'date' => $message->get_decoded_header('Date'),
'full_msg' => $message->as_string,
'body' => $message->body_as_string,
'plain_body' => $message->get_plaindigest_body,
#FIXME: Might be extracted from Date:.
'month' => POSIX::strftime("%Y-%m", localtime $time),
'message_id' => $message->{'message_id'},
};
push @all_msg, $msg;
$spool->remove($handle) unless $options{keep_digest};
}
my $param = {
'replyto' => $list->get_list_address('owner'),
'to' => $list->get_list_address(),
'boundary1' => '----------=_'
. tools::get_message_id($list->{'domain'}),
'boundary2' => '----------=_'
. tools::get_message_id($list->{'domain'}),
};
# Compat. to 6.2a or earlier
$param->{'table_of_content'} = $language->gettext("Table of contents:");
if ($list->get_reply_to() =~ /^list$/io) {
$param->{'replyto'} = "$param->{'to'}";
}
$param->{'datetime'} =
$language->gettext_strftime("%a, %d %b %Y %H:%M:%S", localtime $time);
$param->{'date'} =
$language->gettext_strftime("%a, %d %b %Y", localtime $time);
## Split messages into groups of digest_max_size size
my @group_of_msg;
while (@all_msg) {
my @group = splice @all_msg, 0, $list->{'admin'}{'digest_max_size'};
push @group_of_msg, \@group;
}
my $bulk = Sympa::Bulk->new;
$param->{'current_group'} = 0;
$param->{'total_group'} = $#group_of_msg + 1;
## Foreach set of digest_max_size messages...
foreach my $group (@group_of_msg) {
$param->{'current_group'}++;
$param->{'msg_list'} = $group;
$param->{'auto_submitted'} = 'auto-generated';
# Prepare and send MIME digest, plain digest and summary.
foreach my $mode (qw{digest digestplain summary}) {
next unless exists $available_recipients->{$mode};
my $digest_message =
Sympa::Message->new_from_template($list, $mode,
$available_recipients->{$mode}, $param);
if ($digest_message) {
# Add RFC 2919 header field
$list->add_list_header($digest_message, 'id');
# Add RFC 2369 header fields
foreach my $field (
@{ tools::get_list_params($list->{'domain'})
->{'rfc2369_header_fields'}->{'format'}
}
) {
if (scalar grep { $_ eq $field }
@{$list->{'admin'}{'rfc2369_header_fields'}}) {
$list->add_list_header($digest_message, $field);
}
}
}
unless ($digest_message
and defined $bulk->store($digest_message,
$available_recipients->{$mode})) {
$log->syslog('notice',
'Unable to send template "%s" to %s list subscribers',
$mode, $list);
next;
}
# Add number and size of digests sent to total in stats file.
my $numsent = scalar @{$available_recipients->{$mode}};
my $bytes = length $digest_message->as_string;
$list->{'stats'}[1] += $numsent;
$list->{'stats'}[2] += $bytes;
$list->{'stats'}[3] += $bytes * $numsent;
}
}
$list->savestats();
return 1;
}
# Moved to Sympa::Spindle::SendDigest::_distribute_digest().
#sub distribute_digest;
sub get_digest_recipients_per_mode {
my $self = shift;
......@@ -5491,44 +5330,9 @@ sub is_archiving_enabled {
'on');
}
## Returns 1 if the digest must be sent.
# Old name: Sympa::List::get_nextdigest().
# Note: this would be moved to Pipeline package.
sub may_distribute_digest {
$log->syslog('debug3', '(%s)', @_);
my $spool = shift;
my $list = $spool->{context};
return undef unless defined $spool->{time};
return undef unless $list->is_digest;
my @days = @{$list->{'admin'}{'digest'}->{'days'} || []};
my $hh = $list->{'admin'}{'digest'}->{'hour'} || 0;
my $mm = $list->{'admin'}{'digest'}->{'minute'} || 0;
my @now = localtime time;
my $today = $now[6]; # current day
my @timedigest = localtime $spool->{time};
## Should we send a digest today
my $send_digest = 0;
foreach my $d (@days) {
if ($d == $today) {
$send_digest = 1;
last;
}
}
return undef unless $send_digest;
if ($hh * 60 + $mm <= $now[2] * 60 + $now[1]
and Time::Local::timelocal(0, @timedigest[1 .. 5]) <
Time::Local::timelocal(0, $mm, $hh, @now[3 .. 5])) {
return 1;
}
return undef;
}
# Moved to Sympa::Spindle::SendDigest::_may_distribute_digest().
#sub may_distribute_digest;
## Loads all scenari for an action
sub load_scenario_list {
......
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$
# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015 GIP RENATER
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
package Sympa::Spindle;
use strict;
use warnings;
use English qw(-no_match_vars);
sub new {
my $class = shift;
my %options = @_;
die $EVAL_ERROR unless eval sprintf 'require %s', $class->_distaff;
my $distaff = $class->_distaff->new(%options);
return undef unless $distaff;
my %spools;
my $spools = $class->_spools if $class->can('_spools');
foreach my $key (sort keys %{$spools || {}}) {
die $EVAL_ERROR unless eval sprintf 'require %s', $spools->{$key};
my $spool = $spools->{$key}->new;
return undef unless $spool;
$spools{$key} = $spool;
}
bless {%options, %spools, distaff => $distaff, finish => undef,} =>
$class;
}
sub spin {
my $self = shift;
my %options = @_;
my $processed = 0;
undef $self->{finish};
while (1) {
my ($message, $handle) = $self->{distaff}->next;
if ($message and $handle) {
my $status = $self->_twist($message, $handle);
unless (defined $status) {
$self->_on_failure($message, $handle);
} elsif ($status) {
$self->_on_success($message, $handle);
} else {
$self->_on_skip($message, $handle);
}
return $status if $options{once};
$processed++;
} elsif ($handle) {
$self->_on_garbage($message, $handle);
} else {
last;
}
last if $self->{finish};
}
return $processed;
}
sub _on_failure {
my $self = shift;
my $message = shift;
my $handle = shift;
$self->{distaff}->quarantine($handle);
}
sub _on_success {
my $self = shift;
my $message = shift;
my $handle = shift;
$self->{distaff}->remove($handle);
}
sub _on_skip {
my $self = shift;
my $message = shift;
my $handle = shift;
$handle->close if ref $handle;
}
sub _on_garbage {
my $self = shift;
my $message = shift;
my $handle = shift;
$self->{distaff}->quarantine($handle);
}
sub _twist {0}
1;
__END__
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$
# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015 GIP RENATER
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
package Sympa::Spindle::SendDigest;
use strict;
use warnings;
use POSIX qw();
use Time::Local qw();
use Conf;
use Sympa::Language;
use Sympa::Log;
use Sympa::Message;
use tools;
use base qw(Sympa::Spindle);
my $language = Sympa::Language->instance;
my $log = Sympa::Log->instance;
use constant _distaff => 'Sympa::Spool::Digest::Collection';
use constant _on_failure => 1;
use constant _on_garbage => 1;
use constant _on_skip => 1;
use constant _on_success => 1;
use constant _spools => {spool => 'Sympa::Bulk'};
sub _twist {
my $self = shift;
my $spool_digest = shift;
my $spool_handle = shift; # True scalar, not used.
return 0
unless $self->{send_now}
or _may_distribute_digest($spool_digest);
my $list = $spool_digest->{context};
$language->set_lang(
$list->{'admin'}{'lang'},
Conf::get_robot_conf($list->{'domain'}, 'lang'),
$Conf::Conf{'lang'}, 'en'
);
# Blindly send the message to all users.
$log->syslog('info', 'Sending digest to list %s', $list);
my $start_time = time;
$self->_distribute_digest($spool_digest);
$log->syslog('info', 'Digest of the list %s sent (%d seconds)',
$list, time - $start_time);
$log->db_log(
'robot' => $list->{'domain'},
'list' => $list->{'name'},
'action' => 'SendDigest',
'parameters' => "",
'target_email' => '',
'msg_id' => '',
'status' => 'success',
'error_type' => '',
'user_email' => ''
);
# Always succeeds.
return 1;
}
## Private subroutines.
# Prepare and distribute digest message(s) to the subscribers with
# reception digest, digestplain or summary.
# Old name: List::send_msg_digest(), Sympa::List::distribute_digest().
sub _distribute_digest {
$log->syslog('debug3', '(%s, %s)', @_);
my $self = shift;
my $spool_digest = shift;
my $list = $spool_digest->{context};
my $available_recipients = $list->get_digest_recipients_per_mode;
unless ($available_recipients) {
$log->syslog('info', 'No subscriber for sending digest in list %s',
$list);
unless ($self->{keep_digest}) {
while (1) {
my ($message, $handle) = $spool_digest->next;
if ($message and $handle) {
$spool_digest->remove($handle);
} elsif ($handle) {
$log->syslog('err', 'Cannot parse message <%s>',
$handle->basename);
$spool_digest->quarantine($handle);
} else {
last;
}
}
}
return 0;
}
my $time = time;
# Digest index.
my @all_msg;
my $i = 0;
while (1) {
my ($message, $handle) = $spool_digest->next;
last unless $handle; # No more messages.
unless ($message) {
$log->syslog('err', 'Cannot parse message <%s>',
$handle->basename);
$spool_digest->quarantine($handle);
next;
}
$i++;
# Commented because one Spam made Sympa die (MIME::tools 5.413)
#$entity->remove_sig;
my $msg = {
'id' => $i,
'subject' => $message->{'decoded_subject'},
'from' => $message->get_decoded_header('From'),
'date' => $message->get_decoded_header('Date'),
'full_msg' => $message->as_string,
'body' => $message->body_as_string,
'plain_body' => $message->get_plaindigest_body,
#FIXME: Might be extracted from Date:.
'month' => POSIX::strftime("%Y-%m", localtime $time),
'message_id' => $message->{'message_id'},
};
push @all_msg, $msg;
$spool_digest->remove($handle) unless $self->{keep_digest};
}
my $param = {
'replyto' => $list->get_list_address('owner'),
'to' => $list->get_list_address(),
'boundary1' => '----------=_'
. tools::get_message_id($list->{'domain'}),
'boundary2' => '----------=_'
. tools::get_message_id($list->{'domain'}),
};
# Compat. to 6.2a or earlier
$param->{'table_of_content'} = $language->gettext("Table of contents:");
if ($list->get_reply_to() =~ /^list$/io) {
$param->{'replyto'} = "$param->{'to'}";
}
$param->{'datetime'} =
$language->gettext_strftime("%a, %d %b %Y %H:%M:%S", localtime $time);
$param->{'date'} =
$language->gettext_strftime("%a, %d %b %Y", localtime $time);
## Split messages into groups of digest_max_size size
my @group_of_msg;
while (@all_msg) {
my @group = splice @all_msg, 0, $list->{'admin'}{'digest_max_size'};
push @group_of_msg, \@group;
}
$param->{'current_group'} = 0;
$param->{'total_group'} = scalar @group_of_msg;
## Foreach set of digest_max_size messages...
foreach my $group (@group_of_msg) {
$param->{'current_group'}++;
$param->{'msg_list'} = $group;
$param->{'auto_submitted'} = 'auto-generated';
# Prepare and send MIME digest, plain digest and summary.
foreach my $mode (qw{digest digestplain summary}) {
next unless exists $available_recipients->{$mode};
my $digest_message =
Sympa::Message->new_from_template($list, $mode,
$available_recipients->{$mode}, $param);
if ($digest_message) {
# Add RFC 2919 header field
$list->add_list_header($digest_message, 'id');
# Add RFC 2369 header fields
foreach my $field (
@{ tools::get_list_params($list->{'domain'})
->{'rfc2369_header_fields'}->{'format'}
}
) {
if (scalar grep { $_ eq $field }
@{$list->{'admin'}{'rfc2369_header_fields'}}) {
$list->add_list_header($digest_message, $field);
}
}
}
unless ($digest_message
and defined $self->{spool}
->store($digest_message, $available_recipients->{$mode})) {
$log->syslog('notice',
'Unable to send template "%s" to %s list subscribers',
$mode, $list);
next;
}
# Add number and size of digests sent to total in stats file.
my $numsent = scalar @{$available_recipients->{$mode}};
my $bytes = length $digest_message->as_string;
$list->{'stats'}[1] += $numsent;
$list->{'stats'}[2] += $bytes;
$list->{'stats'}[3] += $bytes * $numsent;
}
}
$list->savestats();
return 1;
}
# Returns 1 if the digest must be sent.
# Old name: Sympa::List::get_nextdigest(),
# Sympa::List::may_distribute_digest().
sub _may_distribute_digest {
$log->syslog('debug3', '(%s)', @_);
my $spool_digest = shift;
my $list = $spool_digest->{context};
return undef unless defined $spool_digest->{time};
return undef unless $list->is_digest;
my @days = @{$list->{'admin'}{'digest'}->{'days'} || []};
my $hh = $list->{'admin'}{'digest'}->{'hour'} || 0;
my $mm = $list->{'admin'}{'digest'}->{'minute'} || 0;
my @now = localtime time;
my $today = $now[6]; # current day
my @timedigest = localtime $spool_digest->{time};
## Should we send a digest today
my $send_digest = 0;
foreach my $d (@days) {
if ($d == $today) {