# list.pm - This module includes all list processing functions
# RCS Identication ; $Revision: 11341 $ ; $Date: 2014-09-02 07:08:40 +0200 (mar. 02 sept. 2014) $ 
#
# 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 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 List;

use strict;

use Encode;
use Fcntl qw(LOCK_SH LOCK_EX LOCK_NB LOCK_UN);
use HTML::Entities qw(encode_entities);
use POSIX qw(strftime);

use Datasource;
use SQLSource qw(create_db %date_format);
use Upgrade;
use Lock;
use Task;
use Scenario;
use Fetch;
use WebAgent;
use Exporter;
use tt2;
use Sympa::Constants;
use tools;

our @ISA = qw(Exporter);
our @EXPORT = qw(%list_of_lists);

=encoding utf-8

=head1 CONSTRUCTOR

=item new( [PHRASE] )

 List->new();

Creates a new object which will be used for a list and
eventually loads the list if a name is given. Returns
a List object.

=back

=head1 METHODS

=over 4

=item load ( LIST )

Loads the indicated list into the object.

=item save ( LIST )

Saves the indicated list object to the disk files.

=item savestats ()

Saves updates the statistics file on disk.

=item update_stats( BYTES )

Updates the stats, argument is number of bytes, returns the next
sequence number. Does nothing if no stats.

=item send_sub_to_owner ( WHO, COMMENT )
Send a message to the list owners telling that someone
wanted to subscribe to the list.

=item send_to_editor ( MSG )
    
Send a Mail::Internet type object to the editor (for approval).

=item send_msg ( MSG )

Sends the Mail::Internet message to the list.

=item send_file ( FILE, USER, GECOS )

Sends the file to the USER. FILE may only be welcome for now.

=item delete_user ( ARRAY )

Delete the indicated users from the list.
 
=item delete_admin_user ( ROLE, ARRAY )

Delete the indicated admin user with the predefined role from the list.

=item get_cookie ()

Returns the cookie for a list, if available.

=item get_max_size ()

Returns the maximum allowed size for a message.

=item get_reply_to ()

Returns an array with the Reply-To values.

=item get_default_user_options ()

Returns a default option of the list for subscription.

=item get_total ()

Returns the number of subscribers to the list.

=item get_user_db ( USER )

Returns a hash with the information regarding the indicated
user.

=item get_subscriber ( USER )

Returns a subscriber of the list.

=item get_admin_user ( ROLE, USER)

Return an admin user of the list with predefined role

=item get_first_user ()

Returns a hash to the first user on the list.

=item get_first_admin_user ( ROLE )

Returns a hash to the first admin user with predefined role on the list.

=item get_next_user ()

Returns a hash to the next users, until we reach the end of
the list.

=item get_next_admin_user ()

Returns a hash to the next admin users, until we reach the end of
the list.

=item update_user ( USER, HASHPTR )

Sets the new values given in the hash for the user.

=item update_admin_user ( USER, ROLE, HASHPTR )

Sets the new values given in the hash for the admin user.

=item add_user ( USER, HASHPTR )

Adds a new user to the list. May overwrite existing
entries.

=item add_admin_user ( USER, ROLE, HASHPTR )

Adds a new admin user to the list. May overwrite existing
entries.

=item is_user ( USER )

Returns true if the indicated user is member of the list.
 
=item am_i ( FUNCTION, USER )

Returns true is USER has FUNCTION (owner, editor) on the
list.

=item get_state ( FLAG )

Returns the value for a flag : sig or sub.

=item may_do ( ACTION, USER )

Chcks is USER may do the ACTION for the list. ACTION can be
one of following : send, review, index, getm add, del,
reconfirm, purge.

=item is_moderated ()

Returns true if the list is moderated.

=item archive_exist ( FILE )

Returns true if the indicated file exists.

=item archive_send ( WHO, FILE )

Send the indicated archive file to the user, if it exists.

=item archive_ls ()

Returns the list of available files, if any.

=item archive_msg ( MSG )

Archives the Mail::Internet message given as argument.

=item is_archived ()

Returns true is the list is configured to keep archives of
its messages.

=item get_stats ( OPTION )

Returns either a formatted printable strings or an array whith
the statistics. OPTION can be 'text' or 'array'.

=item print_info ( FDNAME )

Print the list information to the given file descriptor, or the
currently selected descriptor.

=cut

use Carp;

use IO::Scalar;
use Storable;
use Mail::Header;
use Archive;
use Language;
use Log;
use Conf;
use mail;
use Ldap;
use Time::Local;
use MIME::Entity;
use MIME::EncWords;
use MIME::Parser;
use Message;
use Family;
use PlainDigest;


## Database and SQL statement handlers
my ($dbh, $sth, $db_connected, @sth_stack, $use_db);

my %list_cache;

## DB fields with numeric type
## We should not do quote() for these while inserting data
my %numeric_field = ('cookie_delay_user' => 1,
		     'bounce_score_subscriber' => 1,
		     'subscribed_subscriber' => 1,
		     'included_subscriber' => 1,
		     'subscribed_admin' => 1,
		     'included_admin' => 1,
		     'wrong_login_count' => 1,
		      );
		      
## List parameters defaults
my %default = ('occurrence' => '0-1',
	       'length' => 25
	       );

my @param_order = qw (subject visibility info subscribe add unsubscribe del owner owner_include
		      send editor editor_include delivery_time account topics 
		      host lang web_archive archive digest digest_max_size available_user_options 
		      default_user_options msg_topic msg_topic_keywords_apply_on msg_topic_tagging reply_to_header reply_to forced_reply_to * 
		      verp_rate welcome_return_path remind_return_path merge_feature user_data_source include_file include_remote_file 
		      include_list include_remote_sympa_list include_ldap_query
                      include_ldap_2level_query include_sql_query include_admin ttl distribution_ttl creation update 
		      status serial custom_attribute);

## List parameters aliases
my %alias = ('reply-to' => 'reply_to',
	     'replyto' => 'reply_to',
	     'forced_replyto' => 'forced_reply_to',
	     'forced_reply-to' => 'forced_reply_to',
	     'custom-subject' => 'custom_subject',
	     'custom-header' => 'custom_header',
	     'subscription' => 'subscribe',
	     'unsubscription' => 'unsubscribe',
	     'max-size' => 'max_size');

##############################################################
## This hash COMPLETELY defines ALL list parameters     
## It is then used to load, save, view, edit list config files
##############################################################
## List parameters format accepts the following keywords :
## format :      Regexp aplied to the configuration file entry; 
##               some common regexps are defined in %regexp
## file_format : Config file format of the parameter might not be
##               the same in memory
## split_char:   Character used to separate multiple parameters 
## length :      Length of a scalar variable ; used in web forms
## scenario :    tells that the parameter is a scenario, providing its name
## default :     Default value for the param ; may be a configuration parameter (conf)
## synonym :     Defines synonyms for parameter values (for compatibility reasons)
## gettext_unit :Unit of the parameter ; this is used in web forms and refers to translated
##               strings in PO catalogs
## occurrence :  Occurerence of the parameter in the config file
##               possible values: 0-1 | 1 | 0-n | 1-n
##               example : a list may have multiple owner 
## gettext_id :    Title reference in NLS catalogues
## description : deescription text of a parameter
## group :       Group of parameters
## obsolete :    Obsolete parameter ; should not be displayed 
##               nor saved
## obsolete_values : defined obsolete values for a parameter
##                   these values should not get proposed on the web interface edition form
## order :       Order of parameters within paragraph
## internal :    Indicates that the parameter is an internal parameter
##               that should always be saved in the config file
## field_type :  used to select passwords web input type
###############################################################
%::pinfo = ('account' => {'format' => '\S+',
			  'length' => 10,
			  'gettext_id' => "Account",
			  'group' => 'other'
			  },
	    'add' => {'scenario' => 'add',
		      'gettext_id' => "Who can add subscribers",
		      'group' => 'command'
		      },
	    'anonymous_sender' => {'format' => '.+',
				   'gettext_id' => "Anonymous sender",
				   'group' => 'sending'
				   },
	    'archive' => {'format' => {'period' => {'format' => ['day','week','month','quarter','year'],
						    'synonym' => {'weekly' => 'week'},
						    'gettext_id' => "frequency",
						    'order' => 1
						},
				       'access' => {'format' => ['open','private','public','owner','closed'],
						    'synonym' => {'open' => 'public'},
						    'gettext_id' => "access right",
						    'order' => 2
						}
				   },
			  'gettext_id' => "Text archives",
			  'group' => 'archives'
		      },
	    'archive_crypted_msg' => {'format' => ['original','decrypted'],
				    'default' => 'original',
				    'gettext_id' => "Archive encrypted mails as cleartext",
				    'group' => 'archives'
				    },
           'available_user_options' => {'format' => {'reception' => {'format' => ['mail','notice','digest','digestplain','summary','nomail','txt','html','urlize','not_me'],
								     'occurrence' => '1-n',
								     'split_char' => ',',
								     'default' => 'mail,notice,digest,digestplain,summary,nomail,txt,html,urlize,not_me',
								     'gettext_id' => "reception mode"
								     },
						     },
					 'gettext_id' => "Available subscription options",
					 'group' => 'sending'
				     },

	    'bounce' => {'format' => {'warn_rate' => {'format' => '\d+',
						      'length' => 3,
						      'gettext_unit' => '%',
						      'default' => {'conf' => 'bounce_warn_rate'},
						      'gettext_id' => "warn rate",
						      'order' => 1
						  },
				      'halt_rate' => {'format' => '\d+',
						      'length' => 3,
						      'gettext_unit' => '%',
						      'default' => {'conf' => 'bounce_halt_rate'},
						      'gettext_id' => "halt rate",
						      'order' => 2
						  }
				  },
			 'gettext_id' => "Bounces management",
			 'group' => 'bounces'
		     },
	    'bouncers_level1' => {'format' => {'rate' => {'format' => '\d+',
								 'length' => 2,
								 'gettext_unit' => 'points',
								 'default' => {'conf' => 'default_bounce_level1_rate'},
								 'gettext_id' => "threshold",
								 'order' => 1
								 },
				               'action' => {'format' => ['remove_bouncers','notify_bouncers','none'],
								   'default' => 'notify_bouncers',
								   'gettext_id' => "action for this population",
								   'order' => 2
								   },
					       'notification' => {'format' => ['none','owner','listmaster'],
									 'default' => 'owner',
									 'gettext_id' => "notification",
									 'order' => 3
									 }
					   },
				      'gettext_id' => "Management of bouncers, 1st level",
				      'group' => 'bounces'
				  },
	     'bouncers_level2' => {'format' => {'rate' => {'format' => '\d+',
								 'length' => 2,
								 'gettext_unit' => 'points',
								 'default' => {'conf' => 'default_bounce_level2_rate'},
								 'gettext_id' => "threshold",
								 'order' => 1
								 },
				               'action' => {'format' =>  ['remove_bouncers','notify_bouncers','none'],
								   'default' => 'remove_bouncers',
								   'gettext_id' => "action for this population",
								   'order' => 2
								   },
					       'notification' => {'format' => ['none','owner','listmaster'],
									 'default' => 'owner',
									 'gettext_id' => "notification",
									 'order' => 3
									 }
								     },
				      'gettext_id' => "Management of bouncers, 2nd level",
				      'group' => 'bounces'
				  },
	    'clean_delay_queuemod' => {'format' => '\d+',
				       'length' => 3,
				       'gettext_unit' => 'days',
				       'default' => {'conf' => 'clean_delay_queuemod'},
				       'gettext_id' => "Expiration of unmoderated messages",
				       'group' => 'other'
				       },
	    'cookie' => {'format' => '\S+',
			 'length' => 15,
			 'default' => {'conf' => 'cookie'},
			 'gettext_id' => "Secret string for generating unique keys",
			 'group' => 'other'
		     },
	    'creation' => {'format' => {'date_epoch' => {'format' => '\d+',
							 'occurrence' => '1',
							 'gettext_id' => "epoch date",
							 'order' => 3
						     },
					'date' => {'format' => '.+',
						   'gettext_id' => "human readable",
						   'order' => 2
						   },
					'email' => {'format' => 'listmaster|'.&tools::get_regexp('email'),
						    'occurrence' => '1',
						    'gettext_id' => "who created the list",
						    'order' => 1
						    }
				    },
			   'gettext_id' => "Creation of the list",
			   'occurrence' => '0-1',
			   'internal' => 1,
			   'group' => 'other'

		       },
	'custom_attribute' => {
		'format' => {
			'id' => {
				'format' => '\w+',
				'length' => 20,
				'gettext_id' => "internal identifier",
				'occurrence' => '1',
				'order' =>1
			},
			'name' => {
				'format' => '.+',
				'length' =>30,
				'occurrence' => '1',
				'gettext_id' => "label",
				'order' => 2
			},
			'comment' => {
				'format' => '.+',
				'length' => 100,
				'gettext_id' => "additional comment",
				'order' => 3
			},
			'type' => {
				'format' => ['string','text','integer','enum'],
				'default' => 'string',
				'occurrence' => 1,
				'gettext_id' => "type",
				'order' => 4
			},
			'enum_values' => {
				'format' => '.+',
				'length' => 100,
				'gettext_id' => "possible attribute values (if enum is used)",
				'order' => 5
			},
			'optional' => {
				'format' => ['required','optional'],
				'gettext_id' => "is the attribute optional?",
				'order' => 6
			}
		
		},
		'occurrence' => '0-n',
		'gettext_id' => "Custom user attributes",
		'group' => 'other'
	},
	    'custom_header' => {'format' => '\S+:\s+.*',
				'length' => 30,
				'occurrence' => '0-n',
				'gettext_id' => "Custom header field",
				'group' => 'sending'
				},
	    'custom_subject' => {'format' => '.+',
				 'length' => 15,
				 'gettext_id' => "Subject tagging",
				 'group' => 'sending'
				 },
	    'custom_vars' => {'format' => {'name' => {'format' => '\S+',
						      'occurrence' => '1',
						      'gettext_id' => 'var name',
						      'order' => 1
						      },
					   'value' => {'format' => '.+',
						       'occurrence' => '1',
						       'gettext_id' => 'var value',
						       'order' => 2
						       }
				       },
			      'gettext_id' => "custom parameters",
			      'occurrence' => '0-n',
			      'group' => 'other'
			      },			      

            'default_user_options' => {'format' => {'reception' => {'format' => ['digest','digestplain','mail','nomail','summary','notice','txt','html','urlize','not_me'],
								    'default' => 'mail',
								    'gettext_id' => "reception mode",
								    'order' => 1
								    },
						    'visibility' => {'format' => ['conceal','noconceal'],
								     'default' => 'noconceal',
								     'gettext_id' => "visibility",
								     'order' => 2
								     }
						},
				       'gettext_id' => "Subscription profile",
				       'group' => 'sending'
				   },
	    'del' => {'scenario' => 'del',
		      'gettext_id' => "Who can delete subscribers",
		      'group' => 'command'
		      },
	    'delivery_time' => {'format' => '[0-2]?\d\:[0-6]\d',
				'length' => 5,
				'gettext_id' => "Delivery time (hh:mm)",
				'occurrence' => '0-1',
				'group' => 'sending'
		      },
	    'digest' => {'file_format' => '\d+(\s*,\s*\d+)*\s+\d+:\d+',
			 'format' => {'days' => {'format' => [0..6],
						 'file_format' => '1|2|3|4|5|6|7',
						 'occurrence' => '1-n',
						 'gettext_id' => "days",
						 'order' => 1
						 },
				      'hour' => {'format' => '\d+',
						 'length' => 2,
						 'occurrence' => '1',
						 'gettext_id' => "hour",
						 'order' => 2
						 },
				      'minute' => {'format' => '\d+',
						   'length' => 2,
						   'occurrence' => '1',
						   'gettext_id' => "minute",
						   'order' => 3
						   }
				  },
			 'gettext_id' => "Digest frequency",
			 'group' => 'sending'
		     },

	    'digest_max_size' => {'format' => '\d+',
				  'length' => 2,
				  'gettext_unit' => 'messages',
				  'default' => 25,
				  'gettext_id' => "Digest maximum number of messages",				  
				  'group' => 'sending'
		       },	    

	    'distribution_ttl' => {'format' => '\d+',
		      'length' => 6,
		      'gettext_unit' => 'seconds',
		      'default' => {'conf' => 'default_distribution_ttl'},
		      'gettext_id' => "Inclusions timeout for message distribution",
		      'group' => 'data_source'
		      },

	    'dkim_feature' => {'format' => ['on','off'],
			      'occurrence' => '0-1',
			      'default' => {'conf' => 'dkim_feature'},
			      'gettext_id' => "Insert DKIM signature to messages sent to the list",
			      'comment' =>  "Enable/Disable DKIM. This feature require Mail::DKIM to installed and may be some custom scenario to be updated",
			      'group' => 'dkim',
			  },
	    'dkim_signature_apply_on'=> {'format' => ['md5_authenticated_messages','smime_authenticated_messages','dkim_authenticated_messages','editor_validated_messages','none','any'],
					 'occurrence' => '0-n',
					 'split_char' => ',',
					 'default' => {'conf' => 'dkim_signature_apply_on'},
					 'gettext_id' => "The categories of messages sent to the list that will be signed using DKIM.",
					 'comment' => "This parameter controls in which case messages must be signed using DKIM, you may sign every message choosing 'any' or a subset. The parameter value is a comma separated list of keywords",
					 'group' => 'dkim',
					 },
	    'dkim_parameters'=> {'format' => {'private_key_path'=> {'format' => '\S+',
		                         			  'occurrence' => '0-1',
			                                          'default' => {'conf' => 'dkim_private_key_path'},
			                                          'gettext_id' => "File path for list DKIM private key",
								  'comment' => "The file must contain a RSA pem encoded private key", 
								  'order' => 1
					                         },
					     'selector' => { 'format' => '\S+',
		                         			  'occurrence' => '0-1',
			                                          'default' => {'conf' => 'dkim_selector'},
							          'comment' => "The selector is used in order to build the DNS query for public key. It is up to you to choose the value you want but verify that you can query the public DKIM key for <selector>._domainkey.your_domain",
			                                          'gettext_id' => "Selector for DNS lookup of DKIM public key",
								  'order' => 2
                                                                  },
							          
					     'header_list'=>      { 'format' => '\S+',
		                         			  'occurrence' => '0-1',
			                                          'default' => {'conf' => 'dkim_header_list'},
			                                          'gettext_id' => 'List of headers to be included ito the message for signature',
								  'comment' => 'You should probably use teh default value which is the value recommended by RFC4871',
								  'order' => 4,
								  'obsolete' => 1,
                                                                  },
					     'signer_domain' =>   {'format' => '\S+',
		                         			  'occurrence' => '0-1',
			                                          'default' => {'conf' => 'dkim_signer_domain'},
			                                          'gettext_id' => 'DKIM "d=" tag, you should probably use the default value',
								   'omment' => ' The DKIM "d=" tag, is the domain of the signing entity. the list domain MUST must be included in the "d=" domain',
								  'order' => 5
								 },
                                             'signer_identity'=>  {'format' => '\S+',
		                         			  'occurrence' => '0-1',
								  'comment' => 'DKIM "i=" tag, you should probably not use this parameter, as recommended by RFC 4871, default for list brodcasted messages is i=<listname>-request@<domain>',
			                                          'gettext_id' => 'DKIM "i=" tag, you should probably leave this parameter empty',
								  'order' => 6
								 },
					     },
			      'group' => 'dkim',
			      'comment' => 'A set of parameters in order to define outgoing DKIM signature', 
			      'occurrence' => '0-1',
			      'gettext_id' => "DKIM configuration",
			  },
            'dmarc_protection' => { 
			  'format' => {
                                   'mode' => { 'format' => [ 'none', 'all', 'dkim_signature', 'dmarc_reject', 'dmarc_any', 'dmarc_quarantine', 'domain_regex' ],
				     'synonym' => {
					'dkim' => 'dkim_signature',
					'dkim_exists' => 'dkim_signature',
					'dmarc_exists' => 'dmarc_any',
					'domain' => 'domain_regex',
					'domain_match' => 'domain_regex',
				     },
                                     'gettext_id' => "Protection modes",
				     'split_char' => ',',
		                     'occurrence' => '0-n',
                                     'default' => { 'conf'=>'dmarc_protection_mode' },
                                     'comment' => 'Select one or more operation modes.  "Domain matching regular expression" (domain_regex) matches the specified Domain regexp; "DKIM signature exists" (dkim_signature) matches any message with a DKIM signature header; "DMARC policy ..." (dmarc_*) matches messages from sender domains with a DMARC policy as given; "all" (all) matches all messages.',
                                     'order' => 1
                                   },
                                   'domain_regex' => { 'format' => '.+',
                                     'gettext_id' => "Match domain regexp",
		                     'occurrence' => '0-1',
				     'comment' => 'Regexp match pattern for From domain',
                                     'order' => 2,
                                     'default' => { 'conf'=>'dmarc_protection_domain_regex' },
                                   },
				   'other_email' => { 'format' => '.+',
                                     'gettext_id' => "New From address",
		                     'occurrence' => '0-1',
                                     'comment' => 'This is the email address to use when modifying the From header.  It defaults to the list address.  This is similar to Anonymisation but preserves the original sender details in the From address phrase.',
                                     'order' => 3,
                                     'default' => { 'conf'=>'dmarc_protection_other_email' },
                                   },
				   'phrase' => { 'format' => [ 'display_name', 'name_and_email', 'name_via_list', 'name_email_via_list' ],
				     'synonym' => {'name' => 'display_name'},
                                     'default' => { 'conf'=>'dmarc_protection_phrase' },
                                     'gettext_id' => "New From name format",
		                     'occurrence' => '0-1',
                                     'comment' => 'This is the format to be used for the sender name part of the new From header.',
                                     'order' => 4,
                                   },
                          },
                          'gettext_id' => "DMARC Protection",
                          'group' => 'dkim',
			  'comment' => 'Parameters to define how to manage From address processing to avoid some domains\' excessive DMARC protection', 
			  'occurrence' => '0-1',
                      },
	    'editor' => {'format' => {'email' => {'format' => &tools::get_regexp('email'),
						  'length' => 30,
						  'occurrence' => '1',
						  'gettext_id' => "email address",
						  'order' => 1
						  },
				      'reception' => {'format' => ['mail','nomail'],
						      'default' => 'mail',
						      'gettext_id' => "reception mode",
						      'order' => 4
						      },
				      'visibility' => {'format' => ['conceal','noconceal'],
						      'default' => 'noconceal',
						      'gettext_id' => "visibility",
						      'order' => 5
						      },
				      'gecos' => {'format' => '.+',
						  'length' => 30,
						  'gettext_id' => "name",
						  'order' => 2
						  },
				      'info' => {'format' => '.+',
						 'length' => 30,
						 'gettext_id' => "private information",
						 'order' => 3
						 }
				  },
			 'occurrence' => '0-n',
			 'gettext_id' => "Moderators",
			 'group' => 'description'
			 },
	    'editor_include' => {'format' => {'source' => {'datasource' => 1,
							   'occurrence' => '1',
							   'gettext_id' => 'the data source',
							   'order' => 1
							   },
					      'source_parameters' => {'format' => '.*',
								      'occurrence' => '0-1',
								      'gettext_id' => 'data source parameters',
								      'order' => 2
    								      },
					      'reception' => {'format' => ['mail','nomail'],
							      'default' => 'mail',
							      'gettext_id' => 'reception mode',
							       'order' => 3
							      },
				              'visibility' => {'format' => ['conceal','noconceal'],
							       'default' => 'noconceal',
							       'gettext_id' => "visibility",
							       'order' => 5
					                      }
					      
					      },
				  'occurrence' => '0-n',
				  'gettext_id' => 'Moderators defined in an external data source',
				  'group' => 'description',
			      },
	    'expire_task' => {'task' => 'expire',
			      'gettext_id' => "Periodical subscription expiration task",
			      'group' => 'other'
			 },
 	    'family_name' => {'format' => &tools::get_regexp('family_name'),
 			      'occurrence' => '0-1',
 			      'gettext_id' => 'Family name',
			      'internal' => 1,
 			      'group' => 'description'
 			      },
	    'footer_type' => {'format' => ['mime','append'],
			      'default' => 'mime',
			      'gettext_id' => "Attachment type",
			      'group' => 'sending'
			      },
	    'forced_reply_to' => {'format' => '\S+',
				  'gettext_id' => "Forced reply address",
				  'obsolete' => 1
			 },
	    'host' => {'format' => &tools::get_regexp('host'),
		       'length' => 20,
		       'default' => {'conf' => 'host'},
		       'gettext_id' => "Internet domain",
		       'group' => 'description'
		   },
	    'include_file' => {'format' => '\S+',
			       'length' => 20,
			       'occurrence' => '0-n',
			       'gettext_id' => "File inclusion",
			       'group' => 'data_source'
			       },
	    'include_remote_file' => {'format' => {'url' => {'format' => '.+',
							     'gettext_id' => "data location URL",
							     'occurrence' => '1',
							     'length' => 50,
							     'order' => 2
							     },					       
						   'user' => {'format' => '.+',
							      'gettext_id' => "remote user",
							      'order' => 3,
							      'occurrence' => '0-1'
							      },
						   'passwd' => {'format' => '.+',
								'length' => 10,
								'field_type' => 'password',
								'gettext_id' => "remote password",
								'order' => 4,
								'occurrence' => '0-1'
								},							      
						    'name' => {'format' => '.+',
							       'gettext_id' => "short name for this source",
							       'length' => 15,
							       'order' => 1
							       }
						     },
				      'gettext_id' => "Remote file inclusion",
				      'occurrence' => '0-n',
				      'group' => 'data_source'
				      },				  
	    'include_ldap_query' => {'format' => {'host' => {'format' => &tools::get_regexp('multiple_host_with_port'),
							     'occurrence' => '1',
							     'gettext_id' => "remote host",
							     'order' => 2
							     },
						  'port' => {'format' => '\d+',
							     'length' => 4,
							     'gettext_id' => "remote port",
							     'obsolete' => 1,
							     'order' => 2
							     },
						  'user' => {'format' => '.+',
							     'gettext_id' => "remote user",
							     'order' => 3
							     },
						  'passwd' => {'format' => '.+',
							       'length' => 10,
							       'field_type' => 'password',
							       'gettext_id' => "remote password",
							       'order' => 3
							       },
						  'suffix' => {'format' => '.+',
							       'gettext_id' => "suffix",
							       'order' => 4
							       },
						  'filter' => {'format' => '.+',
							       'length' => 50,
							       'occurrence' => '1',
							       'gettext_id' => "filter",
							       'order' => 7
							       },
						  'attrs' => {'format' => '\w+',
							      'length' => 15,
							      'default' => 'mail',
							      'gettext_id' => "extracted attribute",
							      'order' => 8
							      },
						  'select' => {'format' => ['all','first'],
							       'default' => 'first',
							       'gettext_id' => "selection (if multiple)",
							       'order' => 9
							       },
					          'scope' => {'format' => ['base','one','sub'],
							      'default' => 'sub',
							      'gettext_id' => "search scope",
							      'order' => 5
							      },
						  'timeout' => {'format' => '\w+',
								'default' => 30,
								'gettext_unit' => 'seconds',
								'gettext_id' => "connection timeout",
								'order' => 6
								},
						   'name' => {'format' => '.+',
							      'gettext_id' => "short name for this source",
							      'length' => 15,
							      'order' => 1
							      },
							      'use_ssl' => {'format' => ['yes','no'],
									    'default' => 'no',
									    'gettext_id' => 'use SSL (LDAPS)',
									    'order' => 2.5,
									},
							      'ssl_version' => {'format' => ['sslv2','sslv3','tls'],
										'default' => 'sslv3',
										'gettext_id' => 'SSL version',
										'order' => 2.5,
									    },
							      'ssl_ciphers' => {'format' => '.+',
										'default' => 'ALL',
										'gettext_id' => 'SSL ciphers used',
										'order' => 2.5,
									   },
							      
							      
									    
					      },
				     'occurrence' => '0-n',
				     'gettext_id' => "LDAP query inclusion",
				     'group' => 'data_source'
				     },
	    'include_ldap_2level_query' => {'format' => {'host' => {'format' => &tools::get_regexp('multiple_host_with_port'),
							     'occurrence' => '1',
							     'gettext_id' => "remote host",
							     'order' => 1
							     },
						  'port' => {'format' => '\d+',
							     'length' => 4,
							     'gettext_id' => "remote port",
							     'obsolete' => 1,
							     'order' => 2
							     },
						  'user' => {'format' => '.+',
							     'gettext_id' => "remote user",
							     'order' => 3
							     },
						  'passwd' => {'format' => '.+',
							       'length' => 10,
							       'field_type' => 'password',
							       'gettext_id' => "remote password",
							       'order' => 3
							       },
						  'suffix1' => {'format' => '.+',
							       'gettext_id' => "first-level suffix",
							       'order' => 4
							       },
						  'filter1' => {'format' => '.+',
							       'length' => 50,
							       'occurrence' => '1',
							       'gettext_id' => "first-level filter",
							       'order' => 7
							       },
						  'attrs1' => {'format' => '\w+',
							      'length' => 15,
							      'gettext_id' => "first-level extracted attribute",
							      'order' => 8
							      },
						  'select1' => {'format' => ['all','first','regex'],
							       'default' => 'first',
							       'gettext_id' => "first-level selection",
							       'order' => 9
							       },
					          'scope1' => {'format' => ['base','one','sub'],
							      'default' => 'sub',
							      'gettext_id' => "first-level search scope",
							      'order' => 5
							      },
						  'timeout1' => {'format' => '\w+',
								'default' => 30,
								'gettext_unit' => 'seconds',
								'gettext_id' => "first-level connection timeout",
								'order' => 6
								},
						  'regex1' => {'format' => '.+',
								'length' => 50,
								'default' => '',
								'gettext_id' => "first-level regular expression",
								'order' => 10
								},
						  'suffix2' => {'format' => '.+',
							       'gettext_id' => "second-level suffix template",
							       'order' => 11
							       },
						  'filter2' => {'format' => '.+',
							       'length' => 50,
							       'occurrence' => '1',
							       'gettext_id' => "second-level filter template",
							       'order' => 14
							       },
						  'attrs2' => {'format' => '\w+',
							      'length' => 15,
							      'default' => 'mail',
							      'gettext_id' => "second-level extracted attribute",
							      'order' => 15
							      },
						  'select2' => {'format' => ['all','first','regex'],
							       'default' => 'first',
							       'gettext_id' => "second-level selection",
							       'order' => 16
							       },
					          'scope2' => {'format' => ['base','one','sub'],
							      'default' => 'sub',
							      'gettext_id' => "second-level search scope",
							      'order' => 12
							      },
						  'timeout2' => {'format' => '\w+',
								'default' => 30,
								'gettext_unit' => 'seconds',
								'gettext_id' => "second-level connection timeout",
								'order' => 13
								},
						  'regex2' => {'format' => '.+',
								'length' => 50,
								'default' => '',
								'gettext_id' => "second-level regular expression",
								'order' => 17
								},
						   'name' => {'format' => '.+',
							      'gettext_id' => "short name for this source",
							      'length' => 15,
							      'order' => 1
							      },
							      'use_ssl' => {'format' => ['yes','no'],
									    'default' => 'no',
									    'gettext_id' => 'use SSL (LDAPS)',
									    'order' => 2.5,
									},
							      'ssl_version' => {'format' => ['sslv2','sslv3','tls'],
										'default' => '',
										'gettext_id' => 'SSL version',
										'order' => 2.5,
									    },
							      'ssl_ciphers' => {'format' => '.+',
										'default' => 'ALL',
										'gettext_id' => 'SSL ciphers used',
										'order' => 2.5,
									    },

					      },
				     'occurrence' => '0-n',
				     'gettext_id' => "LDAP 2-level query inclusion",
				     'group' => 'data_source'
				     },
	    'include_list' => {'format' => &tools::get_regexp('listname').'(\@'.&tools::get_regexp('host').')?',
			       'occurrence' => '0-n',
			       'gettext_id' => "List inclusion",
			       'group' => 'data_source'
			       },
	    'include_remote_sympa_list' => {'format' => {'host' => {'format' => &tools::get_regexp('host'),
							    'occurrence' => '1',
							    'gettext_id' => "remote host",
							    'order' => 1
							    },
							 'port' => {'format' => '\d+',
							     'default' => 443,
							     'length' => 4,
							     'gettext_id' => "remote port",
							     'order' => 2
							     },
							 'path' => {'format' => '\S+',
			                                     'length' => 20,
			                                     'occurrence' => '1',
			                                     'gettext_id' => "remote path of sympa list dump",
							     'order' => 3 

			                                     },
                                                         'cert' => {'format' => ['robot','list'],
							           'gettext_id' => "certificate for authentication by remote Sympa",
								   'default' => 'list',
								    'order' => 4
								    },
							   'name' => {'format' => '.+',
								      'gettext_id' => "short name for this source",
								      'length' => 15,
								      'order' => 1
								      }
					},

			       'occurrence' => '0-n',
			       'gettext_id' => "remote list inclusion",
			       'group' => 'data_source'
			       },
	    'include_sql_query' => {'format' => {'db_type' => {'format' => '\S+',
							       'occurrence' => '1',
							       'gettext_id' => "database type",
							       'order' => 1
							       },
						 'host' => {'format' => &tools::get_regexp('host'),
# Not required for ODBC
#							    'occurrence' => '1',
							    'gettext_id' => "remote host",
							    'order' => 2
							    },
						 'db_port' => {'format' => '\d+',
							       'gettext_id' => "database port",
							       'order' => 3 
							       },
					         'db_name' => {'format' => '\S+',
							       'occurrence' => '1',
							       'gettext_id' => "database name",
							       'order' => 4 
							       },
						 'connect_options' => {'format' => '.+',
								       'gettext_id' => "connection options",
								       'order' => 4
								       },
						 'db_env' => {'format' => '\w+\=\S+(;\w+\=\S+)*',
							      'order' => 5,
							      'gettext_id' => "environment variables for database connection"
							      },
						 'user' => {'format' => '\S+',
							    'occurrence' => '1',
							    'gettext_id' => "remote user",
							    'order' => 6
							    },
						 'passwd' => {'format' => '.+',
							      'field_type' => 'password',
							      'gettext_id' => "remote password",
							      'order' => 7
							      },
						 'sql_query' => {'format' => &tools::get_regexp('sql_query'),
								 'length' => 50,
								 'occurrence' => '1',
								 'gettext_id' => "SQL query",
								 'order' => 8
								 },
						  'f_dir' => {'format' => '.+',
							     'gettext_id' => "Directory where the database is stored (used for DBD::CSV only)",
							     'order' => 9
							     },
						  'name' => {'format' => '.+',
							     'gettext_id' => "short name for this source",
							     'length' => 15,
							     'order' => 1
							     }
						 
					     },
				    'occurrence' => '0-n',
				    'gettext_id' => "SQL query inclusion",
				    'group' => 'data_source'
				    },
	    'inclusion_notification_feature' => {'format' => ['on','off'],
						 'occurrence' => '0-1',
						 'default' => 'off',
						 'gettext_id' => "Notify subscribers when they are included from a data source?",
						 'group' => 'data_source',
					     },
	    'info' => {'scenario' => 'info',
		       'gettext_id' => "Who can view list information",
		       'group' => 'command'
		       },
	    'invite' => {'scenario' => 'invite',
			 'gettext_id' => "Who can invite people",
			 'group' => 'command'
			 },
	    'lang' => {'format' => [], ## &Language::GetSupportedLanguages() called later
		       'file_format' => '\w+',
		       'default' => {'conf' => 'lang'},
		       'gettext_id' => "Language of the list",
		       'group' => 'description'
		   },
 	    'latest_instantiation' => {'format' => {'date_epoch' => {'format' => '\d+',
 								     'occurrence' => '1',
 								     'gettext_id' => 'epoch date',
 								     'order' => 3
 								     },
 						    'date' => {'format' => '.+',
 							       'gettext_id' => 'date',
 							       'order' => 2
 							       },
 						    'email' => {'format' => 'listmaster|'.&tools::get_regexp('email'),
 								'occurrence' => '0-1',
 								'gettext_id' => 'who ran the instantiation',
 								'order' => 1
 								}
 						},
 				       'gettext_id' => 'Latest family instantiation',
				       'internal' => 1,
				       'group' => 'other'
 				       },
	    'loop_prevention_regex' => {'format' => '\S*',
					'length' => 70,
					'default' => {'conf' => 'loop_prevention_regex'},
					'gettext_id' => "Regular expression applied to prevent loops with robots",
					'group' => 'other'
					},
	    'max_size' => {'format' => '\d+',
			   'length' => 8,
			   'gettext_unit' => 'bytes',
			   'default' => {'conf' => 'max_size'},
			   'gettext_id' => "Maximum message size",
			   'group' => 'sending'
		       },
	    'msg_topic' => {'format' => {'name' => {'format' => '[\-\w]+',
						    'length' => 15,
						    'occurrence' => '1',
						    'gettext_id' => "Message topic name",
						    'order' => 1		
						    }, 
  					 'keywords' => {'format' => '[^,\n]+(,[^,\n]+)*',
							'occurrence' => '0-1',
							'gettext_id' => "Message topic keywords",
							'order' => 2		
							},
				         'title' => {'format' => '.+',
						     'length' => 35,
						     'occurrence' => '1',
						     'gettext_id' => "Message topic title",
						     'order' => 3		
						     }
				         },
			    'occurrence' => '0-n',
			    'gettext_id' => "Topics for message categorization",
			    'group' => 'sending'
			    },
	    'msg_topic_keywords_apply_on' => { 'format' => ['subject','body','subject_and_body'],
					       'occurrence' => '0-1',
					       'default' => 'subject',
					       'gettext_id' => "Defines to which part of messages topic keywords are applied",
					       'group' => 'sending'
					     },    

	    'msg_topic_tagging' => { 'format' => ['required_sender','required_moderator','optional'],
				      'occurrence' => '0-1',
				      'default' => 'optional',
				      'gettext_id' => "Message tagging",
				      'group' => 'sending'
				      },    	       				   
	    'owner' => {'format' => {'email' => {'format' => &tools::get_regexp('email'),
						 'length' =>30,
						 'occurrence' => '1',
						 'gettext_id' => "email address",
						 'order' => 1
						 },
				     'reception' => {'format' => ['mail','nomail'],
						     'default' => 'mail',
						     'gettext_id' => "reception mode",
						     'order' =>5
						     },
				     'visibility' => {'format' => ['conceal','noconceal'],
						      'default' => 'noconceal',
						      'gettext_id' => "visibility",
						      'order' => 6
				                     },
				     'gecos' => {'format' => '.+',
						 'length' => 30,
						 'gettext_id' => "name",
						 'order' => 2
						 },
				     'info' => {'format' => '.+',
						'length' => 30,
						'gettext_id' => "private information",
						'order' => 3
						},
				     'profile' => {'format' => ['privileged','normal'],
						   'default' => 'normal',
						   'gettext_id' => "profile",
						   'order' => 4
						   }
				 },
			'occurrence' => '1-n',
			'gettext_id' => "Owner",
			'group' => 'description'
			},
	    'owner_include' => {'format' => {'source' => {'datasource' => 1,
							  'occurrence' => '1',
							  'gettext_id' => 'the datasource',
							  'order' => 1
							  },
					     'source_parameters' => {'format' => '.*',
								     'occurrence' => '0-1',
								     'gettext_id' => 'datasource parameters',
								     'order' => 2
						      },
					     'reception' => {'format' => ['mail','nomail'],
							     'default' => 'mail',
							     'gettext_id' => 'reception mode',
							     'order' => 4
							 },
				             'visibility' => {'format' => ['conceal','noconceal'],
							      'default' => 'noconceal',
							      'gettext_id' => "visibility",
							      'order' => 5
				                             },
					     'profile' => {'format' => ['privileged','normal'],
							   'default' => 'normal',
							   'gettext_id' => 'profile',
							    'order' => 3
						       }
					 },
				'occurrence' => '0-n',
				'gettext_id' => 'Owners defined in an external data source',
				'group' => 'description',
			    },
	    'priority' => {'format' => [0..9,'z'],
			   'length' => 1,
			   'default' => {'conf' => 'default_list_priority'},
			   'gettext_id' => "Priority",
			   'group' => 'description'
		       },
	    'reject_mail_from_automates_feature' => {'format' => ['on','off'],
						     'occurrence' => '0-1',
						     'default' => {'conf' => 'reject_mail_from_automates_feature'},
			       'gettext_id' => "Reject mail from automates (crontab, etc)?",
			       'group' => 'sending'
			       },	
	    'remind' => {'scenario' => 'remind',
			 'gettext_id' => "Who can start a remind process",
			 'group' => 'command'
			  },
	    'remind_return_path' => {'format' => ['unique','owner'],
				     'default' => {'conf' => 'remind_return_path'},
				     'gettext_id' => "Return-path of the REMIND command",
				     'group' => 'bounces'
				 },
	    'remind_task' => {'task' => 'remind',
			      'gettext_id' => 'Periodical subscription reminder task',
			      'default' => {'conf' => 'default_remind_task'},
			      'group' => 'other'
			      },
	    'remove_headers' => {'format' => '\S+',
				 'gettext_id' => 'Incoming SMTP header fields to be removed',
				 'default' => {'conf' => 'remove_headers'},
				 'group' => 'sending',
				 'occurrence' => '0-n',
				 'split_char' => ',',
				 },
	    'remove_outgoing_headers' => {'format' => '\S+',
					  'gettext_id' => 'Outgoing SMTP header fields to be removed',
					  'default' => {'conf' => 'remove_outgoing_headers'},
					  'group' => 'sending',
					  'occurrence' => '0-n',
					  'split_char' => ',',
					  },
	    'reply_to' => {'format' => '\S+',
			   'default' => 'sender',
			   'gettext_id' => "Reply address",
			   'group' => 'sending',
			   'obsolete' => 1
			   },
	    'reply_to_header' => {'format' => {'value' => {'format' => ['sender','list','all','other_email'],
							   'default' => 'sender',
							   'gettext_id' => "value",
							   'occurrence' => '1',
							   'order' => 1
							   },
					       'other_email' => {'format' => &tools::get_regexp('email'),
								 'gettext_id' => "other email address",
								 'order' => 2
								 },
					       'apply' => {'format' => ['forced','respect'],
							   'default' => 'respect',
							   'gettext_id' => "respect of existing header field",
							   'order' => 3
							   }
					   },
				  'gettext_id' => "Reply address",
				  'group' => 'sending'
				  },		
	    'review' => {'scenario' => 'review',
			 'synonym' => {'open' => 'public'},
			 'gettext_id' => "Who can review subscribers",
			 'group' => 'command'
			 },
	    'rfc2369_header_fields' => {'format' => ['help','subscribe','unsubscribe','post','owner','archive'],
					'default' => {'conf' => 'rfc2369_header_fields'},
					'occurrence' => '0-n',
					'split_char' => ',',
					'gettext_id' => "RFC 2369 Header fields",
					'group' => 'sending'
					},
	    'send' => {'scenario' => 'send',
		       'gettext_id' => "Who can send messages",
		       'group' => 'sending'
		       },
	    'serial' => {'format' => '\d+',
			 'default' => 0,
			 'length' => 3,
			 'default' => 0,
			 'gettext_id' => "Serial number of the config",
			 'internal' => 1,
			 'group' => 'other'
			 },
	    'shared_doc' => {'format' => {'d_read' => {'scenario' => 'd_read',
						       'gettext_id' => "Who can view",
						       'order' => 1
						       },
					  'd_edit' => {'scenario' => 'd_edit',
						       'gettext_id' => "Who can edit",
						       'order' => 2
						       },
					  'quota' => {'format' => '\d+',
						      'default' => {'conf' => 'default_shared_quota'},
						      'length' => 8,
						      'gettext_unit' => 'Kbytes',
						      'gettext_id' => "quota",
						      'order' => 3
						      }
				      },
			     'gettext_id' => "Shared documents",
			     'group' => 'command'
			 },
	    'spam_protection' => {'format' => ['at','javascript','none'],
			 'default' => 'javascript',
			 'gettext_id' => "email address protection method",
			 'group' => 'other'
			  },
	    'web_archive_spam_protection' => {'format' => ['cookie','javascript','at','none'],
			 'default' => {'conf' => 'web_archive_spam_protection'},
			 'gettext_id' => "email address protection method",
			 'group' => 'archives'
			  },

	    'status' => {'format' => ['open','closed','pending','error_config','family_closed'],
			 'default' => 'open',
			 'gettext_id' => "Status of the list",
			 'internal' => 1,
			 'group' => 'other'
			 },
	    'sql_fetch_timeout' => {'format' => '\d+',
		      'length' => 6,
		      'gettext_unit' => 'seconds',
		      'default' => {'conf' => 'default_sql_fetch_timeout'},
		      'gettext_id' => "Timeout for fetch of include_sql_query",
		      'group' => 'data_source'
		      },
	    'subject' => {'format' => '.+',
			  'length' => 50,
			  'occurrence' => '1',
			  'gettext_id' => "Subject of the list",
			  'group' => 'description'
			   },
	    'subscribe' => {'scenario' => 'subscribe',
			    'gettext_id' => "Who can subscribe to the list",
			    'group' => 'command'
			    },
	    'topics' => {'format' => '[\-\w]+(\/[\-\w]+)?',
			 'split_char' => ',',
			 'occurrence' => '0-n',
			 'gettext_id' => "Topics for the list",
			 'group' => 'description'
			 },
	    'ttl' => {'format' => '\d+',
		      'length' => 6,
		      'gettext_unit' => 'seconds',
		      'default' => {'conf' => 'default_ttl'},
		      'gettext_id' => "Inclusions timeout",
		      'group' => 'data_source'
		      },
	    'unsubscribe' => {'scenario' => 'unsubscribe',
			      'gettext_id' => "Who can unsubscribe",
			      'group' => 'command'
			      },
	    'update' => {'format' => {'date_epoch' => {'format' => '\d+',
						       'length' => 8,
						       'occurrence' => '1',
						       'gettext_id' => 'epoch date',
						       'order' => 3
						       },
				      'date' => {'format' => '.+',
						 'length' => 30,
						 'gettext_id' => 'date',
						 'order' => 2
						 },
				      'email' => {'format' => '(listmaster|automatic|'.&tools::get_regexp('email').')',
						  'length' => 30,
						  'occurrence' => '1',
						  'gettext_id' => 'who updated the config',
						  'order' => 1
						  }
				  },
			 'gettext_id' => "Last update of config",
			 'internal' => 1,
			 'group' => 'other'
		     },
	    'user_data_source' => {'format' => '\S+',
				   'default' => 'include2',
				   'gettext_id' => "User data source",
				   'group' => 'data_source',
				   'obsolete' => 1,
				   },
	    'pictures_feature' => {'format' => ['on','off'],
			       'occurrence' => '0-1',
			       'default' => {'conf' => 'pictures_feature'},
			       'gettext_id' => "Allow picture display? (must be enabled for the current robot)",
			       'group' => 'other'
			       },	
	    'merge_feature' => {'format' => ['on','off'],
			       'occurrence' => '0-1',
			       'default' => {'conf' => 'merge_feature'},
			       'gettext_id' => "Allow message personnalization",
			       'group' => 'sending'
			       },
	    'visibility' => {'scenario' => 'visibility',
			     'synonym' => {'public' => 'noconceal',
					   'private' => 'conceal'},
			     'gettext_id' => "Visibility of the list",
			     'group' => 'description'
			     },
	    'web_archive'  => {'format' => {'access' => {'scenario' => 'access_web_archive',
							 'gettext_id' => "access right",
							 'order' => 1
							 },
					    'quota' => {'format' => '\d+',
							'default' => {'conf' => 'default_archive_quota'},
							'length' => 8,
							'gettext_unit' => 'Kbytes',
							'gettext_id' => "quota",
							'order' => 2
							},
 					    'max_month' => {'format' => '\d+',
							    'length' => 3,
							    'gettext_id' => "Maximum number of month archived",
							    'order' => 3 
  							     }
					},
			       
			       'gettext_id' => "Web archives",
			       'group' => 'archives'

			   },
	    'welcome_return_path' => {'format' => ['unique','owner'],
				      'default' => {'conf' => 'welcome_return_path'},
				      'gettext_id' => "Welcome return-path",
				      'group' => 'bounces'
				  },
	    'verp_rate' => {'format' => ['100%','50%','33%','25%','20%','10%','5%','2%','0%'],
			     'default' =>  {'conf' => 'verp_rate'},
			     'gettext_id' => "percentage of list members in VERP mode",
			     'group' => 'bounces'
			     },

	    );

## List parameter values except for parameters below.
my %list_option = (

    # reply_to_header.apply
    'forced'  => {'gettext_id' => 'overwrite Reply-To: header field'},
    'respect' => {'gettext_id' => 'preserve existing header field'},

    # reply_to_header.value
    'sender' => {'gettext_id' => 'sender'},

    # reply_to_header.value, include_remote_sympa_list.cert
    'list' => {'gettext_id' => 'list'},

    # include_ldap_2level_query.select2, include_ldap_2level_query.select1,
    # include_ldap_query.select, reply_to_header.value, dmarc_protection.mode
    'all' => {'gettext_id' => 'all'},

    # reply_to_header.value
    'other_email' => {'gettext_id' => 'other email address'},

    # msg_topic_keywords_apply_on
    'subject'          => {'gettext_id' => 'subject field'},
    'body'             => {'gettext_id' => 'message body'},
    'subject_and_body' => {'gettext_id' => 'subject and body'},

    # bouncers_level2.notification, bouncers_level2.action,
    # bouncers_level1.notification, bouncers_level1.action,
    # spam_protection, dkim_signature_apply_on, web_archive_spam_protection,
    # dmarc_protection.mode
    'none' => {'gettext_id' => 'do nothing'},

    # bouncers_level2.notification, bouncers_level1.notification,
    # welcome_return_path, remind_return_path, rfc2369_header_fields,
    # archive.access
    'owner' => {'gettext_id' => 'owner'},

    # bouncers_level2.notification, bouncers_level1.notification
    'listmaster' => {'gettext_id' => 'listmaster'},

    # bouncers_level2.action, bouncers_level1.action
    'remove_bouncers' => {'gettext_id' => 'remove bouncing users'},
    'notify_bouncers' => {'gettext_id' => 'send notify to bouncing users'},

    # pictures_feature, dkim_feature, merge_feature,
    # inclusion_notification_feature
    'on'  => {'gettext_id' => 'enabled'},
    'off' => {'gettext_id' => 'disabled'},

    # include_remote_sympa_list.cert
    'robot' => {'gettext_id' => 'robot'},

    # include_ldap_2level_query.select2, include_ldap_2level_query.select1,
    # include_ldap_query.select
    'first' => {'gettext_id' => 'first entry'},

    # include_ldap_2level_query.select2, include_ldap_2level_query.select1
    'regex' => {'gettext_id' => 'entries matching regular expression'},

    # include_ldap_2level_query.scope2, include_ldap_2level_query.scope1,
    # include_ldap_query.scope
    'base' => {'gettext_id' => 'base'},
    'one'  => {'gettext_id' => 'one level'},
    'sub'  => {'gettext_id' => 'subtree'},

    # include_ldap_2level_query.use_ssl, include_ldap_query.use_ssl
    'yes' => {'gettext_id' => 'yes'},
    'no'  => {'gettext_id' => 'no'},

    # include_ldap_2level_query.ssl_version, include_ldap_query.ssl_version
    'sslv2' => {'gettext_id' => 'SSL version 2'},
    'sslv3' => {'gettext_id' => 'SSL version 3'},
    'tls'   => {'gettext_id' => 'TLS'},

    # editor.reception, owner_include.reception, owner.reception,
    # editor_include.reception
    'mail'   => {'gettext_id' => 'receive notification email'},
    'nomail' => {'gettext_id' => 'no notifications'},

    # editor.visibility, owner_include.visibility, owner.visibility,
    # editor_include.visibility
    'conceal'   => {'gettext_id' => 'concealed from list menu'},
    'noconceal' => {'gettext_id' => 'listed on the list menu'},

    # welcome_return_path, remind_return_path
    'unique' => {'gettext_id' => 'bounce management'},

    # owner_include.profile, owner.profile
    'privileged' => {'gettext_id' => 'privileged owner'},
    'normal'     => {'gettext_id' => 'normal owner'},

    # priority
    '0' => {'gettext_id' => '0 - highest priority'},
    '9' => {'gettext_id' => '9 - lowest priority'},
    'z' => {'gettext_id' => 'queue messages only'},

    # spam_protection, web_archive_spam_protection
    'at'         => {'gettext_id' => 'replace @ characters'},
    'javascript' => {'gettext_id' => 'use JavaScript'},

    # msg_topic_tagging
    'required_sender' => {'gettext_id' => 'required to post message'},
    'required_moderator' =>
	{'gettext_id' => 'required to distribute message'},

    # msg_topic_tagging, custom_attribute.optional
    'optional' => {'gettext_id' => 'optional'},

    # custom_attribute.optional
    'required' => {'gettext_id' => 'required'},

    # custom_attribute.type
    'string'  => {'gettext_id' => 'string'},
    'text'    => {'gettext_id' => 'multi-line text'},
    'integer' => {'gettext_id' => 'number'},
    'enum'    => {'gettext_id' => 'set of keywords'},

    # footer_type
    'mime'   => {'gettext_id' => 'add a new MIME part'},
    'append' => {'gettext_id' => 'append to message body'},

    # archive.access
    'open'    => {'gettext_id' => 'open'},
    'closed'  => {'gettext_id' => 'closed'},
    'private' => {'gettext_id' => 'subscribers only'},
    'public'  => {'gettext_id' => 'public'},

##    ## user_data_source
##    'database' => {'gettext_id' => 'RDBMS'},
##    'file'     => {'gettext_id' => 'include from local file'},
##    'include'  => {'gettext_id' => 'include from external source'},
##    'include2' => {'gettext_id' => 'general datasource'},

    # rfc2369_header_fields
    'help'        => {'gettext_id' => 'help'},
    'subscribe'   => {'gettext_id' => 'subscription'},
    'unsubscribe' => {'gettext_id' => 'unsubscription'},
    'post'        => {'gettext_id' => 'posting address'},
    'archive'     => {'gettext_id' => 'list archive'},

    # dkim_signature_apply_on
    'md5_authenticated_messages' =>
	{'gettext_id' => 'authenticated by password'},
    'smime_authenticated_messages' =>
	{'gettext_id' => 'authenticated by S/MIME signature'},
    'dkim_authenticated_messages' =>
	{'gettext_id' => 'authenticated by DKIM signature'},
    'editor_validated_messages' => {'gettext_id' => 'approved by editor'},
    'any'                       => {'gettext_id' => 'any messages'},

    # archive.period
    'day'     => {'gettext_id' => 'daily'},
    'week'    => {'gettext_id' => 'weekly'},
    'month'   => {'gettext_id' => 'monthly'},
    'quarter' => {'gettext_id' => 'quarterly'},
    'year'    => {'gettext_id' => 'yearly'},

    # web_archive_spam_protection
    'cookie' => {'gettext_id' => 'use HTTP cookie'},

    # verp_rate
    '100%' => {'gettext_id' => '100% - always'},
    '0%'   => {'gettext_id' => '0% - never'},

    # archive_crypted_msg
    'original'  => {'gettext_id' => 'original messages'},
    'decrypted' => {'gettext_id' => 'decrypted messages'},

    # dmarc_protection.mode
    'dkim_signature' => {'gettext_id' => 'DKIM signature exists'},
    'dmarc_any'      => {'gettext_id' => 'DMARC policy exists'},
    'dmarc_reject'   => {'gettext_id' => 'DMARC policy suggests rejection'},
    'dmarc_quarantine' => {'gettext_id' => 'DMARC policy suggests quarantine'},
    'domain_regex'   => {'gettext_id' => 'domain matching regular expression'},

    # dmarc_protection.phrase
    'display_name'   => {'gettext_id' => 'display name'},
    'name_and_email' => {'gettext_id' => 'display name and e-mail'},
    'name_via_list'  => {'gettext_id' => 'name "via Mailing List"'},
    'name_email_via_list' => {'gettext_id' => 'e-mail "via Mailing List"'},
);

## Values for subscriber reception mode.
my %reception_mode = (
    'mail'        => {'gettext_id' => 'standard (direct reception)'},
    'digest'      => {'gettext_id' => 'digest MIME format'},
    'digestplain' => {'gettext_id' => 'digest plain text format'},
    'summary'     => {'gettext_id' => 'summary mode'},
    'notice'      => {'gettext_id' => 'notice mode'},
    'txt'         => {'gettext_id' => 'text-only mode'},
    'html'        => {'gettext_id' => 'html-only mode'},
    'urlize'      => {'gettext_id' => 'urlize mode'},
    'nomail'      => {'gettext_id' => 'no mail'},
    'not_me'      => {'gettext_id' => 'you do not receive your own posts'}
);

## Values for subscriber visibility mode.
my %visibility_mode = (
    'noconceal' => {'gettext_id' => 'listed in the list review page'},
    'conceal'   => {'gettext_id' => 'concealed'}
);

## Values for list status.
my %list_status = (
    'open'          => {'gettext_id' => 'in operation'},
    'pending'       => {'gettext_id' => 'list not yet activated'},
    'error_config'  => {'gettext_id' => 'erroneous configuration'},
    'family_closed' => {'gettext_id' => 'closed family instance'},
    'closed'        => {'gettext_id' => 'closed list'},
);

## This is the generic hash which keeps all lists in memory.
my %list_of_lists = ();
my %list_of_robots = ();
our %list_of_topics = ();
my %edit_list_conf = ();

## Last modification times
my %mtime;

use Fcntl;
use DB_File;

$DB_BTREE->{compare} = \&_compare_addresses;

## Connect to Database
sub db_connect {
    my $option = shift;

    do_log('debug2', 'List::db_connect');

    my $connect_string;

    ## Check if already connected
    if ($dbh && $dbh->ping()) {
	&do_log('notice', 'List::db_connect(): Db handle already available');
	return 1;
    }

    ## We keep trying to connect if this is the first attempt
    ## Unless in a web context, because we can't afford long response time on the web interface
    unless ( $dbh = &SQLSource::connect(\%Conf::Conf, {'keep_trying'=>($option ne 'just_try' && ( !$db_connected && !$ENV{'HTTP_HOST'})),
						 'warn'=>1 } )) {
    	return undef;
    }
    do_log('debug3','Connected to Database %s',$Conf::Conf{'db_name'});

    ## We set Long preload length to two times global max message size
    ## (because of base64 encoding) instead of defaulting to 80 on Oracle
    ## and 32768 on Sybase.
    ## This is to avoid error in Bulk::messageasstring when using Oracle
    ## or Sybase database:
    ##   bulk[pid]: internal error : current packet 'messagekey= 0c40f56e07d3c8ce34683b98d54b6575 contain a ref to a null message
    ## FIXME: would be better to use lists' setting, but
    ##  * list config is not load()-ed at this point, and
    ##  * when invoked from Bulk::messageasstring, list settings is not even
    ##    load()-ed later.
    if ($Conf::Conf{'db_type'} eq 'Oracle' or
	$Conf::Conf{'db_type'} eq 'Sybase') {
	$dbh->{LongReadLen} = $Conf::Conf{'max_size'} * 2;
	$dbh->{LongTruncOk} = 0;
    }
    do_log('debug3',
	'Database driver seetings for this session: LongReadLen= %d, LongTruncOk= %d, RaiseError= %d',
	$dbh->{LongReadLen}, $dbh->{LongTruncOk}, $dbh->{RaiseError});

    $db_connected = 1;

    return 1;
}

## Disconnect from Database
sub db_disconnect {
    do_log('debug3', 'List::db_disconnect');

    unless ($dbh->disconnect()) {
	do_log('notice','Can\'t disconnect from Database %s : %s',$Conf::Conf{'db_name'}, $dbh->errstr);
	return undef;
    }

    return 1;
}

## Get database handler
sub db_get_handler {
    do_log('debug3', 'List::db_get_handler');


    return $dbh;
}

## Creates an object.
sub new {
    my($pkg, $name, $robot, $options) = @_;
    my $list={};
    do_log('debug2', 'List::new(%s, %s, %s)', $name, $robot, join('/',keys %$options));
    
    ## Allow robot in the name
    if ($name =~ /\@/) {
	my @parts = split /\@/, $name;
	$robot ||= $parts[1];
	$name = $parts[0];
    }

    ## Look for the list if no robot was provided
    $robot ||= &search_list_among_robots($name);

    unless ($robot) {
	&do_log('err', 'Missing robot parameter, cannot create list object for %s',  $name) unless ($options->{'just_try'});
	return undef;
    }

    $options = {} unless (defined $options);

    ## Only process the list if the name is valid.
    my $listname_regexp = &tools::get_regexp('listname');
    unless ($name and ($name =~ /^($listname_regexp)$/io) ) {
	&do_log('err', 'Incorrect listname "%s"',  $name) unless ($options->{'just_try'});
	return undef;
    }
    ## Lowercase the list name.
    $name = $1;
    $name =~ tr/A-Z/a-z/;
    
    ## Reject listnames with reserved list suffixes
    my $regx = &Conf::get_robot_conf($robot,'list_check_regexp');
    if ( $regx ) {
	if ($name =~ /^(\S+)-($regx)$/) {
	    &do_log('err', 'Incorrect name: listname "%s" matches one of service aliases',  $name) unless ($options->{'just_try'});
	    return undef;
	}
    }

    my $status ;
    ## If list already in memory and not previously purged by another process
    if ($list_of_lists{$robot}{$name} and -d $list_of_lists{$robot}{$name}{'dir'}){
	# use the current list in memory and update it
	$list=$list_of_lists{$robot}{$name};
	
	$status = $list->load($name, $robot, $options);
    }else{
	# create a new object list
	bless $list, $pkg;

	$options->{'first_access'} = 1;
	$status = $list->load($name, $robot, $options);
    }   
    unless (defined $status) {
	return undef;
    }

    ## Config file was loaded or reloaded
    my $pertinent_ttl = $list->{'admin'}{'distribution_ttl'}||$list->{'admin'}{'ttl'};
    if (
	$status == 1
	&& (! $options->{'skip_sync_admin'}
	|| ($options->{'optional_sync_admin'} && $list->{'last_sync'} < time - $pertinent_ttl)
	|| $options->{'force_sync_admin'})
	)
    {
	## Update admin_table
	unless (defined $list->sync_include_admin()) {
	    &do_log('err','List::new() : sync_include_admin_failed') unless ($options->{'just_try'});
	}
	if ($list->get_nb_owners() < 1 &&
	    $list->{'admin'}{'status'} ne 'error_config') {
	    &do_log('err', 'The list "%s" has got no owner defined',$list->{'name'}) ;
	    $list->set_status_error_config('no_owner_defined',$list->{'name'});
	}
    }

    return $list;
}

## When no robot is specified, look for a list among robots
sub search_list_among_robots {
    my $listname = shift;
    
    unless ($listname) {
 	&do_log('err', 'List::search_list_among_robots() : Missing list parameter');
 	return undef;
    }
    
    ## Search in default robot
    if (-d $Conf::Conf{'home'}.'/'.$listname) {
 	return $Conf::Conf{'host'};
    }
    
     foreach my $r (keys %{$Conf::Conf{'robots'}}) {
	 if (-d $Conf::Conf{'home'}.'/'.$r.'/'.$listname) {
	     return $r;
	 }
     }
    
     return 0;
}

## set the list in status error_config and send a notify to listmaster
sub set_status_error_config {
    my ($self, $message, @param) = @_;
    &do_log('debug3', 'List::set_status_error_config');

    unless ($self->{'admin'}{'status'} eq 'error_config'){
	$self->{'admin'}{'status'} = 'error_config';

	#my $host = &Conf::get_robot_conf($self->{'domain'}, 'host');
	## No more save config in error...
	#$self->save_config("listmaster\@$host");
	#$self->savestats();
	&do_log('err', 'The list "%s" is set in status error_config',$self->{'name'});
	unless (&List::send_notify_to_listmaster($message, $self->{'domain'},\@param)) {
	    &do_log('notice',"Unable to send notify '$message' to listmaster");
	};
    }
}

## set the list in status family_closed and send a notify to owners
sub set_status_family_closed {
    my ($self, $message, @param) = @_;
    &do_log('debug2', 'List::set_status_family_closed');
    
    unless ($self->{'admin'}{'status'} eq 'family_closed'){
	
	my $host = &Conf::get_robot_conf($self->{'domain'}, 'host');	
	
	unless ($self->close("listmaster\@$host",'family_closed')) {
	    &do_log('err','Impossible to set the list %s in status family_closed');
	    return undef;
	}
	&do_log('err', 'The list "%s" is set in status family_closed',$self->{'name'});
	unless ($self->send_notify_to_owner($message,\@param)){
	    &do_log('err','Impossible to send notify to owner informing status family_closed for the list %s',$self->{'name'});
	}
# messages : close_list
    }
    return 1;
}

## Saves the statistics data to disk.
sub savestats {
    my $self = shift;
    do_log('debug2', 'List::savestats');
   
    ## Be sure the list has been loaded.
    my $name = $self->{'name'};
    my $dir = $self->{'dir'};
    return undef unless ($list_of_lists{$self->{'domain'}}{$name});
    
    ## Lock file
    my $lock = new Lock ($dir.'/stats');
    unless (defined $lock) {
	&do_log('err','Could not create new lock');
	return undef;
    }
    $lock->set_timeout(2); 
    unless ($lock->lock('write')) {
	return undef;
    }   

   _save_stats_file("$dir/stats", $self->{'stats'}, $self->{'total'}, $self->{'last_sync'}, $self->{'last_sync_admin_user'});
    
    ## Release the lock
    unless ($lock->unlock()) {
	return undef;
    }

    ## Changed on disk
    $self->{'mtime'}[2] = time;

    return 1;
}

## msg count.
sub increment_msg_count {
    my $self = shift;
    do_log('debug2', "List::increment_msg_count($self->{'name'})");
   
    ## Be sure the list has been loaded.
    my $name = $self->{'name'};
    my $file = "$self->{'dir'}/msg_count";
    
    my %count ; 
    if (open(MSG_COUNT, $file)) {	
	while (<MSG_COUNT>){
	    if ($_ =~ /^(\d+)\s(\d+)$/) {
		$count{$1} = $2;	
	    }
	}
	close MSG_COUNT ;
    }
    my $today = int(time / 86400);
    if ($count{$today}) {
	$count{$today}++;
    }else{
	$count{$today} = 1;
    }
    
    unless (open(MSG_COUNT, ">$file.$$")) {
	do_log('err', "Unable to create '%s.%s' : %s", $file,$$, $!);
	return undef;
    }
    foreach my $key (sort {$a <=> $b} keys %count) {
	printf MSG_COUNT "%d\t%d\n",$key,$count{$key} ;
    }
    close MSG_COUNT ;
    
    unless (rename("$file.$$", $file)) {
	do_log('err', "Unable to write '%s' : %s", $file, $!);
	return undef;
    }
    return 1;
}

# Returns the number of messages sent to the list
sub get_msg_count {
    my $self = shift;
    do_log('debug3', "Getting the number of messages for list %s",$self->{'name'});

    ## Be sure the list has been loaded.
    my $name = $self->{'name'};
    my $file = "$self->{'dir'}/stats";
    
    my $count = 0 ;
    if (open(MSG_COUNT, $file)) {	
	while (<MSG_COUNT>){
	    if ($_ =~ /^(\d+)\s+(.*)$/) {
		$count=$1;	
	    }
	}
	close MSG_COUNT ;
    }

    return $count;

}
## last date of distribution message .
sub get_latest_distribution_date {
    my $self = shift;
    do_log('debug3', "List::latest_distribution_date($self->{'name'})");
   
    ## Be sure the list has been loaded.
    my $name = $self->{'name'};
    my $file = "$self->{'dir'}/msg_count";
    
    my %count ; 
    my $latest_date = 0 ; 
    unless (open(MSG_COUNT, $file)) {
	do_log('debug2',"get_latest_distribution_date: unable to open $file");
	return undef ;
    }

    while (<MSG_COUNT>){
	if ($_ =~ /^(\d+)\s(\d+)$/) {
	    $latest_date = $1 if ($1 > $latest_date);
	}
    }
    close MSG_COUNT ;

    return undef if ($latest_date == 0); 
    return $latest_date ;
}

## Update the stats struct 
## Input  : num of bytes of msg
## Output : num of msgs sent
sub update_stats {
    my($self, $bytes) = @_;
    do_log('debug2', 'List::update_stats(%d)', $bytes);

    my $stats = $self->{'stats'};
    $stats->[0]++;
    $stats->[1] += $self->{'total'};
    $stats->[2] += $bytes;
    $stats->[3] += $bytes * $self->{'total'};

    ## Update 'msg_count' file, used for bounces management
    $self->increment_msg_count();

    return $stats->[0];
}

## Extract a set of rcpt for which verp must be use from a rcpt_tab.
## Input  :  percent : the rate of subscribers that must be threaded using verp
##           xseq    : the message sequence number
##           @rcpt   : a tab of emails
## return :  a tab of rcpt for which rcpt must be use depending on the message sequence number, this way every subscriber is "verped" from time to time
##           input table @rcpt is spliced : rcpt for which verp must be used are extracted from this table
sub extract_verp_rcpt() {
    my $percent = shift;
    my $xseq = shift;
    my $refrcpt = shift;
    my $refrcptverp = shift;

    &do_log('debug','&extract_verp(%s,%s,%s,%s)',$percent,$xseq,$refrcpt,$refrcptverp)  ;

    my @result;

    if ($percent ne '0%') {
	my $nbpart ; 
	if ( $percent =~ /^(\d+)\%/ ) {
	    $nbpart = 100/$1;  
	}
	else {
	    &do_log ('err', 'Wrong format for parameter extract_verp: %s. Can\'t process VERP.',$percent);
	    return undef;
	}
	
	my $modulo = $xseq % $nbpart ;
	my $lenght = int (($#{$refrcpt} + 1) / $nbpart) + 1;
	
	@result = splice @$refrcpt, $lenght*$modulo, $lenght ;
    }
    foreach my $verprcpt (@$refrcptverp) {
	push @result, $verprcpt;
    }
    return ( @result ) ;
}



## Dumps a copy of lists to disk, in text format
sub dump {
    my $self = shift;
    do_log('debug2', 'List::dump(%s)', $self->{'name'});

    unless (defined $self) {
	&do_log('err','Unknown list');
	return undef;
    }

    my $user_file_name = "$self->{'dir'}/subscribers.db.dump";

    unless ($self->_save_users_file($user_file_name)) {
	&do_log('err', 'Failed to save file %s', $user_file_name);
	return undef;
    }
    
    $self->{'mtime'} = [ (stat("$self->{'dir'}/config"))[9], (stat("$self->{'dir'}/subscribers"))[9], (stat("$self->{'dir'}/stats"))[9] ];

    return 1;
}

## Saves the configuration file to disk
sub save_config {
    my ($self, $email) = @_;
    do_log('debug3', 'List::save_config(%s,%s)', $self->{'name'}, $email);

    return undef 
	unless ($self);

    my $config_file_name = "$self->{'dir'}/config";

    ## Lock file
    my $lock = new Lock ($self->{'dir'}.'/config');
    unless (defined $lock) {
	&do_log('err','Could not create new lock');
	return undef;
    }
    $lock->set_timeout(5); 
    unless ($lock->lock('write')) {
	return undef;
    }

    my $name = $self->{'name'};    
    my $old_serial = $self->{'admin'}{'serial'};
    my $old_config_file_name = "$self->{'dir'}/config.$old_serial";

    ## Update management info
    $self->{'admin'}{'serial'}++;
    $self->{'admin'}{'update'} = {'email' => $email,
				  'date_epoch' => time,
				  'date' => (gettext_strftime "%d %b %Y at %H:%M:%S", localtime(time)),
				  };

    unless (&_save_admin_file($config_file_name, $old_config_file_name, $self->{'admin'})) {
	&do_log('info', 'unable to save config file %s', $config_file_name);
	$lock->unlock();
	return undef;
    }
    
    ## Also update the binary version of the data structure
    if (&Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq 'binary_file') {
	eval {&Storable::store($self->{'admin'},"$self->{'dir'}/config.bin")};
	if ($@) {
	    &do_log('err', 'Failed to save the binary config %s. error: %s', "$self->{'dir'}/config.bin",$@);
	}
    }

#    $self->{'mtime'}[0] = (stat("$list->{'dir'}/config"))[9];
    
    ## Release the lock
    unless ($lock->unlock()) {
	return undef;
    }

    if ($List::use_db) {
        unless (&_update_list_db) {
            &do_log('err', "Unable to update list_table");
        }
    }

    return 1;
}

## Loads the administrative data for a list
sub load {
    my ($self, $name, $robot, $options) = @_;
    do_log('debug2', 'List::load(%s, %s, %s)', $name, $robot, join('/',keys %$options));
    
    my $users;

    ## Set of initializations ; only performed when the config is first loaded
    if ($options->{'first_access'}) {

	## Search robot if none was provided
	unless ($robot) {
	    foreach my $r (keys %{$Conf::Conf{'robots'}}) {
		if (-d "$Conf::Conf{'home'}/$r/$name") {
		    $robot=$r;
		    last;
		}
	    }
	    
	    ## Try default robot
	    unless ($robot) {
		if (-d "$Conf::Conf{'home'}/$name") {
		    $robot = $Conf::Conf{'host'};
		}
	    }
	}
	
	if ($robot && (-d "$Conf::Conf{'home'}/$robot")) {
	    $self->{'dir'} = "$Conf::Conf{'home'}/$robot/$name";
	}elsif (lc($robot) eq lc($Conf::Conf{'host'})) {
	    $self->{'dir'} = "$Conf::Conf{'home'}/$name";
	}else {
	    &do_log('err', 'No such robot (virtual domain) %s', $robot) unless ($options->{'just_try'});
	    return undef ;
	}
	
	$self->{'domain'} = $robot ;

	# default list host is robot domain
	$self->{'admin'}{'host'} ||= $self->{'domain'};
	$self->{'name'}  = $name ;
    }

    unless ((-d $self->{'dir'}) && (-f "$self->{'dir'}/config")) {
	&do_log('debug2', 'Missing directory (%s) or config file for %s', $self->{'dir'}, $name) unless ($options->{'just_try'});
	return undef ;
    }

    my ($m1, $m2, $m3) = (0, 0, 0);
    ($m1, $m2, $m3) = @{$self->{'mtime'}} if (defined $self->{'mtime'});

    my $time_config = (stat("$self->{'dir'}/config"))[9];
    my $time_config_bin = (stat("$self->{'dir'}/config.bin"))[9];
    my $time_subscribers; 
    my $time_stats = (stat("$self->{'dir'}/stats"))[9];
    my $main_config_time = (stat(Sympa::Constants::CONFIG))[9];
    my $web_config_time = (stat(Sympa::Constants::WWSCONFIG))[9];
    my $config_reloaded = 0;
    my $admin;
    
    if (
        &Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq 'binary_file'
        && ! $options->{'reload_config'}
        && $time_config_bin > $self->{'mtime'}->[0]
        && $time_config_bin >= $time_config 
        && $time_config_bin >= $main_config_time
        && $time_config_bin >= $web_config_time
        ){
	## Get a shared lock on config file first 
	my $lock = new Lock ($self->{'dir'}.'/config');
	unless (defined $lock) {
	    &do_log('err','Could not create new lock');
	    return undef;
	}
	$lock->set_timeout(5); 
	unless ($lock->lock('read')) {
	    return undef;
	}

	## Load a binary version of the data structure
	## unless config is more recent than config.bin
	eval {$admin = &Storable::retrieve("$self->{'dir'}/config.bin")};
	if ($@) {
	    &do_log('err', 'Failed to load the binary config %s, error: %s', "$self->{'dir'}/config.bin",$@);
	    $lock->unlock();
	    return undef;
	}	    

	$config_reloaded = 1;
	$m1 = $time_config_bin;
	$lock->unlock();

    }elsif (
        $self->{'name'} ne $name
        || $time_config > $self->{'mtime'}->[0]
        || $options->{'reload_config'}
        ) {
	$admin = _load_admin_file($self->{'dir'}, $self->{'domain'}, 'config');

	## Get a shared lock on config file first 
	my $lock = new Lock ($self->{'dir'}.'/config');
	unless (defined $lock) {
	    &do_log('err','Could not create new lock');
	    return undef;
	}
	$lock->set_timeout(5); 
	unless ($lock->lock('write')) {
	    return undef;
	}

	## update the binary version of the data structure
	if (&Conf::get_robot_conf($self->{'domain'}, 'cache_list_config') eq 'binary_file') {
	    eval {&Storable::store($admin,"$self->{'dir'}/config.bin")};
	    if ($@) {
		&do_log('err', 'Failed to save the binary config %s. error: %s', "$self->{'dir'}/config.bin",$@);
	    }
	}

	$config_reloaded = 1;
 	unless (defined $admin) {
 	    &do_log('err', 'Impossible to load list config file for list % set in status error_config',$self->{'name'});
 	    $self->set_status_error_config('load_admin_file_error',$self->{'name'});
	    $lock->unlock();
 	    return undef;	    
 	}

	$m1 = $time_config;
	$lock->unlock();
    }
    
    ## If config was reloaded...
    if ($admin) {
 	$self->{'admin'} = $admin;
 	
 	## check param_constraint.conf if belongs to a family and the config has been loaded
 	if (defined $admin->{'family_name'} && ($admin->{'status'} ne 'error_config')) {
 	    my $family;
 	    unless ($family = $self->get_family()) {
 		&do_log('err', 'Impossible to get list %s family : %s. The list is set in status error_config',$self->{'name'},$self->{'admin'}{'family_name'});
 		$self->set_status_error_config('no_list_family',$self->{'name'}, $admin->{'family_name'});
		return undef;
 	    }  
 	    my $error = $family->check_param_constraint($self);
 	    unless($error) {
 		&do_log('err', 'Impossible to check parameters constraint for list % set in status error_config',$self->{'name'});
 		$self->set_status_error_config('no_check_rules_family',$self->{'name'}, $family->{'name'});
 	    }
	    if (ref($error) eq 'ARRAY') {
 		&do_log('err', 'The list "%s" does not respect the rules from its family %s',$self->{'name'}, $family->{'name'});
 		$self->set_status_error_config('no_respect_rules_family',$self->{'name'}, $family->{'name'});
 	    }
 	}
     } 

    $self->{'as_x509_cert'} = 1  if ((-r "$self->{'dir'}/cert.pem") || (-r "$self->{'dir'}/cert.pem.enc"));

    ## Load stats file if first new() or stats file changed
    my ($stats, $total);
    if (! $self->{'mtime'}[2] || ($time_stats > $self->{'mtime'}[2])) {
	($stats, $total, $self->{'last_sync'}, $self->{'last_sync_admin_user'}) = _load_stats_file("$self->{'dir'}/stats");
	$m3 = $time_stats;

	$self->{'stats'} = $stats if (defined $stats);	
	$self->{'total'} = $total if (defined $total);	
    }
    
    $self->{'users'} = $users->{'users'} if ($users);
    $self->{'ref'}   = $users->{'ref'} if ($users);
    
    if ($users && defined($users->{'total'})) {
	$self->{'total'} = $users->{'total'};
    }

    ## We have updated %users, Total may have changed
    if ($m2 > $self->{'mtime'}[1]) {
	$self->savestats();
    }

    $self->{'mtime'} = [ $m1, $m2, $m3];

    $list_of_lists{$self->{'domain'}}{$name} = $self;
    return $config_reloaded;
}

## Return a list of hash's owners and their param
sub get_owners {
    my($self) = @_;
    &do_log('debug3', 'List::get_owners(%s)', $self->{'name'});
  
    my $owners = ();

    # owners are in the admin_table ; they might come from an include data source
    for (my $owner = $self->get_first_admin_user('owner'); $owner; $owner = $self->get_next_admin_user()) {
	push(@{$owners},$owner);
    } 

    return $owners;
}

sub get_nb_owners {
    my($self) = @_;
    &do_log('debug3', 'List::get_nb_owners(%s)', $self->{'name'});
    
    my $resul = 0;
    my $owners = $self->get_owners;

    if (defined $owners) {
	$resul = $#{$owners} + 1;
    }
    return $resul;
}

## Return a hash of list's editors and their param(empty if there isn't any editor)
sub get_editors {
    my($self) = @_;
    &do_log('debug3', 'List::get_editors(%s)', $self->{'name'});
  
    my $editors = ();

    # editors are in the admin_table ; they might come from an include data source
    for (my $editor = $self->get_first_admin_user('editor'); $editor; $editor = $self->get_next_admin_user()) {
	push(@{$editors},$editor);
    } 

    return $editors;
}


## Returns an array of owners' email addresses
sub get_owners_email {
    my($self,$param) = @_;
    do_log('debug3', 'List::get_owners_email(%s,%s)', $self->{'name'}, $param -> {'ignore_nomail'});
    
    my @rcpt;
    my $owners = ();

    $owners = $self->get_owners();

    if ($param -> {'ignore_nomail'}) {
	foreach my $o (@{$owners}) {
	    push (@rcpt, lc($o->{'email'}));
	}
    }
    else {
	foreach my $o (@{$owners}) {
	    next if ($o->{'reception'} eq 'nomail');
	    push (@rcpt, lc($o->{'email'}));
	}
    }
    unless (@rcpt) {
	&do_log('notice','Warning : no owner found for list %s', $self->{'name'} );
    }
    return @rcpt;
}

## Returns an array of editors' email addresses
#  or owners if there isn't any editors' email addresses
sub get_editors_email {
    my($self,$param) = @_;
    do_log('debug3', 'List::get_editors_email(%s,%s)', $self->{'name'}, $param -> {'ignore_nomail'});
    
    my @rcpt;
    my $editors = ();

    $editors = $self->get_editors();

    if ($param -> {'ignore_nomail'}) {
	foreach my $e (@{$editors}) {
	    push (@rcpt, lc($e->{'email'}));
	}
    }
    else {
	foreach my $e (@{$editors}) {
	    next if ($e->{'reception'} eq 'nomail');
	    push (@rcpt, lc($e->{'email'}));
	}
    }
    unless (@rcpt) {
	&do_log('notice','Warning : no editor found for list %s, getting owners', $self->{'name'} );
	@rcpt = $self->get_owners_email($param);
    }
    return @rcpt;
}

## Returns an object Family if the list belongs to a family
#  or undef
sub get_family {
    my $self = shift;
    &do_log('debug3', 'List::get_family(%s)', $self->{'name'});
    
    if (ref($self->{'family'}) eq 'Family') {
	return $self->{'family'};
    }

    my $family_name;
    my $robot = $self->{'domain'};

    unless (defined $self->{'admin'}{'family_name'}) {
	&do_log('err', 'List::get_family(%s) : this list has not got any family', $self->{'name'});
	return undef;
    }
        
    $family_name = $self->{'admin'}{'family_name'};
	    
    my $family;
    unless ($family = new Family($family_name,$robot) ) {
	&do_log('err', 'List::get_family(%s) : new Family(%s) impossible', $self->{'name'},$family_name);
	return undef;
    }
  	
    $self->{'family'} = $family;
    return $family;
}

## return the config_changes hash
## Used ONLY with lists belonging to a family.
sub get_config_changes {
    my $self = shift;
    &do_log('debug3', 'List::get_config_changes(%s)', $self->{'name'});
    
    unless ($self->{'admin'}{'family_name'}) {
	&do_log('err', 'List::get_config_changes(%s) is called but there is no family_name for this list.',$self->{'name'});
	return undef;
    }
    
    ## load config_changes
    my $time_file = (stat("$self->{'dir'}/config_changes"))[9];
    unless (defined $self->{'config_changes'} && ($self->{'config_changes'}{'mtime'} >= $time_file)) {
	unless ($self->{'config_changes'} = $self->_load_config_changes_file()) {
	    &do_log('err','Impossible to load file config_changes from list %s',$self->{'name'});
	    return undef;
	}
    }
    return $self->{'config_changes'};
}


## update file config_changes if the list belongs to a family by
#  writing the $what(file or param) name 
sub update_config_changes {
    my $self = shift;
    my $what = shift;
    # one param or a ref on array of param
    my $name = shift;
    &do_log('debug2', 'List::update_config_changes(%s,%s)', $self->{'name'},$what);
    
    unless ($self->{'admin'}{'family_name'}) {
	&do_log('err', 'List::update_config_changes(%s,%s,%s) is called but there is no family_name for this list.',$self->{'name'},$what);
	return undef;
    }
    unless (($what eq 'file') || ($what eq 'param')){
	&do_log('err', 'List::update_config_changes(%s,%s) : %s is wrong : must be "file" or "param".',$self->{'name'},$what);
	return undef;
    } 
    
    # status parameter isn't updating set in config_changes
    if (($what eq 'param') && ($name eq 'status')) {
	return 1;
    }

    ## load config_changes
    my $time_file = (stat("$self->{'dir'}/config_changes"))[9];
    unless (defined $self->{'config_changes'} && ($self->{'config_changes'}{'mtime'} >= $time_file)) {
	unless ($self->{'config_changes'} = $self->_load_config_changes_file()) {
	    &do_log('err','Impossible to load file config_changes from list %s',$self->{'name'});
	    return undef;
	}
    }
    
    if (ref($name) eq 'ARRAY' ) {
	foreach my $n (@{$name}) {
	    $self->{'config_changes'}{$what}{$n} = 1; 
	}
    } else {
	$self->{'config_changes'}{$what}{$name} = 1;
    }
    
    $self->_save_config_changes_file();
    
    return 1;
}

## return a hash of config_changes file
sub _load_config_changes_file {
    my $self = shift;
    &do_log('debug3', 'List::_load_config_changes_file(%s)', $self->{'name'});

    my $config_changes = {};

    unless (-e "$self->{'dir'}/config_changes") {
	&do_log('err','No file %s/config_changes. Assuming no changes', $self->{'dir'});
	return $config_changes;
    }

    unless (open (FILE,"$self->{'dir'}/config_changes")) {
	&do_log('err','File %s/config_changes exists, but unable to open it: %s', $self->{'dir'},$_);
	return undef;
    }
    
    while (<FILE>) {
	
	next if /^\s*(\#.*|\s*)$/;

	if (/^param\s+(.+)\s*$/) {
	    $config_changes->{'param'}{$1} = 1;

	}elsif (/^file\s+(.+)\s*$/) {
	    $config_changes->{'file'}{$1} = 1;
	
	}else {
	    &do_log ('err', 'List::_load_config_changes_file(%s) : bad line : %s',$self->{'name'},$_);
	    next;
	}
    }
    close FILE;

    $config_changes->{'mtime'} = (stat("$self->{'dir'}/config_changes"))[9];

    return $config_changes;
}

## save config_changes file in the list directory
sub _save_config_changes_file {
    my $self = shift;
    &do_log('debug3', 'List::_save_config_changes_file(%s)', $self->{'name'});

    unless ($self->{'admin'}{'family_name'}) {
	&do_log('err', 'List::_save_config_changes_file(%s) is called but there is no family_name for this list.',$self->{'name'});
	return undef;
    }
    unless (open (FILE,">$self->{'dir'}/config_changes")) {
	&do_log('err','List::_save_config_changes_file(%s) : unable to create file %s/config_changes : %s',$self->{'name'},$self->{'dir'},$_);
	return undef;
    }

    foreach my $what ('param','file') {
	foreach my $name (keys %{$self->{'config_changes'}{$what}}) {
	    print FILE "$what $name\n";
	}
    }
    close FILE;
    
    return 1;
}




sub _get_param_value_anywhere {
    my $new_admin = shift;
    my $param = shift; 
    &do_log('debug3', '_get_param_value_anywhere(%s %s)',$param);
    my $minor_p;
    my @values;

   if ($param =~ /^([\w-]+)\.([\w-]+)$/) {
	$param = $1;
	$minor_p = $2;
    }

    ## Multiple parameter (owner, custom_header, ...)
    if ((ref ($new_admin->{$param}) eq 'ARRAY') &&
	!($::pinfo{$param}{'split_char'})) {
	foreach my $elt (@{$new_admin->{$param}}) {
	    my $val = &List::_get_single_param_value($elt,$param,$minor_p);
	    if (defined $val) {
		push @values,$val;
	    }
	}

    }else {
	my $val = &List::_get_single_param_value($new_admin->{$param},$param,$minor_p);
	if (defined $val) {
	    push @values,$val;
	}
    }
    return \@values;
}


## Returns the list parameter value from $list->{'admin'}
#  the parameter is simple ($param) or composed ($param & $minor_param)
#  the value is a scalar or a ref on an array of scalar
# (for parameter digest : only for days)
sub get_param_value {
    my $self = shift;
    my $param = shift; 
    &do_log('debug3', 'List::get_param_value(%s,%s)', $self->{'name'},$param);
    my $minor_param;
    my $value;

    if ($param =~ /^([\w-]+)\.([\w-]+)$/) {
	$param = $1;
	$minor_param = $2;
    }

    ## Multiple parameter (owner, custom_header, ...)
    if ((ref ($self->{'admin'}{$param}) eq 'ARRAY') &&
	! $::pinfo{$param}{'split_char'}) {
	my @values;
	foreach my $elt (@{$self->{'admin'}{$param}}) {
	    push @values,&_get_single_param_value($elt,$param,$minor_param) 
	}
	$value = \@values;
    }else {
	$value = &_get_single_param_value($self->{'admin'}{$param},$param,$minor_param);
    }
    return $value;
}

## Returns the single list parameter value from struct $p, with $key entrie,
#  $k is optionnal
#  the single value can be a ref on a list when the parameter value is a list
sub _get_single_param_value {
    my ($p,$key,$k) = @_;
    &do_log('debug3', 'List::_get_single_value(%s %s)',$key,$k);

    if (defined ($::pinfo{$key}{'scenario'}) ||
        defined ($::pinfo{$key}{'task'})) {
	return $p->{'name'};
    
    }elsif (ref($::pinfo{$key}{'file_format'})) {
	
	if (defined ($::pinfo{$key}{'file_format'}{$k}{'scenario'})) {
	    return $p->{$k}{'name'};

	}elsif (($::pinfo{$key}{'file_format'}{$k}{'occurrence'} =~ /n$/)
		    && $::pinfo{$key}{'file_format'}{$k}{'split_char'}) {
	    return $p->{$k}; # ref on an array
	}else {
	    return $p->{$k};
	}

    }else {
	if (($::pinfo{$key}{'occurrence'} =~ /n$/)
	    && $::pinfo{$key}{'split_char'}) {
	    return $p; # ref on an array
	}elsif ($key eq 'digest') {
	    return $p->{'days'}; # ref on an array 
	}else {
	    return $p;
	}
    }
}



########################################################################################
#                       FUNCTIONS FOR MESSAGE SENDING                                  #
########################################################################################
#                                                                                      #
#  -list distribution   
#  -template sending                                                                   #
#  -service messages
#  -notification sending(listmaster, owner, editor, user)                              #
#                                                                 #

                                             
#########################   LIST DISTRIBUTION  #########################################


####################################################
# distribute_msg                              
####################################################
#  prepares and distributes a message to a list, do 
#  some of these :
#  stats, hidding sender, adding custom subject, 
#  archive, changing the replyto, removing headers, 
#  adding headers, storing message in digest
# 
#  
# IN : -$self (+): ref(List)
#      -$message (+): ref(Message)
#      -$apply_dkim_signature : on | off
# OUT : -$numsmtp : number of sendmail process
####################################################
sub distribute_msg {
    my $self = shift;
    my %param = @_;

    my $message = $param{'message'};
    my $apply_dkim_signature = $param{'apply_dkim_signature'};

    do_log('debug2', 'List::distribute_msg(%s, %s, %s, %s, %s, %s, apply_dkim_signature=%s)', $self->{'name'}, $message->{'msg'}, $message->{'size'}, $message->{'filename'}, $message->{'smime_crypted'}, $apply_dkim_signature );

    my $hdr = $message->{'msg'}->head;
    my ($name, $host) = ($self->{'name'}, $self->{'admin'}{'host'});
    my $robot = $self->{'domain'};

    ## Update the stats, and returns the new X-Sequence, if any.
    my $sequence = $self->update_stats($message->{'size'});
    
    ## Loading info msg_topic file if exists, add X-Sympa-Topic
    my $info_msg_topic;
    if ($self->is_there_msg_topic()) {
	my $msg_id = $hdr->get('Message-ID');
	chomp($msg_id);
	$info_msg_topic = $self->load_msg_topic_file($msg_id,$robot);

	# add X-Sympa-Topic header
	if (ref($info_msg_topic) eq "HASH") {
	    $message->add_topic($info_msg_topic->{'topic'});
	}
    }

    ## Munge the From header if we are using DMARC Protection mode
    if ( $self->{'admin'}{'dmarc_protection'}{'mode'} ) {
	Log::do_log('debug','DMARC protection on');
        my $dkimdomain = $self->{'admin'}{'dmarc_protection'}{'domain_regex'};
        my $originalFromHeader = $hdr->get('From');
        my $anonaddr;
        my @addresses = Mail::Address->parse($originalFromHeader);
        my @anonFrom;
        my $dkimSignature = $hdr->get('DKIM-Signature');
        my $origFrom = '';
        my $mungeFrom = 0;

        if ( @addresses ) { 
	    $origFrom = $addresses[0]->address;
	    Log::do_log('debug','From addresses: %s',$origFrom);
	}

        # Will this message be processed?
        if( &tools::is_in_array($self->{'admin'}{'dmarc_protection'}{'mode'},'all') ) {
	    Log::do_log('debug','Munging From for ALL messages');
	    $mungeFrom = 1;
	}
        if( !$mungeFrom and $dkimSignature 
            and &tools::is_in_array($self->{'admin'}{'dmarc_protection'}{'mode'},'dkim_signature')) {
	    Log::do_log('debug','Munging From for DKIM-signed messages');
            $mungeFrom = 1;
        }
        if( !$mungeFrom and $origFrom and $dkimdomain 
            and &tools::is_in_array($self->{'admin'}{'dmarc_protection'}{'mode'},'domain_regex') ) {
	    Log::do_log('debug','Munging From for messages based on domain regexp');
            $mungeFrom = 1 if( $origFrom =~ /$dkimdomain$/ );
        }
        if( !$mungeFrom and $origFrom 
            and (
                &tools::is_in_array($self->{'admin'}{'dmarc_protection'}{'mode'},'dmarc_reject')
                or &tools::is_in_array($self->{'admin'}{'dmarc_protection'}{'mode'},'dmarc_any')
                or &tools::is_in_array($self->{'admin'}{'dmarc_protection'}{'mode'},'dmarc_quarantine')
            )) {
	    Log::do_log('debug','Munging From for messages with strict policy');
            # Strict auto policy - is the sender domain policy to reject
            my $dom = $origFrom; $dom =~ s/^.*\@//;
            eval { # In case Net::DNS is not installed
		Log::do_log('debug','Requiring Net::DNS');
		require Net::DNS;
                my $res = Net::DNS::Resolver->new;
                my $packet = $res->query("_dmarc.$dom","TXT");
                if ($packet) {
		    Log::do_log('debug','DMARC DNS entry found');
                    foreach my $rr (grep { $_->type eq 'TXT' } $packet->answer) {
                        next if($rr->string !~ /v=DMARC/);
                        if(!$mungeFrom and &tools::is_in_array($self->{'admin'}{'dmarc_protection'}{'mode'},'dmarc_reject')) {
			    Log::do_log('debug','Will block if DMARC rejects');
                            if($rr->string =~ /p=reject/) {
				Log::do_log('debug','DMARC reject policy found');
				$mungeFrom = 1 ;
			    }
                        }
                        if(!$mungeFrom and &tools::is_in_array($self->{'admin'}{'dmarc_protection'}{'mode'},'dmarc_quarantine')) {
			    Log::do_log('debug','Will block if DMARC quarantine');
                            if($rr->string =~ /p=quarantine/) {
				Log::do_log('debug','DMARC quarantine  policy found');
				$mungeFrom = 1;
			    }
                        }
                        if(!$mungeFrom and &tools::is_in_array($self->{'admin'}{'dmarc_protection'}{'mode'},'dmarc_any')) {
			    Log::do_log('debug','Will munge whatever DMARC policy is');
                            $mungeFrom = 1;
                        }
                        $hdr->add('X-Original-DMARC-Record',"domain=$dom; ".$rr->string);
                        last;
                    }
                }
            };
            if($@) {
		$hdr->add('X-DMARC-Error',$@);
		Log::do_log('err', 'No Net::DNS found. Trying to save the message by adding a X-DMARC-Error header');
	    }
        }

        if( $mungeFrom ) {
	    Log::do_log('debug','Will munge From field');
            # Remove any DKIM signatures we find
            if( $dkimSignature ) {
                $hdr->add('X-Original-DKIM-Signature',$dkimSignature);
                $hdr->delete('DKIM-Signature');
                $hdr->delete('DomainKey-Signature');
                Log::do_log('debug','Removing previous DKIM and DomainKey signatures');
            }

            # Identify default new From address
            my $phraseMode = $self->{'admin'}{'dmarc_protection'}{'phrase'} ||
                'name_via_list';
            my $newAddr;
            my $displayName;
            my $newComment;
            $anonaddr = $self->{'admin'}{'dmarc_protection'}{'other_email'};
            $anonaddr = $self->get_list_address()
                unless $anonaddr and $anonaddr =~ /\@/;
            @anonFrom = Mail::Address->parse($anonaddr);
	    Log::do_log('debug','Anonymous From: %s',$anonaddr);
            if (@addresses) {
                # We should always have a From address in reality, unless the
                # message is from a badly-behaved automate
                if ($addresses[0]->phrase) {
                    $displayName = MIME::EncWords::decode_mimewords(
			$addresses[0]->phrase, Charset => 'UTF-8');
                    $newComment = $addresses[0]->address
			if $phraseMode =~ /email/;
                } else {
                    # If we dont have a Phrase, should we search the Sympa database
                    # for the sender to obtain their name that way? Might be difficult.
                    $displayName = $addresses[0]->address;
                    $displayName =~ s/\@.*// unless $phraseMode =~ /email/;
                }
                if($phraseMode =~ /list/) {
                    if ($newComment and $newComment =~ /\S/) {
                        $newComment =
                            sprintf gettext('%s via %s Mailing List'),
                                $newComment, $name;
                    } else {
                        $newComment =
			    sprintf gettext('via %s Mailing List'), $name;
                    }
                }
                $hdr->add('Reply-To',$addresses[0]->address) unless($hdr->get('Reply-To'));
            }
            # If the new From email address has a Phrase component, then append it
            if (@anonFrom and $anonFrom[0]->phrase) {
                if ($displayName and $displayName =~ /\S/) {
                    $displayName .= ' ' . $anonFrom[0]->phrase;
                } else {
                    $displayName = $anonFrom[0]->phrase;
                }
            }
            $displayName = gettext('Anonymous')
                unless $displayName and $displayName =~ /\S/;

            $newAddr = tools::addrencode(
		(@anonFrom ? $anonFrom[0]->address : $anonaddr),
		$displayName, Language::GetCharset(), $newComment);

            $hdr->add('X-Original-From',"$originalFromHeader");
            $hdr->replace('From', $newAddr);
	}
    }

    ## Hide the sender if the list is anonymoused
    if ( $self->{'admin'}{'anonymous_sender'} ) {

	foreach my $field (@{$Conf::Conf{'anonymous_header_fields'}}) {
	    $hdr->delete($field);
	}

	# override From: and Message-ID: fields.
	# Note that corresponding Resent-*: fields will be removed.
	$hdr->replace('From', $self->{'admin'}{'anonymous_sender'});
	$hdr->delete('Resent-From');
	my $new_id = "$self->{'name'}.$sequence\@anonymous";
	$hdr->replace('Message-Id', "<$new_id>");
	$hdr->delete('Resent-Message-Id');

	# rename msg_topic filename
	if ($info_msg_topic) {
	    my $queuetopic = &Conf::get_robot_conf($robot, 'queuetopic');
	    my $listname = "$self->{'name'}\@$robot";
	    rename("$queuetopic/$info_msg_topic->{'filename'}","$queuetopic/$listname.$new_id");
	    $info_msg_topic->{'filename'} = "$listname.$new_id";
	}
	
	## Virer eventuelle signature S/MIME
    }
    
    ## Add Custom Subject
    if ($self->{'admin'}{'custom_subject'}) {
	my $subject_field = $message->{'decoded_subject'};
	$subject_field =~ s/^\s*(.*)\s*$/$1/; ## Remove leading and trailing blanks
	
	## Search previous subject tagging in Subject
	my $custom_subject = $self->{'admin'}{'custom_subject'};

	## tag_regexp will be used to remove the custom subject if it is already present in the message subject.
	## Remember that the value of custom_subject can be "dude number [%list.sequence"%]" whereas the actual
	## subject will contain "dude number 42".
	my $list_name_escaped = $self->{'name'};
	$list_name_escaped =~ s/(\W)/\\$1/g;
	my $tag_regexp = $custom_subject;
	$tag_regexp =~ s/([^\w\s\x80-\xFF])/\\$1/g;  ## cleanup, just in case dangerous chars were left
	$tag_regexp =~ s/\\\[\\\%\s*list\\\.sequence\s*\\\%\\\]/\\d+/g; ## Replaces "[%list.sequence%]" by "\d+"
	$tag_regexp =~ s/\\\[\\\%\s*list\\\.name\s*\\\%\\\]/$list_name_escaped/g; ## Replace "[%list.name%]" by escaped list name
	$tag_regexp =~ s/\\\[\\\%\s*[^]]+\s*\\\%\\\]/[^]]+/g; ## Replaces variables declarations by "[^\]]+"
	$tag_regexp =~ s/\s+/\\s+/g; ## Takes spaces into account

	## Add subject tag
	$message->{'msg'}->head->delete('Subject');
	my $parsed_tag;
	&tt2::parse_tt2({'list' => {'name' => $self->{'name'},
				    'sequence' => $self->{'stats'}->[0]
				    }},
			[$custom_subject], \$parsed_tag);

	## If subject is tagged, replace it with new tag
	## Splitting the subject in two parts :
	##   - what will be before the custom subject (probably some "Re:")
	##   - what will be after it : the orginal subject sent to the list.
	## The custom subject is not kept.
	my $before_tag;
	my $after_tag;
	if ($custom_subject =~ /\S/) {
	    $subject_field =~ s/\s*\[$tag_regexp\]\s*/ /;
	}
	$subject_field =~ s/\s+$//;

	# truncate multiple "Re:" and equivalents.
	my $re_regexp = tools::get_regexp('re');
	if ($subject_field =~ /^\s*($re_regexp\s*)($re_regexp\s*)*/) {
	    ($before_tag, $after_tag) = ($1, $'); #'
	} else {
	    ($before_tag, $after_tag) = ('', $subject_field);
	}
	
 	## Encode subject using initial charset

	## Don't try to encode the subject if it was not originaly encoded.
	if ($message->{'subject_charset'}) {
	    $subject_field = MIME::EncWords::encode_mimewords([
							       [Encode::decode('utf8', $before_tag), $message->{'subject_charset'}],
							       [Encode::decode('utf8', '['.$parsed_tag.'] '), &Language::GetCharset()],
							       [Encode::decode('utf8', $after_tag), $message->{'subject_charset'}]
							       ], Encoding=>'A', Field=>'Subject');
	}else {
	    $subject_field = $before_tag . ' ' .  MIME::EncWords::encode_mimewords([
										    [Encode::decode('utf8', '['.$parsed_tag.']'), &Language::GetCharset()]
										    ], Encoding=>'A', Field=>'Subject') . ' ' . $after_tag;
	}

	$message->{'msg'}->head->add('Subject', $subject_field);
    }
    
    ## Remove unwanted headers if present.
    if ($self->{'admin'}{'remove_headers'}) {
        foreach my $field (@{$self->{'admin'}{'remove_headers'}}) {
            $hdr->delete($field);
        }
    }

    ## Archives
    $self->archive_msg($message);
    
    ## Change the reply-to header if necessary. 
    if ($self->{'admin'}{'reply_to_header'}) {
	unless ($hdr->get('Reply-To') && ($self->{'admin'}{'reply_to_header'}{'apply'} ne 'forced')) {
	    my $reply;

	    $hdr->delete('Reply-To');
	    $hdr->delete('Resent-Reply-To');

	    if ($self->{'admin'}{'reply_to_header'}{'value'} eq 'list') {
		$reply = "$name\@$host";
	    }elsif ($self->{'admin'}{'reply_to_header'}{'value'} eq 'sender') {
		$reply = $hdr->get('From');
	    }elsif ($self->{'admin'}{'reply_to_header'}{'value'} eq 'all') {
		$reply = "$name\@$host,".$hdr->get('From');
	    }elsif ($self->{'admin'}{'reply_to_header'}{'value'} eq 'other_email') {
		$reply = $self->{'admin'}{'reply_to_header'}{'other_email'};
	    }
	    
	    $hdr->add('Reply-To',$reply) if $reply;
	}
    }
    
    ## Add/replace useful headers

    ## These fields should be added preserving existing ones.
    $hdr->add('X-Loop', "$name\@$host");
    $hdr->add('X-Sequence', $sequence);
    ## These fields should be overwritten if any of them already exist
    $hdr->delete('Errors-To');
    $hdr->add('Errors-to', $name.&Conf::get_robot_conf($robot, 'return_path_suffix').'@'.$host);
    ## Two Precedence: fields are added (overwritten), as some MTAs recognize
    ## only one of them.
    $hdr->delete('Precedence');
    $hdr->add('Precedence', 'list');
    $hdr->add('Precedence', 'bulk');
    ## The Sender: field should be added (overwritten) at least for DKIM
    ## compatibility.  Note that Resent-Sender: field will be removed.
    $hdr->replace('Sender', "$self->{'name'}-request\@$self->{'admin'}{'host'}");
    $hdr->delete('Resent-Sender');
    $hdr->replace('X-no-archive', 'yes');

    ## - add custom headers
    foreach my $i (@{$self->{'admin'}{'custom_header'}}) {
	$hdr->add($1, $2) if ($i=~/^([\S\-\:]*)\s(.*)$/);
    }
    
    ## Add RFC 2919 header field
    if ($hdr->get('List-Id')) {
	&do_log('notice', 'Found List-Id: %s', $hdr->get('List-Id'));
	$hdr->delete('List-ID');
    }
    $hdr->add('List-Id', sprintf ('<%s.%s>', $self->{'name'}, $self->{'admin'}{'host'}));
    
    ## Add RFC 2369 header fields
    foreach my $field (@{$self->{'admin'}{'rfc2369_header_fields'}}) {
	if ($field eq 'help') {
	    $hdr->add('List-Help', sprintf ('<mailto:%s@%s?subject=help>', &Conf::get_robot_conf($robot, 'email'), &Conf::get_robot_conf($robot, 'host')));
	}elsif ($field eq 'unsubscribe') {
	    $hdr->add('List-Unsubscribe', sprintf ('<mailto:%s@%s?subject=unsubscribe%%20%s>', &Conf::get_robot_conf($robot, 'email'), &Conf::get_robot_conf($robot, 'host'), $self->{'name'}));
	}elsif ($field eq 'subscribe') {
	    $hdr->add('List-Subscribe', sprintf ('<mailto:%s@%s?subject=subscribe%%20%s>', &Conf::get_robot_conf($robot, 'email'), &Conf::get_robot_conf($robot, 'host'), $self->{'name'}));
	}elsif ($field eq 'post') {
	    $hdr->add('List-Post', sprintf ('<mailto:%s@%s>', $self->{'name'}, $self->{'admin'}{'host'}));
	}elsif ($field eq 'owner') {
	    $hdr->add('List-Owner', sprintf ('<mailto:%s-request@%s>', $self->{'name'}, $self->{'admin'}{'host'}));
	}elsif ($field eq 'archive') {
	    if (&Conf::get_robot_conf($robot, 'wwsympa_url') and $self->is_web_archived()) {
		$hdr->add('List-Archive', sprintf ('<%s/arc/%s>', &Conf::get_robot_conf($robot, 'wwsympa_url'), $self->{'name'}));
	    }
	}
    }

    ## Remove outgoing header fileds
    ## Useful to remove some header fields that Sympa has set
    if ($self->{'admin'}{'remove_outgoing_headers'}) {
        foreach my $field (@{$self->{'admin'}{'remove_outgoing_headers'}}) {
            $hdr->delete($field);
        }
    }   
    
    ## store msg in digest if list accept digest mode (encrypted message can't be included in digest)
    if (($self->is_digest()) and ($message->{'smime_crypted'} ne 'smime_crypted')) {
	$self->store_digest($message);
    }

    ## Synchronize list members, required if list uses include sources
    ## unless sync_include has been performed recently.
    if ($self->has_include_data_sources()) {
	$self->on_the_fly_sync_include('use_ttl' => 1);
    }

    ## Blindly send the message to all users.
    my $numsmtp = $self->send_msg('message'=> $message, 'apply_dkim_signature'=>$apply_dkim_signature);
    unless (defined ($numsmtp)) {
	return $numsmtp;
    }
    
    $self->savestats();
    
    return $numsmtp;
}

####################################################
# send_msg_digest                              
####################################################
# Send a digest message to the subscribers with 
# reception digest, digestplain or summary
# 
# IN : -$self(+) : ref(List)
#
# OUT : 1 : ok
#       | 0 if no subscriber for sending digest
#       | undef
####################################################
sub send_msg_digest {
    my ($self) = @_;

    my $listname = $self->{'name'};
    my $robot = $self->{'domain'};
    do_log('debug2', 'List:send_msg_digest(%s)', $listname);
    
    my $filename;
    ## Backward compatibility concern
    if (-f "$Conf::Conf{'queuedigest'}/$listname") {
 	$filename = "$Conf::Conf{'queuedigest'}/$listname";
    }else {
 	$filename = $Conf::Conf{'queuedigest'}.'/'.$self->get_list_id();
    }
    
    my $param = {'replyto' => "$self->{'name'}-request\@$self->{'admin'}{'host'}",
		 'to' => $self->get_list_address(),
		 'table_of_content' => sprintf(gettext("Table of contents:")),
		 'boundary1' => '----------=_'.&tools::get_message_id($robot),
		 'boundary2' => '----------=_'.&tools::get_message_id($robot),
		 };
    if ($self->get_reply_to() =~ /^list$/io) {
	$param->{'replyto'}= "$param->{'to'}";
    }
    
    my @tabrcpt ;
    my @tabrcptsummary;
    my @tabrcptplain;
    my $i;
    
    my (@list_of_mail);

    ## Create the list of subscribers in various digest modes
    for (my $user = $self->get_first_user(); $user; $user = $self->get_next_user()) {
	my $options;
	$options->{'email'} = $user->{'email'};
	$options->{'name'} = $self->{'name'};
	$options->{'domain'} = $self->{'domain'};
	my $user_data = &get_subscriber_no_object($options);
	## test to know if the rcpt suspended her subscription for this list
	## if yes, don't send the message
	if ($user_data->{'suspend'} eq '1'){
	    if(($user_data->{'startdate'} <= time) && ((time <= $user_data->{'enddate'}) || (!$user_data->{'enddate'}))){
		next;
	    }elsif(($user_data->{'enddate'} < time) && ($user_data->{'enddate'})){
		## If end date is < time, update the BDD by deleting the suspending's data
		&restore_suspended_subscription($user->{'email'},$self->{'name'},$self->{'domain'});
	    }
	}
	if ($user->{'reception'} eq "digest") {
	    push @tabrcpt, $user->{'email'};

	}elsif ($user->{'reception'} eq "summary") {
	    ## Create the list of subscribers in summary mode
	    push @tabrcptsummary, $user->{'email'};
        
	}elsif ($user->{'reception'} eq "digestplain") {
	    push @tabrcptplain, $user->{'email'};              
	}
    }
    if (($#tabrcptsummary == -1) and ($#tabrcpt == -1) and ($#tabrcptplain == -1)) {
	&do_log('info', 'No subscriber for sending digest in list %s', $listname);
	return 0;
    }

    my $old = $/;
    local $/ = "\n\n" . &tools::get_separator() . "\n\n";
    
    ## Digest split in individual messages
    open DIGEST, $filename or return undef;
    foreach (<DIGEST>){
	
	my @text = split /\n/;
	pop @text; pop @text;
	
	## Restore carriage returns
	foreach $i (0 .. $#text) {
	    $text[$i] .= "\n";
	}
	
	my $parser = new MIME::Parser;
	$parser->output_to_core(1);
	$parser->extract_uuencode(1);  
	$parser->extract_nested_messages(1);
#   $parser->output_dir($Conf::Conf{'spool'} ."/tmp");    
	my $mail = $parser->parse_data(\@text);
	
	next unless (defined $mail);

	push @list_of_mail, $mail;
    }
    close DIGEST;
    local $/ = $old;

    ## Deletes the introduction part
    splice @list_of_mail, 0, 1;
    
    ## Digest index
    my @all_msg;
    foreach $i (0 .. $#list_of_mail){
	my $mail = $list_of_mail[$i];
	my $subject = &tools::decode_header($mail, 'Subject');
	my $from = &tools::decode_header($mail, 'From');
	my $date = &tools::decode_header($mail, 'Date');

        my $msg = {};
	$msg->{'id'} = $i+1;
        $msg->{'subject'} = $subject;	
	$msg->{'from'} = $from;
	$msg->{'date'} = $date;
	
	#$mail->tidy_body;
	
        ## Commented because one Spam made Sympa die (MIME::tools 5.413)
	#$mail->remove_sig;
	
	$msg->{'full_msg'} = $mail->as_string;
	$msg->{'body'} = $mail->body_as_string;
	$msg->{'plain_body'} = $mail->PlainDigest::plain_body_as_string();
	#$msg->{'body'} = $mail->bodyhandle->as_string();
	chomp $msg->{'from'};
	$msg->{'month'} = strftime("%Y-%m", localtime(time)); ## Should be extracted from Date:
	$msg->{'message_id'} = &tools::clean_msg_id($mail->head->get('Message-Id'));
	
	## Clean up Message-ID
	$msg->{'message_id'} = &tools::escape_chars($msg->{'message_id'});

        #push @{$param->{'msg_list'}}, $msg ;
	push @all_msg, $msg ;	
    }
    
    my @now  = localtime(time);
    $param->{'datetime'} = gettext_strftime "%a, %d %b %Y %H:%M:%S", @now;
    $param->{'date'} = gettext_strftime "%a, %d %b %Y", @now;

    ## Split messages into groups of digest_max_size size
    my @group_of_msg;
    while (@all_msg) {
	my @group = splice @all_msg, 0, $self->{'admin'}{'digest_max_size'};
	
	push @group_of_msg, \@group;
    }
    

    $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-forwarded';
	
	## Prepare Digest
	if (@tabrcpt) {
	    ## Send digest
	    unless ($self->send_file('digest', \@tabrcpt, $robot, $param)) {
		&do_log('notice',"Unable to send template 'digest' to $self->{'name'} list subscribers");
	    }
	}    
	
	## Prepare Plain Text Digest
	if (@tabrcptplain) {
	    ## Send digest-plain
	    unless ($self->send_file('digest_plain', \@tabrcptplain, $robot, $param)) {
		&do_log('notice',"Unable to send template 'digest_plain' to $self->{'name'} list subscribers");
	    }
	}    
	
	
	## send summary
	if (@tabrcptsummary) {
	    unless ($self->send_file('summary', \@tabrcptsummary, $robot, $param)) {
		&do_log('notice',"Unable to send template 'summary' to $self->{'name'} list subscribers");
	    }
	}
    }    
    
    return 1;
}


#########################   TEMPLATE SENDING  ##########################################


####################################################
# send_global_file                              
####################################################
#  Send a global (not relative to a list) 
#  message to a user.
#  Find the tt2 file according to $tpl, set up 
#  $data for the next parsing (with $context and
#  configuration )
#  
# IN : -$tpl (+): template file name (file.tt2),
#         without tt2 extension
#      -$who (+): SCALAR |ref(ARRAY) - recipient(s)
#      -$robot (+): robot
#      -$context : ref(HASH) - for the $data set up 
#         to parse file tt2, keys can be :
#         -user : ref(HASH), keys can be :
#           -email
#           -lang
#           -password
#         -auto_submitted auto-generated|auto-replied|auto-forwarded
#         -...
#      -$options : ref(HASH) - options
# OUT : 1 | undef
#       
####################################################
sub send_global_file {
    my($tpl, $who, $robot, $context, $options) = @_;
    do_log('debug2', 'List::send_global_file(%s, %s, %s)', $tpl, $who, $robot);

    my $data = &tools::dup_var($context);

    unless ($data->{'user'}) {
	$data->{'user'} = &get_user_db($who) unless ($options->{'skip_db'});
	$data->{'user'}{'email'} = $who unless (defined $data->{'user'});;
    }
    unless ($data->{'user'}{'lang'}) {
	$data->{'user'}{'lang'} = $Language::default_lang;
    }
    
    unless ($data->{'user'}{'password'}) {
	$data->{'user'}{'password'} = &tools::tmp_passwd($who);
    }

    ## Lang
    $data->{'lang'} = $data->{'lang'} || $data->{'user'}{'lang'} || &Conf::get_robot_conf($robot, 'lang');

    ## What file 
    my $lang = &Language::Lang2Locale($data->{'lang'});
    my $tt2_include_path = &tools::make_tt2_include_path($robot,'mail_tt2',$lang,'');

    foreach my $d (@{$tt2_include_path}) {
	&tt2::add_include_path($d);
    }

    my @path = &tt2::get_include_path();
    my $filename = &tools::find_file($tpl.'.tt2',@path);
 
    unless (defined $filename) {
	&do_log('err','Could not find template %s.tt2 in %s', $tpl, join(':',@path));
	return undef;
    }

    foreach my $p ('email','host','sympa','request','listmaster','wwsympa_url','title','listmaster_email') {
	$data->{'conf'}{$p} = &Conf::get_robot_conf($robot, $p);
    }

    $data->{'sender'} = $who;
    $data->{'conf'}{'version'} = Sympa::Constants::VERSION();
    $data->{'from'} = "$data->{'conf'}{'email'}\@$data->{'conf'}{'host'}" unless ($data->{'from'});
    $data->{'robot_domain'} = $robot;
    $data->{'return_path'} = &Conf::get_robot_conf($robot, 'request');
    $data->{'boundary'} = '----------=_'.&tools::get_message_id($robot) unless ($data->{'boundary'});

    if ((&Conf::get_robot_conf($robot, 'dkim_feature') eq 'on')&&(&Conf::get_robot_conf($robot, 'dkim_add_signature_to')=~/robot/)){
	$data->{'dkim'} = &tools::get_dkim_parameters({'robot' => $robot});
    }
    
    $data->{'use_bulk'} = 1  unless ($data->{'alarm'}) ; # use verp excepted for alarms. We should make this configurable in order to support Sympa server on a machine without any MTA service
    unless (&mail::mail_file($filename, $who, $data, $robot)) {
	&do_log('err',"List::send_global_file, could not send template $filename to $who");
	return undef;
    }

    return 1;
}

####################################################
# send_file                              
####################################################
#  Send a message to a user, relative to a list.
#  Find the tt2 file according to $tpl, set up 
#  $data for the next parsing (with $context and
#  configuration)
#  Message is signed if the list has a key and a 
#  certificate
#  
# IN : -$self (+): ref(List)
#      -$tpl (+): template file name (file.tt2),
#         without tt2 extension
#      -$who (+): SCALAR |ref(ARRAY) - recipient(s)
#      -$robot (+): robot
#      -$context : ref(HASH) - for the $data set up 
#         to parse file tt2, keys can be :
#         -user : ref(HASH), keys can be :
#           -email
#           -lang
#           -password
#         -auto_submitted auto-generated|auto-replied|auto-forwarded
#         -...
# OUT : 1 | undef
####################################################
sub send_file {
    my($self, $tpl, $who, $robot, $context) = @_;
    do_log('debug2', 'List::send_file(%s, %s, %s)', $tpl, $who, $robot);

    my $name = $self->{'name'};
    my $sign_mode;

    my $data = &tools::dup_var($context);

    ## Any recipients
    if ((ref ($who) && ($#{$who} < 0)) ||
	(!ref ($who) && ($who eq ''))) {
	&do_log('err', 'No recipient for sending %s', $tpl);
	return undef;
    }
    
    ## Unless multiple recipients
    unless (ref ($who)) {
	unless ($data->{'user'}) {
	    unless ($data->{'user'} = &get_user_db($who)) {
		$data->{'user'}{'email'} = $who;
		$data->{'user'}{'lang'} = $self->{'admin'}{'lang'};
	    }
	}
	
	$data->{'subscriber'} = $self->get_subscriber($who);
	
	if ($data->{'subscriber'}) {
	    $data->{'subscriber'}{'date'} = gettext_strftime "%d %b %Y", localtime($data->{'subscriber'}{'date'});
	    $data->{'subscriber'}{'update_date'} = gettext_strftime "%d %b %Y", localtime($data->{'subscriber'}{'update_date'});
	    if ($data->{'subscriber'}{'bounce'}) {
		$data->{'subscriber'}{'bounce'} =~ /^(\d+)\s+(\d+)\s+(\d+)(\s+(.*))?$/;
		
		$data->{'subscriber'}{'first_bounce'} = gettext_strftime "%d %b %Y", localtime($1);
	    }
	}
	
	unless ($data->{'user'}{'password'}) {
	    $data->{'user'}{'password'} = &tools::tmp_passwd($who);
	}
	
	## Unique return-path VERP
	if ((($self->{'admin'}{'welcome_return_path'} eq 'unique') && ($tpl eq 'welcome')) ||
	    (($self->{'admin'}{'remind_return_path'} eq 'unique') && ($tpl eq 'remind')))  {
	    my $escapercpt = $who ;
	    $escapercpt =~ s/\@/\=\=a\=\=/;
	    $data->{'return_path'} = "$Conf::Conf{'bounce_email_prefix'}+$escapercpt\=\=$name";
	    $data->{'return_path'} .= '==w' if ($tpl eq 'welcome');
	    $data->{'return_path'} .= '==r' if ($tpl eq 'remind');
	    $data->{'return_path'} .= "\@$self->{'domain'}";
	}
    }

    $data->{'return_path'} ||= $name.&Conf::get_robot_conf($robot, 'return_path_suffix').'@'.$self->{'admin'}{'host'};

    ## Lang
    $data->{'lang'} = $data->{'user'}{'lang'} || $self->{'admin'}{'lang'} || &Conf::get_robot_conf($robot, 'lang');

    ## Trying to use custom_vars
    if (defined $self->{'admin'}{'custom_vars'}) {
	$data->{'custom_vars'} = {};
	foreach my $var (@{$self->{'admin'}{'custom_vars'}}) {
 	    $data->{'custom_vars'}{$var->{'name'}} = $var->{'value'};
	}
    }
    
    ## What file   
    my $lang = &Language::Lang2Locale($data->{'lang'});
    my $tt2_include_path = &tools::make_tt2_include_path($robot,'mail_tt2',$lang,$self);

    push @{$tt2_include_path},$self->{'dir'};             ## list directory to get the 'info' file
    push @{$tt2_include_path},$self->{'dir'}.'/archives'; ## list archives to include the last message

    foreach my $d (@{$tt2_include_path}) {
	&tt2::add_include_path($d);
    }

    foreach my $p ('email','host','sympa','request','listmaster','wwsympa_url','title','listmaster_email') {
	$data->{'conf'}{$p} = &Conf::get_robot_conf($robot, $p);
    }

    my @path = &tt2::get_include_path();
    my $filename = &tools::find_file($tpl.'.tt2',@path);
    
    unless (defined $filename) {
	&do_log('err','Could not find template %s.tt2 in %s', $tpl, join(':',@path));
	return undef;
    }

    $data->{'sender'} ||= $who;
    $data->{'list'}{'lang'} = $self->{'admin'}{'lang'};
    $data->{'list'}{'name'} = $name;
    $data->{'list'}{'domain'} = $data->{'robot_domain'} = $robot;
    $data->{'list'}{'host'} = $self->{'admin'}{'host'};
    $data->{'list'}{'subject'} = $self->{'admin'}{'subject'};
    $data->{'list'}{'owner'} = $self->get_owners();
    $data->{'list'}{'dir'} = $self->{'dir'};

    ## Sign mode
    if ($Conf::Conf{'openssl'} &&
	(-r $self->{'dir'}.'/cert.pem') && (-r $self->{'dir'}.'/private_key')) {
	$sign_mode = 'smime';
    }

    # if the list have it's private_key and cert sign the message
    # . used only for the welcome message, could be usefull in other case? 
    # . a list should have several certificates and use if possible a certificate
    #   issued by the same CA as the recipient CA if it exists 
    if ($sign_mode eq 'smime') {
	$data->{'fromlist'} = "$name\@$data->{'list'}{'host'}";
	$data->{'replyto'} = "$name"."-request\@$data->{'list'}{'host'}";
    }else{
	$data->{'fromlist'} = "$name"."-request\@$data->{'list'}{'host'}";
    }

    $data->{'from'} = $data->{'fromlist'} unless ($data->{'from'});
    $data->{'boundary'} = '----------=_'.&tools::get_message_id($robot) unless ($data->{'boundary'});
    $data->{'sign_mode'} = $sign_mode;
    
    if ((&Conf::get_robot_conf($self->{'domain'}, 'dkim_feature') eq 'on')&&(&Conf::get_robot_conf($self->{'domain'}, 'dkim_add_signature_to')=~/list/)){
	$data->{'dkim'} = &tools::get_dkim_parameters({'robot' => $self->{'domain'}});
    } 
    $data->{'use_bulk'} = 1  unless ($data->{'alarm'}) ; # use verp excepted for alarms. We should make this configurable in order to support Sympa server on a machine without any MTA service
    unless (&mail::mail_file($filename, $who, $data, $self->{'domain'})) {
	&do_log('err',"List::send_file, could not send template $filename to $who");
	return undef;
    }

    return 1;
}

####################################################
# send_msg                              
####################################################
# selects subscribers according to their reception 
# mode in order to distribute a message to a list
# and sends the message to them. For subscribers in reception mode 'mail', 
# and in a msg topic context, selects only one who are subscribed to the topic
# of the message.
# 
#  
# IN : -$self (+): ref(List)  
#      -$message (+): ref(Message)
# OUT : -$numsmtp : number of sendmail process 
#       | 0 : no subscriber for sending message in list
#       | undef 
####################################################
sub send_msg {

    my $self = shift;
    my %param = @_;

    my $message = $param{'message'};
    my $apply_dkim_signature = $param{'apply_dkim_signature'};

    do_log('debug2', 'List::send_msg(filname = %s, smime_crypted = %s,apply_dkim_signature = %s )', $message->{'filename'}, $message->{'smime_crypted'},$apply_dkim_signature);
    
    my $hdr = $message->{'msg'}->head;
    my $name = $self->{'name'};
    my $robot = $self->{'domain'};
    my $admin = $self->{'admin'};
    my $total = $self->get_total('nocache');
    my $sender_line = $hdr->get('From');
    my @sender_hdr = Mail::Address->parse($sender_line);
    my %sender_hash;
    foreach my $email (@sender_hdr) {
	$sender_hash{lc($email->address)} = 1;
    }
   
    unless ($total > 0) {
	&do_log('info', 'No subscriber in list %s', $name);
	return 0;
    }

    ## Bounce rate
    my $rate = $self->get_total_bouncing() * 100 / $total;
    if ($rate > $self->{'admin'}{'bounce'}{'warn_rate'}) {
	unless ($self->send_notify_to_owner('bounce_rate',{'rate' => $rate})) {
	    &do_log('notice',"Unable to send notify 'bounce_rate' to $self->{'name'} listowner");
	}
    }
 
    ## Who is the enveloppe sender?
    my $host = $self->{'admin'}{'host'};
    my $from = $name.&Conf::get_robot_conf($robot, 'return_path_suffix').'@'.$host;

    # separate subscribers depending on user reception option and also if verp a dicovered some bounce for them.
    my (@tabrcpt, @tabrcpt_notice, @tabrcpt_txt, @tabrcpt_html, @tabrcpt_url, @tabrcpt_verp, @tabrcpt_notice_verp, @tabrcpt_txt_verp, @tabrcpt_html_verp, @tabrcpt_url_verp);
    my $mixed = ($message->{'msg'}->head->get('Content-Type') =~ /multipart\/mixed/i);
    my $alternative = ($message->{'msg'}->head->get('Content-Type') =~ /multipart\/alternative/i);
    my $recip = $message->{'msg'}->head->get('X-Sympa-Receipient');
 
    if ($recip) {
	@tabrcpt = split /,/, $recip;
	$message->{'msg'}->head->delete('X-Sympa-Receipient');

    } else {
	
	for ( my $user = $self->get_first_user(); $user; $user = $self->get_next_user() ){
	    unless ($user->{'email'}) {
		&do_log('err','Skipping user with no email address in list %s', $name);
		next;
	    }
	    my $options;
	    $options->{'email'} = $user->{'email'};
	    $options->{'name'} = $name;
	    $options->{'domain'} = $robot;
	    my $user_data = &get_subscriber_no_object($options);
	    ## test to know if the rcpt suspended her subscription for this list
	    ## if yes, don't send the message
	    if ($user_data->{'suspend'} eq '1'){
		if(($user_data->{'startdate'} <= time) && ((time <= $user_data->{'enddate'}) || (!$user_data->{'enddate'}))){
		    next;
		}elsif(($user_data->{'enddate'} < time) && ($user_data->{'enddate'})){
		    ## If end date is < time, update the BDD by deleting the suspending's data
		    &restore_suspended_subscription($user->{'email'}, $name, $robot);
		}
	    }
	    if ($user->{'reception'} =~ /^(digest|digestplain|summary|nomail)$/i) {
		next;
	    } elsif ($user->{'reception'} eq 'notice') {
		if ($user->{'bounce_address'}) {
		    push @tabrcpt_notice_verp, $user->{'email'}; 
		}else{
		    push @tabrcpt_notice, $user->{'email'}; 
		}
	    } elsif ($alternative and ($user->{'reception'} eq 'txt')) {
		if ($user->{'bounce_address'}) {
		    push @tabrcpt_txt_verp, $user->{'email'};
		}else{
		    push @tabrcpt_txt, $user->{'email'};
		}
	    } elsif ($alternative and ($user->{'reception'} eq 'html')) {
		if ($user->{'bounce_address'}) {
		    push @tabrcpt_html_verp, $user->{'email'};
		}else{
		    if ($user->{'bounce_address'}) {
			push @tabrcpt_html_verp, $user->{'email'};
		    }else{
			push @tabrcpt_html, $user->{'email'};
		    }
		}
	    } elsif ($mixed and ($user->{'reception'} eq 'urlize')) {
		if ($user->{'bounce_address'}) {
		    push @tabrcpt_url_verp, $user->{'email'};
		}else{
		    push @tabrcpt_url, $user->{'email'};
		}
	    } elsif ($message->{'smime_crypted'} && 
		     (! -r $Conf::Conf{'ssl_cert_dir'}.'/'.&tools::escape_chars($user->{'email'}) &&
		      ! -r $Conf::Conf{'ssl_cert_dir'}.'/'.&tools::escape_chars($user->{'email'}.'@enc' ))) {
		## Missing User certificate
		my $subject = $message->{'msg'}->head->get('Subject');
		my $sender = $message->{'msg'}->head->get('From');
		unless ($self->send_file('x509-user-cert-missing', $user->{'email'}, $robot, {'mail' => {'subject' => $subject, 'sender' => $sender}, 'auto_submitted' => 'auto-generated'})) {
		    &do_log('notice',"Unable to send template 'x509-user-cert-missing' to $user->{'email'}");
		}
	    }else{
		if ($user->{'bounce_address'}) {
		    push @tabrcpt_verp, $user->{'email'} unless ($sender_hash{$user->{'email'}})&&($user->{'reception'} eq 'not_me');
		}else{	    
		    push @tabrcpt, $user->{'email'} unless ($sender_hash{$user->{'email'}})&&($user->{'reception'} eq 'not_me');}
	    }	    
	}
    }

    ## sa  return 0  = Pb  ?
    unless (@tabrcpt || @tabrcpt_notice || @tabrcpt_txt || @tabrcpt_html || @tabrcpt_url || @tabrcpt_verp || @tabrcpt_notice_verp || @tabrcpt_txt_verp || @tabrcpt_html_verp || @tabrcpt_url_verp) {
	&do_log('info', 'No subscriber for sending msg in list %s', $name);
	return 0;
    }
    #save the message before modifying it
    my $saved_msg = $message->{'msg'}->dup;
    my $nbr_smtp = 0;
    my $nbr_verp = 0;

    # prepare verp parameter
    my $verp_rate =  $self->{'admin'}{'verp_rate'};
    my $xsequence =  $self->{'stats'}->[0] ;

    my $tags_to_use;

    # Define messages which can be tagged as first or last according to the verp rate.
    # If the VERP is 100%, then all the messages are VERP. Don't try to tag not VERP
    # messages as they won't even exist.
    if($verp_rate eq '0%'){
	$tags_to_use->{'tag_verp'} = 0;
	$tags_to_use->{'tag_noverp'} = 1;
    }else{
	$tags_to_use->{'tag_verp'} = 1;
	$tags_to_use->{'tag_noverp'} = 0;
    }
 
    my $dkim_parameters ;
    # prepare dkim parameters
    if ($apply_dkim_signature eq 'on') {
	$dkim_parameters = &tools::get_dkim_parameters({'robot'=>$self->{'domain'}, 'listname'=>$self->{'name'}});
    }

    ## Storing the not empty subscribers' arrays into a hash.
    my $available_rcpt;
    my $available_verp_rcpt;

    if (@tabrcpt) {
	$available_rcpt->{'tabrcpt'} = \@tabrcpt;
	$available_verp_rcpt->{'tabrcpt'} = \@tabrcpt_verp;
    }
    if (@tabrcpt_notice) {
	$available_rcpt->{'tabrcpt_notice'} = \@tabrcpt_notice;
	$available_verp_rcpt->{'tabrcpt_notice'} = \@tabrcpt_notice_verp;
    }
    if (@tabrcpt_txt) {
	$available_rcpt->{'tabrcpt_txt'} = \@tabrcpt_txt;
	$available_verp_rcpt->{'tabrcpt_txt'} = \@tabrcpt_txt_verp;
    }
    if (@tabrcpt_html) {
	$available_rcpt->{'tabrcpt_html'} = \@tabrcpt_html;
	$available_verp_rcpt->{'tabrcpt_html'} = \@tabrcpt_html_verp;
    }
    if (@tabrcpt_url) {
	$available_rcpt->{'tabrcpt_url'} = \@tabrcpt_url;
	$available_verp_rcpt->{'tabrcpt_url'} = \@tabrcpt_url_verp;
    }

    foreach my $array_name (keys %$available_rcpt) {
	my $new_message;
	##Prepare message for normal reception mode
	if ($array_name eq 'tabrcpt') {
	    ## Add a footer
	    unless ($message->{'protected'}) {
		my $new_msg = $self->add_parts($message->{'msg'});
		if (defined $new_msg) {
		    $message->{'msg'} = $new_msg;
		    $message->{'altered'} = '_ALTERED_';
		}
	    }
	    $new_message = $message;	    
	    
	##Prepare message for notice reception mode
	}elsif($array_name eq 'tabrcpt_notice'){
	    my $notice_msg = $saved_msg->dup;
	    $notice_msg->bodyhandle(undef);    
	    $notice_msg->parts([]);
	    $new_message = new Message($notice_msg);

	##Prepare message for txt reception mode
	}elsif($array_name eq 'tabrcpt_txt'){
	    my $txt_msg = $saved_msg->dup;
	    if (&tools::as_singlepart($txt_msg, 'text/plain')) {
		do_log('notice', 'Multipart message changed to singlepart');
	    }
	    
	    ## Add a footer
	    my $new_msg = $self->add_parts($txt_msg);
	    if (defined $new_msg) {
		$txt_msg = $new_msg;
	    }
	    $new_message = new Message($txt_msg);

	##Prepare message for html reception mode
	}elsif($array_name eq 'tabrcpt_html'){
	    my $html_msg = $saved_msg->dup;
	    if (&tools::as_singlepart($html_msg, 'text/html')) {
		do_log('notice', 'Multipart message changed to singlepart');
	    }
	    ## Add a footer
	    my $new_msg = $self->add_parts($html_msg);
	    if (defined $new_msg) {
		$html_msg = $new_msg;
	    }
	    $new_message = new Message($html_msg);
	    
	##Prepare message for urlize reception mode
	}elsif($array_name eq 'tabrcpt_url'){
	    my $url_msg = $saved_msg->dup; 
	    
	    my $expl = $self->{'dir'}.'/urlized';
	    
	    unless ((-d $expl) ||( mkdir $expl, 0775)) {
		do_log('err', "Unable to create urlize directory $expl");
		return undef;
	    }
	    
	    my $dir1 = &tools::clean_msg_id($url_msg->head->get('Message-ID'));
	    
	    ## Clean up Message-ID
	    $dir1 = &tools::escape_chars($dir1);
	    $dir1 = '/'.$dir1;
	    
	    unless ( mkdir ("$expl/$dir1", 0775)) {
		do_log('err', "Unable to create urlize directory $expl/$dir1");
		printf "Unable to create urlized directory $expl/$dir1";
		return 0;
	    }
	    my $mime_types = &tools::load_mime_types();
	    my @parts = ();
	    my $i = 0;
	    foreach my $part ($url_msg->parts()) {
		my $entity = &_urlize_part($part, $self, $dir1, $i, $mime_types,  &Conf::get_robot_conf($robot, 'wwsympa_url'));
		if (defined $entity) {
		    push @parts, $entity;
		} else {
		    push @parts, $part;
		}
		$i++;
	    }
	    
	    ## Replace message parts
	    $url_msg->parts (\@parts);
	    
	    ## Add a footer
	    my $new_msg = $self->add_parts($url_msg);
	    if (defined $new_msg) {
		$url_msg = $new_msg;
	    } 
	    $new_message = new Message($url_msg);
	}

	## TOPICS
	my @selected_tabrcpt;
	my @possible_verptabrcpt;
	if ($self->is_there_msg_topic()){
	    @selected_tabrcpt = $self->select_subscribers_for_topic($new_message->get_topic(),$available_rcpt->{$array_name});
	    @possible_verptabrcpt = $self->select_subscribers_for_topic($new_message->get_topic(),$available_verp_rcpt->{$array_name});
	} else {
	    @selected_tabrcpt = @{$available_rcpt->{$array_name}};
	    @possible_verptabrcpt = @{$available_verp_rcpt->{$array_name}};
	}

	## Preparing VERP recipients.
	my @verp_selected_tabrcpt = &extract_verp_rcpt($verp_rate, $xsequence,\@selected_tabrcpt, \@possible_verptabrcpt);
	
	## Sending non VERP.
	if ($#selected_tabrcpt > -1) {
	    my $result = &mail::mail_message('message'=>$new_message, 
					     'rcpt'=> \@selected_tabrcpt, 
					     'list'=>$self, 
					     'verp' => 'off', 
					     'dkim_parameters'=>$dkim_parameters,
					     'tag_as_last' => $tags_to_use->{'tag_noverp'});
	    unless (defined $result) {
		&do_log('err',"List::send_msg, could not send message to distribute from $from (verp desabled)");
		return undef;
	    }
	    $tags_to_use->{'tag_noverp'} = 0 if ($result > 0);
	    $nbr_smtp += $result;
	}else{
	    Log::do_log('notice','No non VERP subscribers left to distribute message from %s to list %s',$from,$self->{'name'});
	}
	
	## Sending VERP.
	if ($#verp_selected_tabrcpt > -1) {
	    my $result = &mail::mail_message('message'=> $new_message, 
					  'rcpt'=> \@verp_selected_tabrcpt, 
					  'list'=> $self,
					  'verp' => 'on',
					  'dkim_parameters'=>$dkim_parameters,
					  'tag_as_last' => $tags_to_use->{'tag_verp'});
	    unless (defined $result) {
		&do_log('err',"List::send_msg, could not send message to distribute from $from (verp enabled)");
		return undef;
	    }
	    $tags_to_use->{'tag_verp'} = 0 if ($result > 0);
	    $nbr_smtp += $result;
	    $nbr_verp += $result;
	}else{
	    Log::do_log('notice','No VERP subscribers left to distribute message from %s to list %s',$from,$self->{'name'});
	}
    }

    return $nbr_smtp;
}

#########################   SERVICE MESSAGES   ##########################################

###############################################################
# send_to_editor
###############################################################
# Sends a message to the list editor to ask him for moderation 
# ( in moderation context : editor or editorkey). The message 
# to moderate is set in spool queuemod with name containing
# a key (reference send to editor for moderation)
# In context of msg_topic defined the editor must tag it 
# for the moderation (on Web interface)
#  
# IN : -$self(+) : ref(List)
#      -$method : 'md5' - for "editorkey" | 'smtp' - for "editor"
#      -$message(+) : ref(Message) - the message to moderatte
# OUT : $modkey : the moderation key for naming message waiting 
#         for moderation in spool queuemod
#       | undef
#################################################################
sub send_to_editor {
   my($self, $method, $message) = @_;
   my ($msg, $file, $encrypt) = ($message->{'msg'}, $message->{'filename'});

   $encrypt = 'smime_crypted' if ($message->{'smime_crypted'}); 
   do_log('debug3', "List::send_to_editor, msg: $msg, file: $file method : $method, encrypt : $encrypt");

   my($i, @rcpt);
   my $admin = $self->{'admin'};
   my $name = $self->{'name'};
   my $host = $admin->{'host'};
   my $robot = $self->{'domain'};
   my $modqueue = $Conf::Conf{'queuemod'};
   return unless ($name && $admin);
  
   my @now = localtime(time);
   my $messageid=$now[6].$now[5].$now[4].$now[3].$now[2].$now[1]."."
                 .int(rand(6)).int(rand(6)).int(rand(6)).int(rand(6)).int(rand(6)).int(rand(6))."\@".$host;
   my $modkey=Digest::MD5::md5_hex(join('/', $self->get_cookie(),$messageid));
   my $boundary ="__ \<$messageid\>";
   
   ## Keeps a copy of the message
   if ($method eq 'md5'){  
       my $mod_file = $modqueue.'/'.$self->get_list_id().'_'.$modkey;
       unless (open(OUT, ">$mod_file")) {
	   do_log('notice', 'Could Not open %s', $mod_file);
	   return undef;
       }

       unless (open (MSG, $file)) {
	   do_log('notice', 'Could not open %s', $file);
	   return undef;   
       }

       print OUT <MSG>;
       close MSG ;
       close(OUT);

       my $tmp_dir = $modqueue.'/.'.$self->get_list_id().'_'.$modkey;
       unless (-d $tmp_dir) {
	   unless (mkdir ($tmp_dir, 0777)) {
	       &do_log('err','Unable to create %s', $tmp_dir);
	       return undef;
	   }
	   my $mhonarc_ressources = &tools::get_filename('etc',{},'mhonarc-ressources.tt2', $robot, $self);

	   unless ($mhonarc_ressources) {
	       do_log('notice',"Cannot find any MhOnArc ressource file");
	       return undef;
	   }
	   ## generate HTML
	   chdir $tmp_dir;
	   my $mhonarc = &Conf::get_robot_conf($robot, 'mhonarc');
	   my $tag = substr(Digest::MD5::md5_hex(join('/', $Conf::Conf{'cookie'}, $name)), -10);
	   
	   open ARCMOD, "$mhonarc  -single -rcfile $mhonarc_ressources -definevars listname=$name -definevars hostname=$host -definevars tag=$tag $mod_file|";
	   open MSG, ">msg00000.html";
	   &do_log('debug', "$mhonarc  -single -rcfile $mhonarc_ressources -definevars listname=$name -definevars hostname=$host -definevars tag=$tag $mod_file");
	   print MSG <ARCMOD>;
	   close MSG;
	   close ARCMOD;
	   chdir $Conf::Conf{'home'};
       }
   }

   @rcpt = $self->get_editors_email();
   
   my $hdr = $message->{'msg'}->head;

   ## Did we find a recipient?
   if ($#rcpt < 0) {
       &do_log('notice', "No editor found for list %s. Trying to proceed ignoring nomail option", $self->{'name'});
       my $messageid = $hdr->get('Message-Id');
       
       @rcpt = $self->get_editors_email({'ignore_nomail',1});
       &do_log('notice', 'Warning : no owner and editor defined at all in list %s', $name ) unless (@rcpt);
       
       ## Could we find a recipient by ignoring the "nomail" option?
       if ($#rcpt >= 0) {
	   &do_log('notice', 'All the intended recipients of message %s in list %s have set the "nomail" option. Ignoring it and sending it to all of them.', $messageid, $self->{'name'} );
       }
       else {
	   &do_log ('err','Impossible to send the moderation request for message %s to editors of list %s. Neither editor nor owner defined!',$messageid,$self->{'name'}) ;
	   return undef;
       }
   }
   
   my $subject = tools::decode_header($hdr, 'Subject');
   my $param = {'modkey' => $modkey,
		'boundary' => $boundary,
		'msg_from' => $message->{'sender'},
		'subject' => $subject,
		'spam_status' => $message->{'spam_status'},
		'mod_spool_size' => $self->get_mod_spool_size(),
		'method' => $method};

   if ($self->is_there_msg_topic()) {
       $param->{'request_topic'} = 1;
   }

       foreach my $recipient (@rcpt) {
       if ($encrypt eq 'smime_crypted') {	       
	   ## is $msg->body_as_string respect base64 number of char per line ??
	   my $cryptedmsg = &tools::smime_encrypt($msg->head, $msg->body_as_string, $recipient); 
	   unless ($cryptedmsg) {
	       &do_log('notice', 'Failed encrypted message for moderator');
	       # xxxx send a generic error message : X509 cert missing
	       return undef;
	   }

	   my $crypted_file = $Conf::Conf{'tmpdir'}.'/'.$self->get_list_id().'.moderate.'.$$;
	   unless (open CRYPTED, ">$crypted_file") {
	       &do_log('notice', 'Could not create file %s', $crypted_file);
	       return undef;
	   }
	   print CRYPTED $cryptedmsg;
	   close CRYPTED;
	   $param->{'msg_path'} = $crypted_file;

   }else{
       $param->{'msg_path'} = $file;
       }
       # create a one time ticket that will be used as un md5 URL credential

       unless ($param->{'one_time_ticket'} = &Auth::create_one_time_ticket($recipient,$robot,'modindex/'.$name,'mail')){
	   &do_log('notice',"Unable to create one_time_ticket for $recipient, service modindex/$name");
       }else{
	   &do_log('notice',"ticket : $param->{'one_time_ticket'}");
       }
       &tt2::allow_absolute_path();
       $param->{'auto_submitted'} = 'auto-forwarded';

       unless ($self->send_file('moderate', $recipient, $self->{'domain'}, $param)) {
	   &do_log('notice',"Unable to send template 'moderate' to $recipient");
	   return undef;
       }
   }
   return $modkey;
}

####################################################
# send_auth                              
####################################################
# Sends an authentication request for a sent message to distribute.
# The message for distribution is copied in the authqueue 
# spool in order to wait for confirmation by its sender.
# This message is named with a key.
# In context of msg_topic defined, the sender must tag it 
# for the confirmation
#  
# IN : -$self (+): ref(List)
#      -$message (+): ref(Message)
#
# OUT : $authkey : the key for naming message waiting 
#         for confirmation (or tagging) in spool queueauth
#       | undef
####################################################
sub send_auth {
   my($self, $message) = @_;
   my ($sender, $msg, $file) = ($message->{'sender'}, $message->{'msg'}, $message->{'filename'});
   &do_log('debug3', 'List::send_auth(%s, %s)', $sender, $file);

   ## Ensure 1 second elapsed since last message
   sleep (1);

   my($i, @rcpt);
   my $admin = $self->{'admin'};
   my $name = $self->{'name'};
   my $host = $admin->{'host'};
   my $robot = $self->{'domain'};
   my $authqueue = $Conf::Conf{'queueauth'};
   return undef unless ($name && $admin);
  

   my @now = localtime(time);
   my $messageid = $now[6].$now[5].$now[4].$now[3].$now[2].$now[1]."."
                   .int(rand(6)).int(rand(6)).int(rand(6)).int(rand(6))
		   .int(rand(6)).int(rand(6))."\@".$host;
   my $authkey = Digest::MD5::md5_hex(join('/', $self->get_cookie(),$messageid));
     
   my $auth_file = $authqueue.'/'.$self->get_list_id().'_'.$authkey;   
   unless (open OUT, ">$auth_file") {
       &do_log('notice', 'Cannot create file %s', $auth_file);
       return undef;
   }

   unless (open IN, $file) {
       &do_log('notice', 'Cannot open file %s', $file);
       return undef;
   }
   
   print OUT <IN>;

   close IN; close OUT;

   my $param = {'authkey' => $authkey,
		'boundary' => "----------------- Message-Id: \<$messageid\>",
		'file' => $file};
   
   if ($self->is_there_msg_topic()) {
       $param->{'request_topic'} = 1;
   }

   &tt2::allow_absolute_path();
   $param->{'auto_submitted'} = 'auto-replied';
   unless ($self->send_file('send_auth',$sender,$robot,$param)) {
       &do_log('notice',"Unable to send template 'send_auth' to $sender");
       return undef;
   }

   return $authkey;
}

####################################################
# request_auth                              
####################################################
# sends an authentification request for a requested 
# command .
# 
#  
# IN : -$self : ref(List) if is present
#      -$email(+) : recepient (the personn who asked 
#                   for the command)
#      -$cmd : -signoff|subscribe|add|del|remind if $self
#              -remind else
#      -$robot(+) : robot
#      -@param : 0 : used if $cmd = subscribe|add|del|invite
#                1 : used if $cmd = add 
#
# OUT : 1 | undef
#
####################################################
sub request_auth {
    do_log('debug2', 'List::request_auth(%s, %s, %s, %s)', @_);
    my $first_param = shift;
    my ($self, $email, $cmd, $robot, @param);

    if (ref($first_param) eq 'List') {
	$self = $first_param;
	$email= shift;
    }else {
	$email = $first_param;
    }
    $cmd = shift;
    $robot = shift;
    @param = @_;
    &do_log('debug3', 'List::request_auth() List : %s,$email: %s cmd : %s',$self->{'name'},$email,$cmd);

    
    my $keyauth;
    my $data = {'to' => $email};


    if (ref($self) eq 'List') {
	my $listname = $self->{'name'};
	$data->{'list_context'} = 1;

	if ($cmd =~ /signoff$/){
	    $keyauth = $self->compute_auth ($email, 'signoff');
	    $data->{'command'} = "auth $keyauth $cmd $listname $email";
	    $data->{'type'} = 'signoff';
	    
	}elsif ($cmd =~ /subscribe$/){
	    $keyauth = $self->compute_auth ($email, 'subscribe');
	    $data->{'command'} = "auth $keyauth $cmd $listname $param[0]";
	    $data->{'type'} = 'subscribe';

	}elsif ($cmd =~ /add$/){
	    $keyauth = $self->compute_auth ($param[0],'add');
	    $data->{'command'} = "auth $keyauth $cmd $listname $param[0] $param[1]";
	    $data->{'type'} = 'add';
	    
	}elsif ($cmd =~ /del$/){
	    my $keyauth = $self->compute_auth($param[0], 'del');
	    $data->{'command'} = "auth $keyauth $cmd $listname $param[0]";
	    $data->{'type'} = 'del';

	}elsif ($cmd eq 'remind'){
	    my $keyauth = $self->compute_auth('','remind');
	    $data->{'command'} = "auth $keyauth $cmd $listname";
	    $data->{'type'} = 'remind';
	
	}elsif ($cmd eq 'invite'){
	    my $keyauth = $self->compute_auth($param[0],'invite');
	    $data->{'command'} = "auth $keyauth $cmd $listname $param[0]";
	    $data->{'type'} = 'invite';
	}

	$data->{'command_escaped'} = &tt2::escape_url($data->{'command'});
	$data->{'auto_submitted'} = 'auto-replied';
	unless ($self->send_file('request_auth',$email,$robot,$data)) {
	    &do_log('notice',"Unable to send template 'request_auth' to $email");
	    return undef;
	}

    }else {
	if ($cmd eq 'remind'){
	    my $keyauth = &List::compute_auth('',$cmd);
	    $data->{'command'} = "auth $keyauth $cmd *";
	    $data->{'command_escaped'} = &tt2::escape_url($data->{'command'});
	    $data->{'type'} = 'remind';
	    
	}
	$data->{'auto_submitted'} = 'auto-replied';
	unless (&send_global_file('request_auth',$email,$robot,$data)) {
	    &do_log('notice',"Unable to send template 'request_auth' to $email");
	    return undef;
	}
    }


    return 1;
}


####################################################
# archive_send                              
####################################################
# sends an archive file to someone (text archive
# file : independant from web archives)
#  
# IN : -$self(+) : ref(List)
#      -$who(+) : recepient
#      -file(+) : name of the archive file to send
# OUT : - | undef
#
######################################################
sub archive_send {
   my($self, $who, $file) = @_;
   do_log('debug', 'List::archive_send(%s, %s)', $who, $file);

   return unless ($self->is_archived());
       
   my $dir = &Conf::get_robot_conf($self->{'domain'},'arc_path').'/'.$self->get_list_id();
   my $msg_list = Archive::scan_dir_archive($dir, $file);

   my $subject = 'File '.$self->{'name'}.' '.$file ;
   my $param = {'to' => $who,
		'subject' => $subject,
		'msg_list' => $msg_list } ;

   $param->{'boundary1'} = &tools::get_message_id($self->{'domain'});
   $param->{'boundary2'} = &tools::get_message_id($self->{'domain'});
   $param->{'from'} = &Conf::get_robot_conf($self->{'domain'},'sympa');

#    open TMP2, ">/tmp/digdump"; &tools::dump_var($param, 0, \*TMP2); close TMP2;
$param->{'auto_submitted'} = 'auto-replied';
   unless ($self->send_file('get_archive',$who,$self->{'domain'},$param)) {
	   &do_log('notice',"Unable to send template 'archive_send' to $who");
	   return undef;
       }

}

####################################################
# archive_send_last                              
####################################################
# sends last archive file
#  
# IN : -$self(+) : ref(List)
#      -$who(+) : recepient
# OUT : - | undef
#
######################################################
sub archive_send_last {
   my($self, $who) = @_;
   do_log('debug', 'List::archive_send_last(%s, %s)',$self->{'listname'}, $who);

   return unless ($self->is_archived());
   my $dir = $self->{'dir'}.'/archives' ;

   my $mail = new Message("$dir/last_message",'noxsympato');
   unless (defined $mail) {
       &do_log('err', 'Unable to create Message object %s', "$dir/last_message");
       return undef;
   }
   
   my @msglist;
   my $msg = {};
   $msg->{'id'} = 1;

   $msg->{'subject'} = &tools::decode_header($mail, 'Subject');
   $msg->{'from'} = &tools::decode_header($mail, 'From');
   $msg->{'date'} = &tools::decode_header($mail, 'Date');

   $msg->{'full_msg'} = $mail->{'msg'}->as_string;
   
   push @msglist,$msg;

   my $subject = 'File '.$self->{'name'}.'.last_message' ;
   my $param = {'to' => $who,
		'subject' => $subject,
		'msg_list' => \@msglist } ;


   $param->{'boundary1'} = &tools::get_message_id($self->{'domain'});
   $param->{'boundary2'} = &tools::get_message_id($self->{'domain'});
   $param->{'from'} = &Conf::get_robot_conf($self->{'domain'},'sympa');
   $param->{'auto_submitted'} = 'auto-replied';
#    open TMP2, ">/tmp/digdump"; &tools::dump_var($param, 0, \*TMP2); close TMP2;

   unless ($self->send_file('get_archive',$who,$self->{'domain'},$param)) {
	   &do_log('notice',"Unable to send template 'archive_send' to $who");
	   return undef;
       }

}


#########################   NOTIFICATION SENDING  ######################################


####################################################
# send_notify_to_listmaster                         
####################################################
# Sends a notice to listmaster by parsing
# listmaster_notification.tt2 template
#  
# IN : -$operation (+): notification type
#      -$robot (+): robot
#      -$param(+) : ref(HASH) | ref(ARRAY)
#       values for template parsing
#    
# OUT : 1 | undef
#       
###################################################### 
sub send_notify_to_listmaster {

    my ($operation, $robot, $param) = @_;
    unless ($operation eq 'logs_failed') {
	&do_log('debug2', 'List::send_notify_to_listmaster(%s,%s )', $operation, $robot );
    }

    unless ($operation eq 'logs_failed') {
	unless (defined $operation) {
	    &do_log('err','List::send_notify_to_listmaster(%s) : missing incoming parameter "$operation"');
	    return undef;
	}
	unless (defined $robot) {
	    &do_log('err','List::send_notify_to_listmaster(%s) : missing incoming parameter "$robot"');
	    return undef;
	}
    }
    my $host = &Conf::get_robot_conf($robot, 'host');
    my $listmaster = &Conf::get_robot_conf($robot, 'listmaster');
    my $to = "$Conf::Conf{'listmaster_email'}\@$host";
    my $options = {}; ## options for send_global_file()    

    if ($operation eq 'logs_failed') {
	my $data = {'to' => $to,
		    'type' => $operation,
		    'auto_submitted' => 'auto-generated',
		    'alarm' => 1, # bypass bulk
		};
	
	for my $i(0..$#{$param}) {
	    $data->{"param$i"} = $param->[$i];
	}
	unless (&send_global_file('listmaster_notification', $listmaster, $robot, $data, $options)) {
	    return undef;
	}
	return 1;
    }

    if (ref($param) eq 'HASH') {

	$param->{'to'} = $to;
	$param->{'type'} = $operation;
	$param->{'auto_submitted'} = 'auto-generated';

	## Prepare list-related data
	if ($param->{'list'} && ref($param->{'list'}) eq 'List') {
	  my $list = $param->{'list'};
	  $param->{'list'} = {'name' => $list->{'name'},
			      'host' => $list->{'domain'},
			      'subject' => $list->{'admin'}{'subject'},
			  };
	}

	## Automatic action done on bouncing addresses
	if ($operation eq 'automatic_bounce_management') {
	    my $list = new List ($param->{'listname'}, $robot);
	    unless (defined $list) {
		&do_log('err','Parameter %s is not a valid list', $param->{'listname'});
		return undef;
	    }
	    unless ($list->send_file('listmaster_notification',$listmaster, $robot, $param, $options)) {
		&do_log('notice',"Unable to send template 'listmaster_notification' to $listmaster");
		return undef;
	    }
	    
	}else {		
	    
	    ## No DataBase |  DataBase restored
	    if (($operation eq 'no_db')||($operation eq 'db_restored')) {
		
		$param->{'db_name'} = &Conf::get_robot_conf($robot, 'db_name');  
		$options->{'skip_db'} = 1; ## Skip DB access because DB is not accessible
		
				
	    ## Loop detected in Sympa
	    }elsif ($operation eq 'loop_command') {
		$param->{'boundary'} = '----------=_'.&tools::get_message_id($robot);
		&tt2::allow_absolute_path();
	    }


	    foreach my $email (split (/\,/, $listmaster)) {	
		if (($operation eq 'request_list_creation')or($operation eq 'request_list_renaming')) {
		    $param->{'one_time_ticket'} = &Auth::create_one_time_ticket($email,$robot,'get_pending_lists',$param->{'ip'});
		}
		$param->{'alarm'} = 1;
		unless (&send_global_file('listmaster_notification', $email, $robot, $param, $options)) {
		    &do_log('notice',"Unable to send template 'listmaster_notification' to $listmaster");
		    return undef;
		}
	    }
	}
    
    }elsif(ref($param) eq 'ARRAY') {
	
	my $data = {'to' => $to,
		    'type' => $operation,
		    'auto_submitted' => 'auto-generated',
		    'alarm' => 1
		    };
	for my $i(0..$#{$param}) {
	    $data->{"param$i"} = $param->[$i];
	}
	unless (&send_global_file('listmaster_notification', $listmaster, $robot, $data, $options)) {
	    &do_log('notice',"Unable to send template 'listmaster_notification' to $listmaster");
	    return undef;
	}
    }else {
	&do_log('err','List::send_notify_to_listmaster(%s,%s) : error on incoming parameter "$param", it must be a ref on HASH or a ref on ARRAY', $operation, $robot );
	return undef;
    }
    return 1;
}


####################################################
# send_notify_to_owner                              
####################################################
# Sends a notice to list owner(s) by parsing
# listowner_notification.tt2 template
# 
# IN : -$self (+): ref(List)
#      -$operation (+): notification type
#      -$param(+) : ref(HASH) | ref(ARRAY)
#       values for template parsing
#
# OUT : 1 | undef
#    
######################################################
sub send_notify_to_owner {
    
    my ($self,$operation,$param) = @_;
    &do_log('debug2', 'List::send_notify_to_owner(%s, %s)', $self->{'name'}, $operation);

    my $host = $self->{'admin'}{'host'};
    my @to = $self->get_owners_email();
    my $robot = $self->{'domain'};

    unless (@to) {
	do_log('notice', 'No owner defined or all of them use nomail option in list %s ; using listmasters as default', $self->{'name'} );
	@to = split /,/, &Conf::get_robot_conf($robot, 'listmaster');
    }
    unless (defined $operation) {
	&do_log('err','List::send_notify_to_owner(%s) : missing incoming parameter "$operation"', $self->{'name'});
	return undef;
    }

    if (ref($param) eq 'HASH') {

	$param->{'auto_submitted'} = 'auto-generated';
	$param->{'to'} =join(',', @to);
	$param->{'type'} = $operation;


	if ($operation eq 'warn-signoff') {
	    $param->{'escaped_gecos'} = $param->{'gecos'};
	    $param->{'escaped_gecos'} =~ s/\s/\%20/g;
	    $param->{'escaped_who'} = $param->{'who'};
	    $param->{'escaped_who'} =~ s/\s/\%20/g;
	    foreach my $owner (@to) {
		$param->{'one_time_ticket'} = &Auth::create_one_time_ticket($owner,$robot,'search/'.$self->{'name'}.'/'.$param->{'escaped_who'},$param->{'ip'});
		unless ($self->send_file('listowner_notification',[$owner], $robot,$param)) {
		    &do_log('notice',"Unable to send template 'listowner_notification' to $self->{'name'} list owner $owner");		    
		}
	    }
	}elsif ($operation eq 'subrequest') {
	    $param->{'escaped_gecos'} = $param->{'gecos'};
	    $param->{'escaped_gecos'} =~ s/\s/\%20/g;
	    $param->{'escaped_who'} = $param->{'who'};
	    $param->{'escaped_who'} =~ s/\s/\%20/g;
	    foreach my $owner (@to) {
		$param->{'one_time_ticket'} = &Auth::create_one_time_ticket($owner,$robot,'subindex/'.$self->{'name'},$param->{'ip'});
		unless ($self->send_file('listowner_notification',[$owner], $robot,$param)) {
		    &do_log('notice',"Unable to send template 'listowner_notification' to $self->{'name'} list owner $owner");		    
		}
	    }
	}else{
	    if ($operation eq 'sigrequest') {
		$param->{'escaped_who'} = $param->{'who'};
		$param->{'escaped_who'} =~ s/\s/\%20/g;
		$param->{'sympa'} = &Conf::get_robot_conf($self->{'domain'}, 'sympa');
		
	    }elsif ($operation eq 'bounce_rate') {
		$param->{'rate'} = int ($param->{'rate'} * 10) / 10;
	    }
	    unless ($self->send_file('listowner_notification',\@to, $robot,$param)) {
		&do_log('notice',"Unable to send template 'listowner_notification' to $self->{'name'} list owner");
		return undef;
	    }
	}

    }elsif(ref($param) eq 'ARRAY') {	

	my $data = {'to' => join(',', @to),
		    'type' => $operation};

	for my $i(0..$#{$param}) {
		$data->{"param$i"} = $param->[$i];
 	}
 	unless ($self->send_file('listowner_notification', \@to, $robot, $data)) {
	    &do_log('notice',"Unable to send template 'listowner_notification' to $self->{'name'} list owner");
	    return undef;
	}

    }else {

	&do_log('err','List::send_notify_to_owner(%s,%s) : error on incoming parameter "$param", it must be a ref on HASH or a ref on ARRAY', $self->{'name'},$operation);
	return undef;
    }
    return 1;
}

#########################
## Delete a pictures file
#########################
# remove picture from user $2 in list $1 
#########################
sub delete_user_picture {
    my ($self,$email) = @_;    
    do_log('debug2', 'delete_user_picture(%s)', $email);
    
    my $fullfilename = undef;
    my $filename = &tools::md5_fingerprint($email);
    my $name = $self->{'name'};
    my $robot = $self->{'domain'};
    
    foreach my $ext ('.gif','.jpg','.jpeg','.png') {
  	if(-f &Conf::get_robot_conf($robot,'pictures_path').'/'.$name.'@'.$robot.'/'.$filename.$ext) {
  	    my $file = &Conf::get_robot_conf($robot,'pictures_path').'/'.$name.'@'.$robot.'/'.$filename.$ext;
  	    $fullfilename = $file;
  	    last;
  	} 	
    }
    
    if (defined $fullfilename) {
	unless(unlink($fullfilename)) {
	    do_log('err', 'delete_user_picture() : Failed to delete '.$fullfilename);
	    return undef;  
	}

	do_log('notice', 'delete_user_picture() : File deleted successfull '.$fullfilename);
    }

    return 1;
}


####################################################
# send_notify_to_editor                             
####################################################
# Sends a notice to list editor(s) or owner (if no editor)
# by parsing listeditor_notification.tt2 template
# 
# IN : -$self (+): ref(List)
#      -$operation (+): notification type
#      -$param(+) : ref(HASH) | ref(ARRAY)
#       values for template parsing
#
# OUT : 1 | undef
#    
######################################################
sub send_notify_to_editor {

    my ($self,$operation,$param) = @_;
    &do_log('debug2', 'List::send_notify_to_editor(%s, %s)', $self->{'name'}, $operation);

    my @to = $self->get_editors_email();
    my $robot = $self->{'domain'};
    $param->{'auto_submitted'} = 'auto-generated';
      
      unless (@to) {
	do_log('notice', 'Warning : no editor or owner defined or all of them use nomail option in list %s', $self->{'name'} );
	return undef;
    }
    unless (defined $operation) {
	&do_log('err','List::send_notify_to_editor(%s) : missing incoming parameter "$operation"', $self->{'name'});
	return undef;
    }
    if (ref($param) eq 'HASH') {

	$param->{'to'} =join(',', @to);
	$param->{'type'} = $operation;

	unless ($self->send_file('listeditor_notification',\@to, $robot,$param)) {
	    &do_log('notice',"Unable to send template 'listeditor_notification' to $self->{'name'} list editor");
	    return undef;
	}
	
    }elsif(ref($param) eq 'ARRAY') {	
	
	my $data = {'to' => join(',', @to),
		    'type' => $operation};
	
	foreach my $i(0..$#{$param}) {
	    $data->{"param$i"} = $param->[$i];
 	}
 	unless ($self->send_file('listeditor_notification', \@to, $robot, $data)) {
	    &do_log('notice',"Unable to send template 'listeditor_notification' to $self->{'name'} list editor");
	    return undef;
	}	
	
    }else {
	&do_log('err','List::send_notify_to_editor(%s,%s) : error on incoming parameter "$param", it must be a ref on HASH or a ref on ARRAY', $self->{'name'},$operation);
	return undef;
    }
    return 1;
}


####################################################
# send_notify_to_user                             
####################################################
# Send a notice to a user (sender, subscriber ...)
# by parsing user_notification.tt2 template
# 
# IN : -$self (+): ref(List)
#      -$operation (+): notification type
#      -$user(+): email of notified user
#      -$param(+) : ref(HASH) | ref(ARRAY)
#       values for template parsing
#
# OUT : 1 | undef
#    
######################################################
sub send_notify_to_user{

    my ($self,$operation,$user,$param) = @_;
    &do_log('debug2', 'List::send_notify_to_user(%s, %s, %s)', $self->{'name'}, $operation, $user);

    my $host = $self->{'admin'}->{'host'};
    my $robot = $self->{'domain'};
    $param->{'auto_submitted'} = 'auto-generated';

    unless (defined $operation) {
	&do_log('err','List::send_notify_to_user(%s) : missing incoming parameter "$operation"', $self->{'name'});
	return undef;
    }
    unless ($user) {
	&do_log('err','List::send_notify_to_user(%s) : missing incoming parameter "$user"', $self->{'name'});
	return undef;
    }
    
    if (ref($param) eq "HASH") {
	$param->{'to'} = $user;
	$param->{'type'} = $operation;

	if ($operation eq 'auto_notify_bouncers') {	
	}
	
 	unless ($self->send_file('user_notification',$user,$robot,$param)) {
	    &do_log('notice',"Unable to send template 'user_notification' to $user");
	    return undef;
	}

    }elsif (ref($param) eq "ARRAY") {	
	
	my $data = {'to' => $user,
		    'type' => $operation};
	
	for my $i(0..$#{$param}) {
	    $data->{"param$i"} = $param->[$i];
 	}
 	unless ($self->send_file('user_notification',$user,$robot,$data)) {
	    &do_log('notice',"Unable to send template 'user_notification' to $user");
	    return undef;
	}	
	
    }else {
	
	&do_log('err','List::send_notify_to_user(%s,%s,%s) : error on incoming parameter "$param", it must be a ref on HASH or a ref on ARRAY', 
		$self->{'name'},$operation,$user);
	return undef;
    }
    return 1;
}
#                                                                                       #             
#                                                                                       #  
#                                                                                       #
######################### END functions for sending messages ############################



## genererate a md5 checksum using private cookie and parameters
sub compute_auth {
    do_log('debug3', 'List::compute_auth(%s, %s, %s)', @_);

    my $first_param = shift;
    my ($self, $email, $cmd);
    
    if (ref($first_param) eq 'List') {
	$self = $first_param;
	$email= shift;
    }else {
	$email = $email;
    }
    $cmd = shift;

    $email =~ y/[A-Z]/[a-z]/;
    $cmd =~ y/[A-Z]/[a-z]/;

    my ($cookie, $key, $listname) ;

    if ($self){
	$listname = $self->{'name'};
        $cookie = $self->get_cookie() || $Conf::Conf{'cookie'};
    }else {
	$cookie = $Conf::Conf{'cookie'};
    }
    
    $key = substr(Digest::MD5::md5_hex(join('/', $cookie, $listname, $email, $cmd)), -8) ;

    return $key;
}


## Add footer/header to a message
sub add_parts {
    my $self = shift;
    my $msg = shift;
    Log::do_log('debug3', '(%s, %s, type=%s)',
	$self, $msg, $self->{'admin'}{'footer_type'});

    my $type     = $self->{'admin'}{'footer_type'};
    my $listdir  = $self->{'dir'};
    my $eff_type = $msg->effective_type || 'text/plain';

    ## Signed or encrypted messages won't be modified.
    if ($eff_type =~ /^multipart\/(signed|encrypted)$/i) {
	return $msg;
    }

    my ($header, $headermime);
    foreach my $file (
	"$listdir/message.header",
	"$listdir/message.header.mime",
	$Conf::Conf{'etc'} . '/mail_tt2/message.header',
	$Conf::Conf{'etc'} . '/mail_tt2/message.header.mime'
	) {
	if (-f $file) {
	    unless (-r $file) {
		Log::do_log('notice', 'Cannot read %s', $file);
		next;
	    }
	    $header = $file;
	    last;
	}
    }

    my ($footer, $footermime);
    foreach my $file (
	"$listdir/message.footer",
	"$listdir/message.footer.mime",
	$Conf::Conf{'etc'} . '/mail_tt2/message.footer',
	$Conf::Conf{'etc'} . '/mail_tt2/message.footer.mime'
	) {
	if (-f $file) {
	    unless (-r $file) {
		Log::do_log('notice', 'Cannot read %s', $file);
		next;
	    }
	    $footer = $file;
	    last;
	}
    }

    ## No footer/header
    unless (($footer and -s $footer) or ($header and -s $header)) {
 	return undef;
    }

    if ($type eq 'append') {
	## append footer/header
	my ($footer_msg, $header_msg);
	if ($header and -s $header) {
	    open HEADER, $header;
	    $header_msg = join '', <HEADER>;
	    close HEADER;
	    $header_msg = '' unless $header_msg =~ /\S/;
	}
	if ($footer and -s $footer) {
	    open FOOTER, $footer;
	    $footer_msg = join '', <FOOTER>;
	    close FOOTER;
	    $footer_msg = '' unless $footer_msg =~ /\S/;
	}
	if (length $header_msg or length $footer_msg) {
	    if (_append_parts($msg, $header_msg, $footer_msg)) {
		$msg->sync_headers(Length => 'COMPUTE')
		    if $msg->head->get('Content-Length');
	    }
	}
    } else {
	## MIME footer/header
	my $parser = new MIME::Parser;
	$parser->output_to_core(1);

	if ($eff_type =~ /^multipart\/alternative/i ||
	    $eff_type =~ /^multipart\/related/i) {
	    Log::do_log(
		'debug3', 'Making message %s into multipart/mixed', $msg
	    );
	    $msg->make_multipart("mixed", Force => 1);
	}

	if ($header and -s $header) {
	    if ($header =~ /\.mime$/) {
		my $header_part;
		eval { $header_part = $parser->parse_in($header); };
		if ($@) {
		    Log::do_log('err', 'Failed to parse MIME data %s: %s',
				 $header, $parser->last_error);
		} else {
		    $msg->make_multipart unless $msg->is_multipart;
		    $msg->add_part($header_part, 0); ## Add AS FIRST PART (0)
		}
	    ## text/plain header
	    } else {
		$msg->make_multipart unless $msg->is_multipart;
		my $header_part = build MIME::Entity
		    Path       => $header,
		    Type       => "text/plain",
		    Filename   => undef,
		    'X-Mailer' => undef,
		    Encoding   => "8bit",
		    Charset    => "UTF-8";
		$msg->add_part($header_part, 0);
	    }
	}
	if ($footer and -s $footer) {
	    if ($footer =~ /\.mime$/) {
		my $footer_part;
		eval { $footer_part = $parser->parse_in($footer); };
		if ($@) {
		    Log::do_log('err', 'Failed to parse MIME data %s: %s',
				 $footer, $parser->last_error);
		} else {
		    $msg->make_multipart unless $msg->is_multipart;
		    $msg->add_part($footer_part);
		}
	    ## text/plain footer
	    } else {
		$msg->make_multipart unless $msg->is_multipart;
		$msg->attach(
		    Path       => $footer,
		    Type       => "text/plain",
		    Filename   => undef,
		    'X-Mailer' => undef,
		    Encoding   => "8bit",
		    Charset    => "UTF-8"
		);
	    }
	}
    }

    return $msg;
}

## Append header/footer to text/plain body.
## Note: As some charsets (e.g. UTF-16) are not compatible to US-ASCII,
##   we must concatenate decoded header/body/footer and at last encode it.
## Note: With BASE64 transfer-encoding, newline must be normalized to CRLF,
##   however, original body would be intact.
sub _append_parts {
    my $part = shift;
    my $header_msg = shift || '';
    my $footer_msg = shift || '';

    my $enc = $part->head->mime_encoding;
    # Parts with nonstandard encodings aren't modified.
    if ($enc and $enc !~ /^(?:base64|quoted-printable|[78]bit|binary)$/i) {
       return undef;
    }
    my $eff_type = $part->effective_type || 'text/plain';
    my $body;
    my $io;

    ## Signed or encrypted parts aren't modified.
    if ($eff_type =~ m{^multipart/(signed|encrypted)$}i) {
	return undef;
    }

    ## Skip attached parts.
    my $disposition = $part->head->mime_attr('Content-Disposition');
    return undef
	if $disposition and uc $disposition ne 'INLINE';

    ## Preparing header and footer for inclusion.
    if ($eff_type eq 'text/plain' or $eff_type eq 'text/html') {
	if (length $header_msg or length $footer_msg) {

	    ## Only decodable bodies are allowed.
	    my $bodyh = $part->bodyhandle;
	    if ($bodyh) {
		return undef if $bodyh->is_encoded;
		$body = $bodyh->as_string();
	    } else {
		$body = '';
	    }

	    $body = _append_footer_header_to_part(
		{   'part'     => $part,
		    'header'   => $header_msg,
		    'footer'   => $footer_msg,
		    'eff_type' => $eff_type,
		    'body'     => $body
		}
	    );
	    return undef unless defined $body;

	    $io = $bodyh->open('w');
	    unless (defined $io) {
		Log::do_log('err', 'Failed to save message: %s', "$!");
		return undef;
	    }
	    $io->print($body);
	    $io->close;
	    $part->sync_headers(Length => 'COMPUTE')
		if $part->head->get('Content-Length');

	    return 1;
	}
    } elsif ($eff_type eq 'multipart/mixed') {
	## Append to the first part, since other parts will be "attachments".
	if ($part->parts and
	    _append_parts($part->parts(0), $header_msg, $footer_msg)) {
	    return 1;
	}
    } elsif ($eff_type eq 'multipart/alternative') {
	## We try all the alternatives
	my $r = undef;
	foreach my $p ($part->parts) {
	    $r = 1
		if _append_parts($p, $header_msg, $footer_msg);
	}
	return $r if $r;
    } elsif ($eff_type eq 'multipart/related') {
	## Append to the first part, since other parts will be "attachments".
	if ($part->parts and
	    _append_parts($part->parts(0), $header_msg, $footer_msg)) {
	    return 1;
	}
    }

    ## We couldn't find any parts to modify.
    return undef;
}

# Styles to cancel local CSS.
my $div_style = 'background: transparent; border: none; clear: both; display: block; float: none; position: static';

sub _append_footer_header_to_part {
    my $data       = shift;

    my $part       = $data->{'part'};
    my $header_msg = $data->{'header'};
    my $footer_msg = $data->{'footer'};
    my $eff_type   = $data->{'eff_type'};
    my $body       = $data->{'body'};

    my $cset;

    ## Detect charset.  If charset is unknown, detect 7-bit charset.
    my $charset = $part->head->mime_attr('Content-Type.Charset');
    $cset = MIME::Charset->new($charset || 'NONE');
    unless ($cset->decoder) {
	# n.b. detect_7bit_charset() in MIME::Charset prior to 1.009.2 doesn't
	# work correctly.
	my ($dummy, $charset) =
	    MIME::Charset::body_encode($body, '', Detect7Bit => 'YES');
	$cset = MIME::Charset->new($charset)
	    if $charset;
    }
    unless ($cset->decoder) {
	#Log::do_log('err', 'Unknown charset "%s"', $charset);
	return undef;
    }

    ## Decode body to Unicode, since encode_entities() and newline
    ## normalization will break texts with several character sets (UTF-16/32,
    ## ISO-2022-JP, ...).
    eval {
	$body = $cset->decode($body, 1);
	$header_msg = Encode::decode_utf8($header_msg, 1);
	$footer_msg = Encode::decode_utf8($footer_msg, 1);
    };
    return undef if $@;

    my $new_body;
    if ($eff_type eq 'text/plain') {
	Log::do_log('debug3', "Treating text/plain part");

	## Add newlines. For BASE64 encoding they also must be normalized.
	if (length $header_msg) {
	    $header_msg .= "\n" unless $header_msg =~ /\n\z/;
	}
	if (length $footer_msg and length $body) {
	    $body .= "\n" unless $body =~ /\n\z/;
	}
	if (uc($part->head->mime_attr(
	    'Content-Transfer-Encoding') || '') eq 'BASE64') {
	    $header_msg =~ s/\r\n|\r|\n/\r\n/g;
	    $body =~ s/(\r\n|\r|\n)\z/\r\n/;       # only at end
	    $footer_msg =~ s/\r\n|\r|\n/\r\n/g;
	}

	$new_body = $header_msg . $body . $footer_msg;
    } elsif ($eff_type eq 'text/html') {
	Log::do_log('debug3', "Treating text/html part");

	# Escape special characters.
	$header_msg = encode_entities($header_msg, '<>&"');
	$header_msg =~ s/(\r\n|\r|\n)$//; # strip the last newline.
	$header_msg =~ s,(\r\n|\r|\n),<br/>,g;
	$footer_msg = encode_entities($footer_msg, '<>&"');
	$footer_msg =~ s/(\r\n|\r|\n)$//; # strip the last newline.
	$footer_msg =~ s,(\r\n|\r|\n),<br/>,g;

	my @bodydata = split '</body>', $body;
	if (length $header_msg) {
	    $new_body = sprintf '<div style="%s">%s</div>',
		$div_style, $header_msg;
	} else {
	    $new_body = '';
	}
	my $i = -1;
	foreach my $html_body_bit (@bodydata) {
	    $new_body .= $html_body_bit;
	    $i++;
	    if ($i == $#bodydata and length $footer_msg) {
		$new_body .= sprintf '<div style="%s">%s</div></body>',
		    $div_style, $footer_msg;
	    } else {
		$new_body .= '</body>';
	    }
	}
    }

    ## Only encodable footer/header are allowed.
    eval {
	$new_body = $cset->encode($new_body, 1);
    };
    return undef if $@;

    return $new_body;
}

## Delete a new user to Database (in User table)
sub delete_user_db {
    my @users = @_;
    
    do_log('debug2', 'List::delete_user_db');
    
    return undef unless ($#users >= 0);
    
    unless ($List::use_db) {
	&do_log('info', 'Sympa not setup to use DBI');
	return undef;
    }
    
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }	   
    foreach my $who (@users) {
	my $statement;
	
	$who = &tools::clean_email($who);
	
	## Update field
	$statement = sprintf "DELETE FROM user_table WHERE (email_user =%s)", $dbh->quote($who); 
	
	unless ($dbh->do($statement)) {
	    do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	    next;
	}
    }

    return $#users + 1;
}

## Delete the indicate users from the list.
## IN : - ref to array 
##      - option exclude
##
## $list->delete_user('users' => \@u, 'exclude' => 1)
## $list->delete_user('users' => [$email], 'exclude' => 1)
sub delete_user {
    my $self = shift;
    my %param = @_;
    my @u = @{$param{'users'}};
    my $exclude = $param{'exclude'};
    &do_log('debug2', 'List::delete_user');

    my $name = $self->{'name'};
    my $total = 0;

    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }
    
    foreach my $who (@u) {
	$who = &tools::clean_email($who);

	my $statement;
	## Include in exclusion_table only if option is set.
	if($exclude == 1){
	    ## Insert in exclusion_table if $user->{'included'} eq '1'
	    &insert_delete_exclusion($who, $name, $self->{'domain'}, 'insert');
	    
	}

	$list_cache{'is_user'}{$self->{'domain'}}{$name}{$who} = undef;    
	$list_cache{'get_subscriber'}{$self->{'domain'}}{$name}{$who} = undef;    
	
	## Delete record in SUBSCRIBER
	$statement = sprintf "DELETE FROM subscriber_table WHERE (user_subscriber=%s AND list_subscriber=%s AND robot_subscriber=%s)",
	$dbh->quote($who), 
	$dbh->quote($name), 
	$dbh->quote($self->{'domain'});
	
	
	unless ($dbh->do($statement)) {
	    do_log('err','Unable to execute SQL statement %s : %s', $statement, $dbh->errstr);
	    next;
	}   
	
	$total--;
    }

    $self->{'total'} += $total;
    $self->savestats();
    &delete_user_picture($self,shift(@u));
    return (-1 * $total);
}


## Delete the indicated admin users from the list.
sub delete_admin_user {
    my($self, $role, @u) = @_;
    do_log('debug2', 'List::delete_admin_user(%s)', $role); 

    my $name = $self->{'name'};
    my $total = 0;
    
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }
	    
    foreach my $who (@u) {
	$who = &tools::clean_email($who);
	my $statement;
	
	$list_cache{'is_admin_user'}{$self->{'domain'}}{$name}{$who} = undef;    
	    
	## Delete record in ADMIN
	$statement = sprintf "DELETE FROM admin_table WHERE (user_admin=%s AND list_admin=%s AND robot_admin=%s AND role_admin=%s)",
	$dbh->quote($who), 
	$dbh->quote($name),
	$dbh->quote($self->{'domain'}),
	$dbh->quote($role);
	
	unless ($dbh->do($statement)) {
	    do_log('err','Unable to execute SQL statement %s : %s', $statement, $dbh->errstr);
	    next;
	}   
	
	$total--;
    }
    
    return (-1 * $total);
}

## Delete all admin_table entries
sub delete_admin_all {
    &do_log('debug2', 'List::delete_admin_all()'); 
	    
    my $total = 0;
    
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }
    
    my $statement;
    
    ## Delete record in ADMIN
    $statement = sprintf "DELETE FROM admin_table";
    
    unless ($dbh->do($statement)) {
	do_log('err','Unable to execute SQL statement %s : %s', $statement, $dbh->errstr);
	return undef;
    }   
    
    return 1;
}


## Returns the cookie for a list, if any.
sub get_cookie {
   return shift->{'admin'}{'cookie'};
}

## Returns the maximum size allowed for a message to the list.
sub get_max_size {
   return shift->{'admin'}{'max_size'};
}

## Returns an array with the Reply-To data
sub get_reply_to {
    my $admin = shift->{'admin'};

    my $value = $admin->{'reply_to_header'}{'value'};

    $value = $admin->{'reply_to_header'}{'other_email'} if ($value eq 'other_email');

    return $value
}

## Returns a default user option
sub get_default_user_options {
    my $self = shift->{'admin'};
    my $what = shift;
    do_log('debug3', 'List::get_default_user_options(%s)', $what);

    if ($self) {
	return $self->{'default_user_options'};
    }
    return undef;
}

## Returns the number of subscribers to the list
sub get_total {
    my $self = shift;
    my $name = $self->{'name'};
    my $option = shift;
    &do_log('debug3','List::get_total(%s)', $name);

    if ($option eq 'nocache') {
	$self->{'total'} = $self->_load_total_db($option);
    }
    
    return $self->{'total'};
}

## Returns a hash for a given user
sub get_user_db {
    my $who = &tools::clean_email(shift);
    do_log('debug2', 'List::get_user_db(%s)', $who);

    my $statement;
 
    unless ($List::use_db) {
	&do_log('info', 'Sympa not setup to use DBI');
	return undef;
    }

    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }

    ## Additional subscriber fields
    my $additional;
    if ($Conf::Conf{'db_additional_user_fields'}) {
	$additional = ',' . $Conf::Conf{'db_additional_user_fields'};
    }

    $statement = sprintf "SELECT email_user AS email, gecos_user AS gecos, password_user AS password, cookie_delay_user AS cookie_delay, lang_user AS lang %s, attributes_user AS attributes, data_user AS data, last_login_date_user AS last_login_date, wrong_login_count_user AS wrong_login_count, last_login_host_user AS last_login_host FROM user_table WHERE email_user = %s ", $additional, $dbh->quote($who);
    
    push @sth_stack, $sth;

    unless ($sth = $dbh->prepare($statement)) {
	do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
	return undef;
    }
    
    unless ($sth->execute) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }
    
    my $user = $sth->fetchrow_hashref('NAME_lc');
 
    $sth->finish();

    $sth = pop @sth_stack;

    if (defined $user) {
	## decrypt password
	if ($user->{'password'}) {
	    $user->{'password'} = &tools::decrypt_password($user->{'password'});
	}

	## Turn user_attributes into a hash
	my $attributes = $user->{'attributes'};
	$user->{'attributes'} = undef;
	foreach my $attr (split (/__ATT_SEP__/, $attributes)) {
	    my ($key, $value) = split (/__PAIRS_SEP__/, $attr);
	    $user->{'attributes'}{$key} = $value;
	}    
	## Turn data_user into a hash
	 if ($user->{'data'}) {
	     my %prefs = &tools::string_2_hash($user->{'data'});
	     $user->{'prefs'} = \%prefs;
	 }
    }

    return $user;
}

## Returns an array of all users in User table hash for a given user
sub get_all_user_db {
    do_log('debug2', 'List::get_all_user_db()');

    my $statement;
    my @users;
 
    unless ($List::use_db) {
	&do_log('info', 'Sympa not setup to use DBI');
	return undef;
    }

    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }

    $statement = sprintf "SELECT email_user FROM user_table";
    
    push @sth_stack, $sth;

    unless ($sth = $dbh->prepare($statement)) {
	do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
	return undef;
    }
    
    unless ($sth->execute) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }
    
    while (my $email = ($sth->fetchrow_array)[0]) {
	push @users, $email;
    }
 
    $sth->finish();

    $sth = pop @sth_stack;

    return @users;
}

######################################################################
###  suspend_subscription                                            #
## Suspend an user from list(s)                                      #
######################################################################
# IN:                                                                #
#   - email : the subscriber email                                   #
#   - list : the name of the list                                    #
#   - data : start_date and end_date                                 #
#   - robot : domain                                                 #
# OUT:                                                               #
#   - undef if something went wrong.                                 #
#   - 1 if user is suspended from the list                           #
######################################################################
sub suspend_subscription {
    
    my $email = shift;
    my $list = shift;
    my $data = shift;
    my $robot = shift;
    &do_log('debug2', 'List::suspend_subscription("%s", "%s", "%s" )', $email, $list, $data);

    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }

    my $statement = sprintf "UPDATE subscriber_table SET suspend_subscriber='1', suspend_start_date_subscriber=%s, suspend_end_date_subscriber=%s WHERE (user_subscriber=%s AND list_subscriber=%s AND robot_subscriber = %s )", 
    $dbh->quote($data->{'startdate'}), 
    $dbh->quote($data->{'enddate'}), 
    $dbh->quote($email), 
    $dbh->quote($list),
    $dbh->quote($robot);

    unless ($dbh->do($statement)) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }
    
    return 1;
}

######################################################################
###  restore_suspended_subscription                                  #
## Restore the subscription of an user from list(s)                  #
######################################################################
# IN:                                                                #
#   - email : the subscriber email                                   #
#   - list : the name of the list                                    #
#   - robot : domain                                                 #
# OUT:                                                               #
#   - undef if something went wrong.                                 #
#   - 1 if his/her subscription is restored                          #
######################################################################
sub restore_suspended_subscription {

    my $email = shift;
    my $list = shift;
    my $robot = shift;
    &do_log('debug2', 'List::restore_suspended_subscription("%s", "%s", "%s")', $email, $list, $robot);
    
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }
    ## Update field
    my $statement = sprintf "UPDATE subscriber_table SET suspend_subscriber='0', suspend_start_date_subscriber=NULL, suspend_end_date_subscriber=NULL WHERE (user_subscriber=%s AND list_subscriber=%s AND robot_subscriber = %s )",  
    $dbh->quote($email), 
    $dbh->quote($list),
    $dbh->quote($robot);

    unless ($dbh->do($statement)) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }
    
    return 1;
}

######################################################################
###  insert_delete_exclusion                                         #
## Update the exclusion_table                                        #
######################################################################
# IN:                                                                #
#   - email : the subscriber email                                   #
#   - list : the name of the list                                    #
#   - robot : the name of the domain                                 #
#   - action : insert or delete                                      #
# OUT:                                                               #
#   - undef if something went wrong.                                 #
#   - 1                                                              #
######################################################################
sub insert_delete_exclusion {

    my $email = shift;
    my $list = shift;
    my $robot = shift;
    my $action = shift;
    my $family = shift;
    &do_log('info', 'List::insert_delete_exclusion("%s", "%s", "%s", "%s", "%s")', $email, $list, $robot, $action, $family);
    
	my $r = 1;
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }
    
    my $statement;
    if($action eq 'insert'){
	## INSERT only if $user->{'included'} eq '1'

	my $options;
	$options->{'email'} = $email;
	$options->{'name'} = $list;
	$options->{'domain'} = $robot;
	my $user = &get_subscriber_no_object($options);
	my $date = time;

	if ($user->{'included'} eq '1' or defined $family) {
	    ## Insert : family or list, user and date
	    if (defined $family) {
		$statement = sprintf "INSERT INTO exclusion_table (list_exclusion, family_exclusion, robot_exclusion, user_exclusion, date_exclusion) VALUES (%s, %s, %s, %s, %s)", $dbh->quote($list), $dbh->quote($family), $dbh->quote($robot), $dbh->quote($email), $dbh->quote($date);
	    }else{
		$statement = sprintf "INSERT INTO exclusion_table (list_exclusion, robot_exclusion, user_exclusion, date_exclusion) VALUES (%s, %s, %s, %s)", $dbh->quote($list), $dbh->quote($robot), $dbh->quote($email), $dbh->quote($date);
	    }
	    
	    unless ($dbh->do($statement)) {
		&do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
		return undef;
	    }
	}
	
    }elsif($action eq 'delete') {
	## If $email is in exclusion_table, delete it.
	my $data_excluded = &get_exclusion($list,$robot);
	my @users_excluded;

	my $key =0;
	while ($data_excluded->{'emails'}->[$key]){
	    push @users_excluded, $data_excluded->{'emails'}->[$key];
	    $key = $key + 1;
	}
	
	$r = 0;
	foreach my $users (@users_excluded) {
	    if($email eq $users){
		## Delete : list, user and date
		if (defined $family) {
		    $statement = sprintf "DELETE FROM exclusion_table WHERE (family_exclusion = %s AND robot_exclusion = %s AND user_exclusion = %s)",	$dbh->quote($family), $dbh->quote($robot), $dbh->quote($email);
		}else{
		    $statement = sprintf "DELETE FROM exclusion_table WHERE (list_exclusion = %s AND robot_exclusion = %s AND user_exclusion = %s)",	$dbh->quote($list), $dbh->quote($robot), $dbh->quote($email);
		}

		unless ($r = $dbh->do($statement)) {
		    &do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
		    return undef;
		}
	    }
	}

    }else{
	&do_log('err','Unknown action %s',$action);
	return undef;
    }
    return $r;
}

######################################################################
###  get_exclusion                                                   #
## Returns a hash with those excluded from the list and the date.    #
##                                                                   # 
# IN:  - name : the name of the list                                 #
# OUT: - data_exclu : * %data_exclu->{'emails'}->[]                  #
#                     * %data_exclu->{'date'}->[]                    # 
######################################################################
sub get_exclusion {
    
    my  $name= shift;
    my  $robot= shift;
    &do_log('debug2', 'List::get_exclusion(%s@%s)', $name,$robot);
    
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }

    my $list = new List($name, $robot);
    unless (defined $list) {
	&Log::do_log('err','List %s@%s does not exist', $name,$robot);
	return undef;
    }
    ## the query return the email and the date in a hash
    my $statement;
    if (defined $list->{'admin'}{'family_name'} && $list->{'admin'}{'family_name'} ne '') {
	$statement = sprintf "SELECT user_exclusion AS email, date_exclusion AS date FROM exclusion_table WHERE (list_exclusion = %s OR family_exclusion = %s) AND robot_exclusion=%s", 
	$dbh->quote($name),$dbh->quote($list->{'admin'}{'family_name'}),$dbh->quote($robot);
    }else{
	$statement = sprintf "SELECT user_exclusion AS email, date_exclusion AS date FROM exclusion_table WHERE list_exclusion = %s AND robot_exclusion=%s", 
	$dbh->quote($name),$dbh->quote($robot);
    }
 
    push @sth_stack, $sth;
    unless ($sth = $dbh->prepare($statement)) {
	&do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
	return undef;
    }
    unless ($sth->execute) {
	&do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }

    my @users;
    my @date;
    my $data;
    while ($data = $sth->fetchrow_hashref){
	push @users, $data->{'email'};
	push @date, $data->{'date'};
    }
    ## in order to use the data, we add the emails and dates in differents array
    my $data_exclu = {"emails" => \@users,
		      "date"   => \@date
		      };
    
    $sth->finish();
    $sth = pop @sth_stack;
   
    unless($data_exclu){
	&do_log('err','Unable to retrieve information from database for list %s@%s', $name,$robot);
	return undef;
    }
    return $data_exclu;
}

######################################################################
###  get_subscriber                                                  #
## Returns a subscriber of the list.                                 #
######################################################################
sub get_subscriber {
    my  $self= shift;
    my  $email = &tools::clean_email(shift);
    
    do_log('debug2', 'List::get_subscriber(%s)', $email);

    my $name = $self->{'name'};
    my $statement;
    my $date_field = sprintf $date_format{'read'}{$Conf::Conf{'db_type'}}, 'date_subscriber', 'date_subscriber';
    my $update_field = sprintf $date_format{'read'}{$Conf::Conf{'db_type'}}, 'update_subscriber', 'update_subscriber';	
    
    ## Use session cache
    if (defined $list_cache{'get_subscriber'}{$self->{'domain'}}{$self->{'name'}}{$email}) {
	return $list_cache{'get_subscriber'}{$self->{'domain'}}{$self->{'name'}}{$email};
    }

    my $options;
    $options->{'email'} = $email;
    $options->{'name'} = $self->{'name'};
    $options->{'domain'} = $self->{'domain'};

    my $user = &get_subscriber_no_object($options);

    unless($user){
	##do_log('err','Unable to retrieve information from database for user %s', $email);
	return undef;
    }
    $user->{'reception'} = $self->{'admin'}{'default_user_options'}{'reception'}
    unless ($self->is_available_reception_mode($user->{'reception'}));

    ## Set session cache
    $list_cache{'get_subscriber'}{$self->{'domain'}}{$self->{'name'}}{$email} = $user;

    return $user;
}

#######################################################################
# IN
#   - a single reference to a hash with the following keys:          #
#     * email : the subscriber email                                 #
#     * name: the name of the list                                   #
#     * domain: the virtual host under which the list is installed.  #
#
# OUT : undef if something wrong
#       a hash of tab of ressembling emails
sub get_ressembling_subscribers_no_object {
    my $options = shift;
    &do_log('debug2', 'List::get_ressembling_subscribers_no_object(%s, %s, %s)', $options->{'name'}, $options->{'email'}, $options->{'domain'});
    my $name = $options->{'name'};
    my @output;


    
    my $email = &tools::clean_email($options->{'email'});
    my $robot = $options->{'domain'};
    my $listname = $options->{'name'};
    
    
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }
    my $date_field = sprintf $date_format{'read'}{$Conf::Conf{'db_type'}}, 'date_subscriber', 'date_subscriber';
    my $update_field = sprintf $date_format{'read'}{$Conf::Conf{'db_type'}}, 'update_subscriber', 'update_subscriber';	

    $email =~ /^(.*)\@(.*)$/;
    my $local_part = $1;
    my $subscriber_domain = $2;
    my %subscribers_email;



    ##### plused
    # is subscriber a plused email ?
    if ($local_part =~ /^(.*)\+(.*)$/) {

	foreach my $subscriber (&find_subscriber_by_pattern_no_object({'email_pattern' => $1.'@'.$subscriber_domain,'name'=>$listname,'domain'=>$robot})){
	    next if ($subscribers_email{$subscriber->{'email'}});
	    $subscribers_email{$subscriber->{'email'}} = 1;
	    push @output,$subscriber;
	}			       
    }
    # is some subscriber ressembling with a plused email ?    
    foreach my $subscriber (&find_subscriber_by_pattern_no_object({'email_pattern' => $local_part.'+%@'.$subscriber_domain,'name'=>$listname,'domain'=>$robot})){
    	next if ($subscribers_email{$subscriber->{'email'}});
       $subscribers_email{ $subscriber->{'email'} } = 1;
    	push @output,$subscriber;
    }		

    # ressembling local part    
    # try to compare firstname.name@domain with name@domain
        foreach my $subscriber (&find_subscriber_by_pattern_no_object({'email_pattern' => '%'.$local_part.'@'.$subscriber_domain,'name'=>$listname,'domain'=>$robot})){
    	next if ($subscribers_email{$subscriber->{'email'}});
    	$subscribers_email{ $subscriber->{'email'} } = 1;
    	push @output,$subscriber;
    }
    
    if ($local_part =~ /^(.*)\.(.*)$/) {
	foreach my $subscriber (&find_subscriber_by_pattern_no_object({'email_pattern' => $2.'@'.$subscriber_domain,'name'=>$listname,'domain'=>$robot})){
	    next if ($subscribers_email{$subscriber->{'email'}});
	    $subscribers_email{ $subscriber->{'email'} } = 1;
	    push @output,$subscriber;
	}
    }

    #### Same local_part and ressembling domain
    #
    # compare host.domain.tld with domain.tld
    if ($subscriber_domain =~ /^[^\.]\.(.*)$/) {
	my $upperdomain = $1;
	if ($upperdomain =~ /\./) {
            # remove first token if there is still at least 2 tokens try to find a subscriber with that domain
	    foreach my $subscriber (&find_subscriber_by_pattern_no_object({'email_pattern' => $local_part.'@'.$upperdomain,'name'=>$listname,'domain'=>$robot})){
	    	next if ($subscribers_email{$subscriber->{'email'}});
	    	$subscribers_email{ $subscriber->{'email'} } = 1;
	    	push @output,$subscriber;
	    }
	}
    }
    foreach my $subscriber (&find_subscriber_by_pattern_no_object({'email_pattern' => $local_part.'@%'.$subscriber_domain,'name'=>$listname,'domain'=>$robot})){
    	next if ($subscribers_email{$subscriber->{'email'}});
    	$subscribers_email{ $subscriber->{'email'} } = 1;
    	push @output,$subscriber;
    }

    # looking for initial
    if ($local_part =~ /^(.*)\.(.*)$/) {
	my $givenname = $1;
	my $name= $2;
	my $initial = '';
	if ($givenname =~ /^([a-z])/){
	    $initial = $1;
	}
	if ($name =~ /^([a-z])/){
	    $initial = $initial.$1;
	}
	foreach my $subscriber (&find_subscriber_by_pattern_no_object({'email_pattern' => $initial.'@'.$subscriber_domain,'name'=>$listname,'domain'=>$robot})){
	    next if ($subscribers_email{$subscriber->{'email'}});
	    $subscribers_email{ $subscriber->{'email'} } = 1;
	    push @output,$subscriber;
	}
    }
    


    #### users in the same local part in any other domain
    #
    foreach my $subscriber (&find_subscriber_by_pattern_no_object({'email_pattern' => $local_part.'@%','name'=>$listname,'domain'=>$robot})){
	next if ($subscribers_email{$subscriber->{'email'}});
	$subscribers_email{ $subscriber->{'email'} } = 1;
	push @output,$subscriber;
    }

    return \@output;


}


######################################################################
###  find_subscriber_by_pattern_no_object                            #
## Get details regarding a subscriber.                               #
# IN:                                                                #
#   - a single reference to a hash with the following keys:          #
#     * email pattern : the subscriber email patern looking for      #
#     * name: the name of the list                                   #
#     * domain: the virtual host under which the list is installed.  #
# OUT:                                                               #
#   - undef if something went wrong.                                 #
#   - a hash containing the user details otherwise                   #
######################################################################

sub find_subscriber_by_pattern_no_object {
    my $options = shift;

    my $name = $options->{'name'};
    
    my $email_pattern = &tools::clean_email($options->{'email_pattern'});
    my $statement;
    my $date_field = sprintf $date_format{'read'}{$Conf::Conf{'db_type'}}, 'date_subscriber', 'date_subscriber';
    my $update_field = sprintf $date_format{'read'}{$Conf::Conf{'db_type'}}, 'update_subscriber', 'update_subscriber';	
    
    my @ressembling_users;

    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }
    ## Additional subscriber fields
    my $additional;
    if ($Conf::Conf{'db_additional_subscriber_fields'}) {
	$additional = ',' . $Conf::Conf{'db_additional_subscriber_fields'};
    }
    $statement = sprintf "SELECT user_subscriber AS email, comment_subscriber AS gecos, bounce_subscriber AS bounce, bounce_score_subscriber AS bounce_score, bounce_address_subscriber AS bounce_address, reception_subscriber AS reception,  topics_subscriber AS topics, visibility_subscriber AS visibility, %s AS \"date\", %s AS update_date, subscribed_subscriber AS subscribed, included_subscriber AS included, include_sources_subscriber AS id, custom_attribute_subscriber AS custom_attribute, suspend_subscriber AS suspend, suspend_start_date_subscriber AS startdate, suspend_end_date_subscriber AS enddate %s FROM subscriber_table WHERE (user_subscriber LIKE %s AND list_subscriber = %s AND robot_subscriber = %s)", 
    $date_field, 
    $update_field, 
    $additional, 
    $dbh->quote($email_pattern), 
    $dbh->quote($name),
    $dbh->quote($options->{'domain'});
#    $statement = sprintf "SELECT user_subscriber AS email FROM subscriber_table WHERE (user_subscriber LIKE %s AND list_subscriber = %s AND robot_subscriber = %s)",     
#    $dbh->quote($email_pattern), 
#    $dbh->quote($name),
#    $dbh->quote($options->{'domain'});


    push @sth_stack, $sth;
    unless ($sth = $dbh->prepare($statement)) {
	do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
	return undef;
    }
    unless ($sth->execute) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }
    
    while (my $user = $sth->fetchrow_hashref('NAME_lc')){
	if (defined $user) {
	    
	    $user->{'reception'} ||= 'mail';
	    $user->{'escaped_email'} = &tools::escape_chars($user->{'email'});
	    $user->{'update_date'} ||= $user->{'date'};
	    if (defined $user->{custom_attribute}) {
		my %custom_attr = &parseCustomAttribute($user->{'custom_attribute'});
		$user->{'custom_attribute'} = \%custom_attr ;
		my @k = sort keys %custom_attr ;
	    }
	push @ressembling_users, $user;
	}
    }
    $sth->finish();
    
    $sth = pop @sth_stack;
    ## Set session cache

    return @ressembling_users;
}

######################################################################
###  get_subscriber_no_object                                        #
## Get details regarding a subscriber.                               #
# IN:                                                                #
#   - a single reference to a hash with the following keys:          #
#     * email : the subscriber email                                 #
#     * name: the name of the list                                   #
#     * domain: the virtual host under which the list is installed.  #
# OUT:                                                               #
#   - undef if something went wrong.                                 #
#   - a hash containing the user details otherwise                   #
######################################################################

sub get_subscriber_no_object {
    my $options = shift;
    &do_log('debug2', 'List::get_subscriber_no_object(%s, %s, %s)', $options->{'name'}, $options->{'email'}, $options->{'domain'});

    my $name = $options->{'name'};
    
    my $email = &tools::clean_email($options->{'email'});
    my $statement;
    my $date_field = sprintf $date_format{'read'}{$Conf::Conf{'db_type'}}, 'date_subscriber', 'date_subscriber';
    my $update_field = sprintf $date_format{'read'}{$Conf::Conf{'db_type'}}, 'update_subscriber', 'update_subscriber';	
    
    ## Use session cache
    if (defined $list_cache{'get_subscriber'}{$options->{'domain'}}{$name}{$email}) {
	return $list_cache{'get_subscriber'}{$options->{'domain'}}{$name}{$email};
    }

    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }
    ## Additional subscriber fields
    my $additional;
    if ($Conf::Conf{'db_additional_subscriber_fields'}) {
	$additional = ',' . $Conf::Conf{'db_additional_subscriber_fields'};
    }
    $statement = sprintf "SELECT user_subscriber AS email, comment_subscriber AS gecos, bounce_subscriber AS bounce, bounce_score_subscriber AS bounce_score, bounce_address_subscriber AS bounce_address, reception_subscriber AS reception,  topics_subscriber AS topics, visibility_subscriber AS visibility, %s AS \"date\", %s AS update_date, subscribed_subscriber AS subscribed, included_subscriber AS included, include_sources_subscriber AS id, custom_attribute_subscriber AS custom_attribute, suspend_subscriber AS suspend, suspend_start_date_subscriber AS startdate, suspend_end_date_subscriber AS enddate %s FROM subscriber_table WHERE (user_subscriber = %s AND list_subscriber = %s AND robot_subscriber = %s)", 
    $date_field, 
    $update_field, 
    $additional, 
    $dbh->quote($email), 
    $dbh->quote($name),
    $dbh->quote($options->{'domain'});
    
    push @sth_stack, $sth;
    unless ($sth = $dbh->prepare($statement)) {
	do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
	return undef;
    }
    unless ($sth->execute) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }
    my $user = $sth->fetchrow_hashref('NAME_lc');
    if (defined $user) {
	
	$user->{'reception'} ||= 'mail';
	$user->{'update_date'} ||= $user->{'date'};
	do_log('debug2', 'custom_attribute  = (%s)', $user->{custom_attribute});
	if (defined $user->{custom_attribute}) {
	    do_log('debug2', '1. custom_attribute  = (%s)', $user->{custom_attribute});
	    my %custom_attr = &parseCustomAttribute($user->{'custom_attribute'});
	    $user->{'custom_attribute'} = \%custom_attr ;
	    do_log('debug2', '2. custom_attribute  = (%s)', %custom_attr);
	    do_log('debug2', '3. custom_attribute  = (%s)', $user->{custom_attribute});
	    my @k = sort keys %custom_attr ;
	    do_log('debug2', "keys custom_attribute  = @k");
	}

    }
 
    $sth->finish();

    $sth = pop @sth_stack;
    ## Set session cache
    $list_cache{'get_subscriber'}{$options->{'domain'}}{$name}{$email} = $user;
    return $user;
}

## Returns an array of all users in User table hash for a given user
sub get_subscriber_by_bounce_address {

    my  $self= shift;
    my  $bounce_address = &tools::clean_email(shift);
    
    do_log('debug2', 'List::get_subscriber_by_bounce_address (%s)', $bounce_address);

    return undef unless $bounce_address;

    my $statement;
    my @users;
    my @subscribers;
 
    unless ($List::use_db) {
	&do_log('info', 'Sympa not setup to use DBI');
	return undef;
    }

    my $listname = $self->{'name'};
    my $robot = $self->{'domain'};

    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }

    $statement = sprintf "SELECT user_subscriber AS email, bounce_address_subscriber AS bounce_address FROM subscriber_table WHERE (list_subscriber=%s AND robot_subscriber=%s AND bounce_address_subscriber LIKE %s",$dbh->quote($listname),$dbh->quote($robot),$dbh->quote($bounce_address);
    
    push @sth_stack, $sth;

    unless ($sth = $dbh->prepare($statement)) {
	do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
	return undef;
    }
    unless ($sth->execute) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }
    while (my $subscriber = $sth->fetchrow_hashref('NAME_lc')) {
	push @subscribers, $subscriber;
    }
    $sth->finish();
    $sth = pop @sth_stack;
    return @subscribers;
}


## Returns an admin user of the list.
sub get_admin_user {
    my  $self= shift;
    my  $role= shift;
    my  $email = &tools::clean_email(shift);
    
    do_log('debug2', 'List::get_admin_user(%s,%s)', $role,$email); 

    my $name = $self->{'name'};
    my $statement;
    my $date_field = sprintf $date_format{'read'}{$Conf::Conf{'db_type'}}, 'date_admin', 'date_admin';
    my $update_field = sprintf $date_format{'read'}{$Conf::Conf{'db_type'}}, 'update_admin', 'update_admin';	

    ## Use session cache
    if (defined $list_cache{'get_admin_user'}{$self->{'domain'}}{$name}{$role}{$email}) {
	return $list_cache{'get_admin_user'}{$self->{'domain'}}{$name}{$role}{$email};
    }

    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }

    $statement = sprintf "SELECT user_admin AS email, comment_admin AS gecos, reception_admin AS reception, visibility_admin AS visibility, %s AS \"date\", %s AS update_date, info_admin AS info, profile_admin AS profile, subscribed_admin AS subscribed, included_admin AS included, include_sources_admin AS id FROM admin_table WHERE (user_admin = %s AND list_admin = %s AND robot_admin = %s AND role_admin = %s)", 
      $date_field, 
	$update_field, 
	  $dbh->quote($email), 
	    $dbh->quote($name), 
	      $dbh->quote($self->{'domain'}),
		$dbh->quote($role);
    
    push @sth_stack, $sth;

    unless ($sth = $dbh->prepare($statement)) {
	do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
	return undef;
    }
    
    unless ($sth->execute) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }
    
    my $admin_user = $sth->fetchrow_hashref('NAME_lc');

    if (defined $admin_user) {
	$admin_user->{'reception'} ||= 'mail';
	$admin_user->{'update_date'} ||= $admin_user->{'date'};
    }
    
    $sth->finish();
    
    $sth = pop @sth_stack;
    
    ## Set session cache
    $list_cache{'get_admin_user'}{$self->{'domain'}}{$name}{$role}{$email} = $admin_user;
    
    return $admin_user;
    
}


## Returns the first user for the list.
sub get_first_user {
    my ($self, $data) = @_;

    my ($sortby, $offset, $rows, $sql_regexp);
    $sortby = $data->{'sortby'};
    ## Sort may be domain, email, date
    $sortby ||= 'domain';
    $offset = $data->{'offset'};
    $rows = $data->{'rows'};
    $sql_regexp = $data->{'sql_regexp'};
    
    my $lock = new Lock ($self->{'dir'}.'/include');
    unless (defined $lock) {
	&do_log('err','Could not create new lock');
	return undef;
    }
    $lock->set_timeout(10*60); 

    do_log('debug2', '(%s, %s, %s, %s)',
	$self->{'name'}, $sortby, $offset, $rows);
        
    ## Get an Shared lock	    
    unless ($lock->lock('read')) {
	return undef;
    }
    
    my $name = $self->{'name'};
    my $statement;
    my $date_field = sprintf $date_format{'read'}{$Conf::Conf{'db_type'}}, 'date_subscriber', 'date_subscriber';
    my $update_field = sprintf $date_format{'read'}{$Conf::Conf{'db_type'}}, 'update_subscriber', 'update_subscriber';
    
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }
    
    ## SQL regexp
    my $selection;
    if ($sql_regexp) {
	$selection = sprintf " AND (user_subscriber LIKE %s OR comment_subscriber LIKE %s)"
	    ,$dbh->quote($sql_regexp), $dbh->quote($sql_regexp);
    }
    
    ## Additional subscriber fields
    my $additional;
    if ($Conf::Conf{'db_additional_subscriber_fields'}) {
	$additional = ',' . $Conf::Conf{'db_additional_subscriber_fields'};
    }
    
    ## Oracle
    if ($Conf::Conf{'db_type'} eq 'Oracle') {
	
	$statement = sprintf "SELECT user_subscriber \"email\", comment_subscriber \"gecos\", reception_subscriber \"reception\", topics_subscriber \"topics\", visibility_subscriber \"visibility\", bounce_subscriber \"bounce\", bounce_score_subscriber \"bounce_score\", bounce_address_subscriber \"bounce_address\", %s \"date\", %s \"update_date\", subscribed_subscriber \"subscribed\", included_subscriber \"included\", include_sources_subscriber \"id\", custom_attribute_subscriber \"custom_attribute\", suspend_subscriber \"suspend\", suspend_start_date_subscriber \"startdate\", suspend_end_date_subscriber AS \"enddate\" %s FROM subscriber_table WHERE (list_subscriber = %s AND robot_subscriber = %s %s)", 
	$date_field, 
	$update_field, 
	$additional, 
	$dbh->quote($name), 
	$dbh->quote($self->{'domain'}),
	$selection;
	
	## SORT BY
	if ($sortby eq 'domain') {
	    $statement = sprintf "SELECT user_subscriber \"email\", comment_subscriber \"gecos\", reception_subscriber \"reception\", topics_subscriber \"topics\", visibility_subscriber \"visibility\", bounce_subscriber \"bounce\", bounce_score_subscriber \"bounce_score\",bounce_address_subscriber \"bounce_address\", %s \"date\", %s \"update_date\", subscribed_subscriber \"subscribed\", included_subscriber \"included\", include_sources_subscriber \"id\", custom_attribute_subscriber \"custom_attribute\", substr(user_subscriber,instr(user_subscriber,'\@')+1) \"dom\",suspend_subscriber \"suspend\", suspend_start_date_subscriber \"startdate\", suspend_end_date_subscriber \"enddate\" %s FROM subscriber_table WHERE (list_subscriber = %s AND robot_subscriber = %s) ORDER BY \"dom\"", 
	    $date_field, 
	    $update_field, 
	    $additional, 
	    $dbh->quote($name),
	    $dbh->quote($self->{'domain'});
	    
	}elsif ($sortby eq 'email') {
	    $statement .= " ORDER BY email";
	    
	}elsif ($sortby eq 'date') {
	    $statement .= " ORDER BY date DESC";
	    
	}elsif ($sortby eq 'sources') {
	    $statement .= " ORDER BY subscribed DESC,id";
	    
	}elsif ($sortby eq 'name') {
	    $statement .= " ORDER BY gecos";
	} 
	
	## Sybase
    }elsif ($Conf::Conf{'db_type'} eq 'Sybase'){
	
	$statement = sprintf "SELECT user_subscriber \"email\", comment_subscriber \"gecos\", reception_subscriber \"reception\", topics_subscriber \"topics\", visibility_subscriber \"visibility\", bounce_subscriber \"bounce\", bounce_score_subscriber \"bounce_score\", bounce_address_subscriber \"bounce_address\", %s \"date\", %s \"update_date\", subscribed_subscriber \"subscribed\", included_subscriber \"included\", include_sources_subscriber \"id\", custom_attribute_subscriber \"custom_attribute\", suspend_subscriber \"suspend\", suspend_start_date_subscriber \"startdate\", suspend_end_date_subscriber \"enddate\" %s FROM subscriber_table WHERE (list_subscriber = %s AND robot_subscriber = %s %s)", 
	$date_field, 
	$update_field, 
	$additional, 
	$dbh->quote($name), 
	$dbh->quote($self->{'domain'}),
	$selection;
	
	## SORT BY
	if ($sortby eq 'domain') {
	    $statement = sprintf "SELECT user_subscriber \"email\", comment_subscriber \"gecos\", reception_subscriber \"reception\", topics_subscriber \"topics\", visibility_subscriber \"visibility\", bounce_subscriber \"bounce\", bounce_score_subscriber \"bounce_score\",  bounce_address_subscriber \"bounce_address\",%s \"date\", %s \"update_date\", subscribed_subscriber \"subscribed\", included_subscriber \"included\", include_sources_subscriber \"id\", custom_attribute_subscriber \"custom_attribute\", substring(user_subscriber,charindex('\@',user_subscriber)+1,100) \"dom\",suspend_subscriber \"suspend\", suspend_start_date_subscriber \"startdate\", suspend_end_date_subscriber \"enddate\" %s FROM subscriber_table WHERE (list_subscriber = %s AND robot_subscriber = %s) ORDER BY \"dom\"", 
	    $date_field, 
	    $update_field, 
	    $additional, 
	    $dbh->quote($name),
	    $dbh->quote($self->{'domain'});
	    
	}elsif ($sortby eq 'email') {
	    $statement .= " ORDER BY email";
	    
	}elsif ($sortby eq 'date') {
	    $statement .= " ORDER BY date DESC";
	    
	}elsif ($sortby eq 'sources') {
	    $statement .= " ORDER BY subscribed DESC,id";
	    
	}elsif ($sortby eq 'name') {
	    $statement .= " ORDER BY gecos";
	}
	
	
	## mysql
    }elsif ($Conf::Conf{'db_type'} eq 'mysql') {
	
	$statement = sprintf "SELECT user_subscriber AS email, comment_subscriber AS gecos, reception_subscriber AS reception, topics_subscriber AS topics, visibility_subscriber AS visibility, bounce_subscriber AS bounce, bounce_score_subscriber AS bounce_score, bounce_address_subscriber AS bounce_address,  %s AS \"date\", %s AS update_date, subscribed_subscriber AS subscribed, included_subscriber AS included, include_sources_subscriber AS id, custom_attribute_subscriber AS custom_attribute, suspend_subscriber AS suspend, suspend_start_date_subscriber AS startdate, suspend_end_date_subscriber AS enddate %s FROM subscriber_table WHERE (list_subscriber = %s AND robot_subscriber = %s %s)", 
	$date_field, 
	$update_field, 
	$additional, 
	$dbh->quote($name), 
	$dbh->quote($self->{'domain'}),
	$selection;
	
	## SORT BY
	if ($sortby eq 'domain') {
	    ## Redefine query to set "dom"
	    
	    $statement = sprintf "SELECT user_subscriber AS email, comment_subscriber AS gecos, reception_subscriber AS reception, topics_subscriber AS topics, visibility_subscriber AS visibility, bounce_subscriber AS bounce, bounce_score_subscriber AS bounce_score, bounce_address_subscriber AS bounce_address,  %s AS \"date\", %s AS update_date, subscribed_subscriber AS subscribed, included_subscriber AS included, include_sources_subscriber AS id, custom_attribute_subscriber AS custom_attribute, REVERSE(SUBSTRING(user_subscriber FROM position('\@' IN user_subscriber) FOR 50)) AS \"dom\", suspend_subscriber AS suspend, suspend_start_date_subscriber AS startdate, suspend_end_date_subscriber AS enddate %s FROM subscriber_table WHERE (list_subscriber = %s AND robot_subscriber = %s ) ORDER BY dom", 
	    $date_field, 
	    $update_field, 
	    $additional, 
	    $dbh->quote($name),
	    $dbh->quote($self->{'domain'});
	    
	}elsif ($sortby eq 'email') {
	    ## Default SORT
	    $statement .= ' ORDER BY email';
	    
	}elsif ($sortby eq 'date') {
	    $statement .= ' ORDER BY date DESC';
	    
	}elsif ($sortby eq 'sources') {
	    $statement .= " ORDER BY subscribed DESC,id";
	    
	}elsif ($sortby eq 'name') {
	    $statement .= ' ORDER BY gecos';
	} 
	
	## LIMIT clause
	if (defined($rows) and defined($offset)) {
	    $statement .= sprintf " LIMIT %d, %d", $offset, $rows;
	}
	
	## SQLite
    }elsif ($Conf::Conf{'db_type'} eq 'SQLite') {
	
	$statement = sprintf "SELECT user_subscriber AS email, comment_subscriber AS gecos, reception_subscriber AS reception, visibility_subscriber AS visibility, bounce_subscriber AS bounce, bounce_score_subscriber AS bounce_score, bounce_address_subscriber AS bounce_address, %s AS \"date\", %s AS update_date, subscribed_subscriber AS subscribed, included_subscriber AS included, include_sources_subscriber AS id, custom_attribute_subscriber AS custom_attribute,suspend_subscriber AS suspend, suspend_start_date_subscriber AS startdate, suspend_end_date_subscriber AS enddate %s FROM subscriber_table WHERE (list_subscriber = %s AND robot_subscriber = %s %s)", 
	$date_field, 
	$update_field, 
	$additional, 
	$dbh->quote($name), 
	$dbh->quote($self->{'domain'}),
	$selection;
	
	## SORT BY
	if ($sortby eq 'domain') {
	    ## Redefine query to set "dom"
	    
	    $statement = sprintf "SELECT user_subscriber AS email, comment_subscriber AS gecos, reception_subscriber AS reception, visibility_subscriber AS visibility, bounce_subscriber AS bounce, bounce_score_subscriber AS bounce_score, bounce_address_subscriber AS bounce_address, %s AS \"date\", %s AS update_date, subscribed_subscriber AS subscribed, included_subscriber AS included, include_sources_subscriber AS id, custom_attribute_subscriber AS custom_attribute, substr(user_subscriber,0,func_index(user_subscriber,'\@')+1) AS \"dom\", suspend_subscriber AS suspend, suspend_start_date_subscriber AS startdate, suspend_end_date_subscriber AS enddate %s FROM subscriber_table WHERE (list_subscriber = %s AND robot_subscriber = %s) ORDER BY \"dom\"", 
	    $date_field, 
	    $update_field, 
	    $additional, 
	    $dbh->quote($name),
	    $dbh->quote($self->{'domain'});
	    
	}elsif ($sortby eq 'email') {
	    ## Default SORT
	    $statement .= ' ORDER BY email';
	    
	}elsif ($sortby eq 'date') {
	    $statement .= ' ORDER BY date DESC';
	    
	}elsif ($sortby eq 'sources') {
	    $statement .= " ORDER BY subscribed DESC,id";
	    
	}elsif ($sortby eq 'name') {
	    $statement .= ' ORDER BY gecos';
	} 
	
	## LIMIT clause
	if (defined($rows) and defined($offset)) {
	    $statement .= sprintf " LIMIT %d, %d", $offset, $rows;
	}
	
	## Pg    
    }else {
	
	$statement = sprintf "SELECT user_subscriber AS email, comment_subscriber AS gecos, reception_subscriber AS reception, topics_subscriber AS topics, visibility_subscriber AS visibility, bounce_subscriber AS bounce, bounce_score_subscriber AS bounce_score, bounce_address_subscriber AS bounce_address, %s AS \"date\", %s AS update_date, subscribed_subscriber AS subscribed, included_subscriber AS included, include_sources_subscriber AS id, custom_attribute_subscriber AS custom_attribute,suspend_subscriber AS suspend, suspend_start_date_subscriber AS startdate, suspend_end_date_subscriber AS enddate %s FROM subscriber_table WHERE (list_subscriber = %s AND robot_subscriber = %s %s)", 
	$date_field, 
	$update_field, 
	$additional, 
	$dbh->quote($name), 
	$dbh->quote($self->{'domain'}),
	$selection;
	
	## SORT BY
	if ($sortby eq 'domain') {
	    ## Redefine query to set "dom"
	    
	    $statement = sprintf "SELECT user_subscriber AS email, comment_subscriber AS gecos, reception_subscriber AS reception, topics_subscriber AS topics, visibility_subscriber AS visibility, bounce_subscriber AS bounce, bounce_score_subscriber AS bounce_score, bounce_address_subscriber AS bounce_address, %s AS \"date\", %s AS update_date, subscribed_subscriber AS subscribed, included_subscriber AS included, include_sources_subscriber AS id, custom_attribute_subscriber AS custom_attribute, SUBSTRING(user_subscriber FROM position('\@' IN user_subscriber) FOR 50) AS \"dom\", suspend_subscriber AS suspend, suspend_start_date_subscriber AS startdate, suspend_end_date_subscriber AS enddate %s FROM subscriber_table WHERE (list_subscriber = %s AND robot_subscriber = %s) ORDER BY \"dom\"", 
	    $date_field, 
	    $update_field, 
	    $additional, 
	    $dbh->quote($name),
	    $dbh->quote($self->{'domain'});
	    
	}elsif ($sortby eq 'email') {
	    $statement .= ' ORDER BY email';
	    
	}elsif ($sortby eq 'date') {
	    $statement .= ' ORDER BY date DESC';
	    
	}elsif ($sortby eq 'sources') {
	    $statement .= " ORDER BY subscribed DESC,id";
	    
	}elsif ($sortby eq 'name') {
	    $statement .= ' ORDER BY gecos';
	}
	
	## LIMIT clause
	if (defined($rows) and defined($offset)) {
	    $statement .= sprintf " LIMIT %d OFFSET %d", $rows, $offset;
	}
    }
    push @sth_stack, $sth;
    
    unless ($sth = $dbh->prepare($statement)) {
	do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
	return undef;
    }
    
    unless ($sth->execute) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }
    
    my $user = $sth->fetchrow_hashref('NAME_lc');
    if (defined $user) {
	&do_log('err','Warning: entry with empty email address in list %s', $self->{'name'}) 
	    if (! $user->{'email'});
	$user->{'reception'} ||= 'mail';
	$user->{'reception'} = $self->{'admin'}{'default_user_options'}{'reception'}
	unless ($self->is_available_reception_mode($user->{'reception'}));
	$user->{'update_date'} ||= $user->{'date'};

	############################################################################	    
	if (defined $user->{custom_attribute}) {
	    do_log('debug2', 'custom_attribute  = (%s)', $user->{custom_attribute});
	    my %custom_attr = &parseCustomAttribute($user->{'custom_attribute'});
	    $user->{'custom_attribute'} = \%custom_attr ;
	}


    }
    else {
	$sth->finish;
	$sth = pop @sth_stack;
	
	## Release the Shared lock
	unless ($lock->unlock()) {
	    return undef;
	}
    }
    
    ## If no offset (for LIMIT) was used, update total of subscribers
    unless ($offset) {
	my $total = $self->_load_total_db('nocache');
	if ($total != $self->{'total'}) {
	    $self->{'total'} = $total;
	    $self->savestats();
	}
    }
    
    return $user;
}

# Create a custom attribute from an XML description
# IN : File handle or a string, XML formed data as stored in database
# OUT : HASH data storing custome attributes.
sub parseCustomAttribute {
	my $xmldoc = shift ;
	return undef if ! defined $xmldoc or $xmldoc eq '';

	my $parser = XML::LibXML->new();
	my $tree;

	## We should use eval to parse to prevent the program to crash if it fails
	if (ref($xmldoc) eq 'GLOB') {
	    $tree = eval {$parser->parse_fh($xmldoc)};
	}else {
	    $tree = eval {$parser->parse_string($xmldoc)};
	}

	unless (defined $tree) {
	    &do_log('err', "Failed to parse XML data: %s", $@);
	    return undef;
	}

	my $doc = $tree->getDocumentElement;
	
	my @custom_attr = $doc->getChildrenByTagName('custom_attribute') ;
	my %ca ;
	foreach my $ca (@custom_attr) {
	        my $id = Encode::encode_utf8($ca->getAttribute('id'));
	        my $value = Encode::encode_utf8($ca->getElementsByTagName('value'));
		$ca{$id} = {value=>$value} ;
	}
	return %ca ;
}

# Create an XML Custom attribute to be stored into data base.
# IN : HASH data storing custome attributes
# OUT : string, XML formed data to be stored in database
sub createXMLCustomAttribute {
	my $custom_attr = shift ;
	return '<?xml version="1.0" encoding="UTF-8" ?><custom_attributes></custom_attributes>' if (not defined $custom_attr) ;
	my $XMLstr = '<?xml version="1.0" encoding="UTF-8" ?><custom_attributes>';
	foreach my $k (sort keys %{$custom_attr} ) {
		$XMLstr .= "<custom_attribute id=\"$k\"><value>".&tools::escape_html($custom_attr->{$k}{value})."</value></custom_attribute>";
	}
	$XMLstr .= "</custom_attributes>";
	
	return $XMLstr ;
}

## Returns the first admin_user with $role for the list.
sub get_first_admin_user {
    my ($self, $role, $data) = @_;

    my ($sortby, $offset, $rows, $sql_regexp);
    $sortby = $data->{'sortby'};
    ## Sort may be domain, email, date
    $sortby ||= 'domain';
    $offset = $data->{'offset'};
    $rows = $data->{'rows'};
    $sql_regexp = $data->{'sql_regexp'};
    my $fh;

    do_log('debug2', '(%s, %s, %s, %s, %s)',
	$self->{'name'}, $role, $sortby, $offset, $rows);

    my $lock = new Lock ($self->{'dir'}.'/include_admin_user');
    unless (defined $lock) {
	&do_log('err','Could not create new lock');
	return undef;
    }
    $lock->set_timeout(20); 

    ## Get a shared lock
    unless ($fh = $lock->lock('read')) {
	return undef;
    }
          
    my $name = $self->{'name'};
    my $statement;
    
    my $date_field = sprintf $date_format{'read'}{$Conf::Conf{'db_type'}}, 'date_admin', 'date_admin';
    my $update_field = sprintf $date_format{'read'}{$Conf::Conf{'db_type'}}, 'update_admin', 'update_admin';
    
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }
    
    ## SQL regexp
    my $selection;
    if ($sql_regexp) {
	$selection = sprintf " AND (user_admin LIKE %s OR comment_admin LIKE %s)"
	    ,$dbh->quote($sql_regexp), $dbh->quote($sql_regexp);
    }
    
     ## Oracle
# and ok?
    if ($Conf::Conf{'db_type'} eq 'Oracle') {
	
	$statement = sprintf "SELECT user_admin \"email\", comment_admin \"gecos\", reception_admin \"reception\", visibility_admin \"visibility\", %s \"date\", %s \"update_date\", info_admin \"info\", profile_admin \"profile\", subscribed_admin \"subscribed\", included_admin \"included\", include_sources_admin \"id\" FROM admin_table WHERE (list_admin = %s AND robot_admin = %s %s AND role_admin = %s)", 
	$date_field, 
	$update_field, 
	$dbh->quote($name), 
	$dbh->quote($self->{'domain'}),
	$selection, 
	$dbh->quote($role);
	
	## SORT BY
	if ($sortby eq 'domain') {
	    $statement = sprintf "SELECT user_admin \"email\", comment_admin \"gecos\", reception_admin \"reception\", visibility_admin \"visibility\", %s \"date\", %s \"update_date\", info_admin \"info\", profile_admin \"profile\", subscribed_admin \"subscribed\", included_admin \"included\", include_sources_admin \"id\", substr(user_admin,instr(user_admin,'\@')+1) \"dom\"  FROM admin_table WHERE (list_admin = %s AND robot_admin = %s AND role_admin = %s ) ORDER BY \"dom\"", 
	    $date_field, 
	    $update_field, 
	    $dbh->quote($name), 
	    $dbh->quote($self->{'domain'}),
	    $dbh->quote($role);
	    
	}elsif ($sortby eq 'email') {
	    $statement .= " ORDER BY email";
	    
	}elsif ($sortby eq 'date') {
	    $statement .= " ORDER BY date DESC";
	    
	}elsif ($sortby eq 'sources') {
	    $statement .= " ORDER BY subscribed DESC,id";
	    
	}elsif ($sortby eq 'name') {
	    $statement .= " ORDER BY gecos";
	} 
	
	## Sybase
    }elsif ($Conf::Conf{'db_type'} eq 'Sybase'){
	
	$statement = sprintf "SELECT user_admin \"email\", comment_admin \"gecos\", reception_admin \"reception\", visibility_admin \"visibility\", %s \"date\", %s \"update_date\", info_admin \"info\", profile_admin \"profile\", subscribed_admin \"subscribed\", included_admin \"included\", include_sources_admin \"id\" FROM admin_table WHERE (list_admin = %s AND robot_admin = %s %s AND role_admin = %s)", 
	$date_field, 
	$update_field, 
	$dbh->quote($name), 
	$dbh->quote($self->{'domain'}),
	$selection, 
	$dbh->quote($role);
	## SORT BY
	if ($sortby eq 'domain') {
	    $statement = sprintf "SELECT user_admin \"email\", comment_admin \"gecos\", reception_admin \"reception\", visibility_admin \"visibility\", %s \"date\", %s \"update_date\", info_admin \"info\", profile_admin \"profile\", subscribed_admin \"subscribed\", included_admin \"included\", include_sources_admin \"id\", substring(user_admin,charindex('\@',user_admin)+1,100) \"dom\" FROM admin_table WHERE (list_admin = %s  AND robot_admin = %s AND role_admin = %s) ORDER BY \"dom\"", 
	    $date_field, 
	    $update_field, 
	    $dbh->quote($name), 
	    $dbh->quote($self->{'domain'}),
	    $dbh->quote($role);
	    
	}elsif ($sortby eq 'email') {
	    $statement .= " ORDER BY email";
	    
	}elsif ($sortby eq 'date') {
	    $statement .= " ORDER BY date DESC";
	    
	}elsif ($sortby eq 'sources') {
	    $statement .= " ORDER BY subscribed DESC,id";
	    
	}elsif ($sortby eq 'name') {
	    $statement .= " ORDER BY gecos";
	}
	
	
	## mysql
    }elsif ($Conf::Conf{'db_type'} eq 'mysql') {
	
	$statement = sprintf "SELECT user_admin AS email, comment_admin AS gecos, reception_admin AS reception, visibility_admin AS visibility, %s AS \"date\", %s AS update_date, info_admin AS info, profile_admin AS profile, subscribed_admin AS subscribed, included_admin AS included, include_sources_admin AS id  FROM admin_table WHERE (list_admin = %s AND robot_admin = %s %s AND role_admin = %s)", 
	$date_field, 
	$update_field, 
	$dbh->quote($name), 
	$dbh->quote($self->{'domain'}),
	$selection, 
	$dbh->quote($role);
	
	## SORT BY
	if ($sortby eq 'domain') {
	    ## Redefine query to set "dom"
	    
	    $statement = sprintf "SELECT user_admin AS email, comment_admin AS gecos, reception_admin AS reception, visibility_admin AS visibility, %s AS \"date\", %s AS update_date, info_admin AS info, profile_admin AS profile, subscribed_admin AS subscribed, included_admin AS included, include_sources_admin AS id, REVERSE(SUBSTRING(user_admin FROM position('\@' IN user_admin) FOR 50)) AS \"dom\" FROM admin_table WHERE (list_admin = %s AND robot_admin = %s AND role_admin = %s ) ORDER BY \"dom\"", 
	    $date_field, 
	    $update_field, 
	    $dbh->quote($name), 
	    $dbh->quote($self->{'domain'}),
	    $dbh->quote($role);
	    
	}elsif ($sortby eq 'email') {
	    ## Default SORT
	    $statement .= ' ORDER BY email';
	    
	}elsif ($sortby eq 'date') {
	    $statement .= ' ORDER BY date DESC';
	    
	}elsif ($sortby eq 'sources') {
	    $statement .= " ORDER BY subscribed DESC,id";
	    
	}elsif ($sortby eq 'name') {
	    $statement .= ' ORDER BY gecos';
	} 
	
	## LIMIT clause
	if (defined($rows) and defined($offset)) {
	    $statement .= sprintf " LIMIT %d, %d", $offset, $rows;
	}
	
	## SQLite
    }elsif ($Conf::Conf{'db_type'} eq 'SQLite') {
	
	$statement = sprintf "SELECT user_admin AS email, comment_admin AS gecos, reception_admin AS reception, visibility_admin AS visibility, %s AS \"date\", %s AS update_date, info_admin AS info, profile_admin AS profile, subscribed_admin AS subscribed, included_admin AS included, include_sources_admin AS id  FROM admin_table WHERE (list_admin = %s AND robot_admin = %s %s AND role_admin = %s)", 
	$date_field, 
	$update_field, 
	$dbh->quote($name), 
	$dbh->quote($self->{'domain'}),
	$selection, 
	$dbh->quote($role);
	
	## SORT BY
	if ($sortby eq 'domain') {
	    ## Redefine query to set "dom"
	    
	    $statement = sprintf "SELECT user_admin AS email, comment_admin AS gecos, reception_admin AS reception, visibility_admin AS visibility, %s AS \"date\", %s AS update_date, info_admin AS info, profile_admin AS profile, subscribed_admin AS subscribed, included_admin AS included, include_sources_admin AS id, substr(user_admin,func_index(user_admin,'\@')+1,50) AS \"dom\" FROM admin_table WHERE (list_admin = %s AND robot_admin = %s AND role_admin = %s ) ORDER BY \"dom\"", 
	    $date_field, 
	    $update_field, 
	    $dbh->quote($name), 
	    $dbh->quote($self->{'domain'}),
	    $dbh->quote($role);
	    
	}elsif ($sortby eq 'email') {
	    ## Default SORT
	    $statement .= ' ORDER BY email';
	    
	}elsif ($sortby eq 'date') {
	    $statement .= ' ORDER BY date DESC';
	    
	}elsif ($sortby eq 'sources') {
	    $statement .= " ORDER BY subscribed DESC,id";
	    
	}elsif ($sortby eq 'name') {
	    $statement .= ' ORDER BY gecos';
	} 
	
	## LIMIT clause
	if (defined($rows) and defined($offset)) {
	    $statement .= sprintf " LIMIT %d, %d", $offset, $rows;
	}
	
	## Pg    
    }else {
	
	$statement = sprintf "SELECT user_admin AS email, comment_admin AS gecos, reception_admin AS reception, visibility_admin AS visibility, %s AS \"date\", %s AS update_date, info_admin AS info, profile_admin AS profile, subscribed_admin AS subscribed, included_admin AS included, include_sources_admin AS id FROM admin_table WHERE (list_admin = %s AND robot_admin = %s %s AND role_admin = %s)", 
	$date_field, 
	$update_field, 
	$dbh->quote($name), 
	$dbh->quote($self->{'domain'}),
	$selection, 
	$dbh->quote($role);
	
	## SORT BY
	if ($sortby eq 'domain') {
	    ## Redefine query to set "dom"
	    
	    $statement = sprintf "SELECT user_admin AS email, comment_admin AS gecos, reception_admin AS reception, visibility_admin AS visibility, %s AS \"date\", %s AS update_date, info_admin AS info, profile_admin AS profile, subscribed_admin AS subscribed, included_admin AS included, include_sources_admin AS id, SUBSTRING(user_admin FROM position('\@' IN user_admin) FOR 50) AS \"dom\"  FROM admin_table WHERE (list_admin = %s AND robot_admin = %s AND role_admin = %s) ORDER BY \"dom\"", 
	    $date_field, 
	    $update_field, 
	    $dbh->quote($name), 
	    $dbh->quote($self->{'domain'}),
	    $dbh->quote($role);
	    
	}elsif ($sortby eq 'email') {
	    $statement .= ' ORDER BY email';
	    
	}elsif ($sortby eq 'date') {
	    $statement .= ' ORDER BY date DESC';
	    
	}elsif ($sortby eq 'sources') {
	    $statement .= " ORDER BY subscribed DESC,id";
	    
	}elsif ($sortby eq 'email') {
	    $statement .= ' ORDER BY gecos';
	}
	
	## LIMIT clause
	if (defined($rows) and defined($offset)) {
	    $statement .= sprintf " LIMIT %d OFFSET %d", $rows, $offset;
	}
    }
    push @sth_stack, $sth;	    

    &do_log('debug2','SQL: %s', $statement);
    
    unless ($sth = $dbh->prepare($statement)) {
	do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
	return undef;
    }
    
    unless ($sth->execute) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }
    
    my $admin_user = $sth->fetchrow_hashref('NAME_lc');
    if (defined $admin_user) {
	&do_log('err','Warning: entry with empty email address in list %s', $self->{'name'}) 
	    if (! $admin_user->{'email'});
	$admin_user->{'reception'} ||= 'mail';
	$admin_user->{'update_date'} ||= $admin_user->{'date'};
    }else {
	$sth->finish;
        $sth = pop @sth_stack;

	## Release the Shared lock
	my $lock = new Lock($self->{'dir'}.'/include_admin_user');
	unless (defined $lock) {
	    &do_log('err','Could not create new lock');
	    return undef;
	}
	
	unless ($lock->unlock()) {
	    return undef;
	}
    }

    return $admin_user;
}
    
## Loop for all subsequent users.
sub get_next_user {
    my $self = shift;
    do_log('debug2', 'List::get_next_user');

    unless (defined $sth) {
	&do_log('err', 'No handle defined, get_first_user(%s) was not run', $self->{'name'});
	return undef;
    }
    
    my $user = $sth->fetchrow_hashref('NAME_lc');
    
    if (defined $user) {
	&do_log('err','Warning: entry with empty email address in list %s', $self->{'name'}) 
	    if (! $user->{'email'});
	$user->{'reception'} ||= 'mail';
	unless ($self->is_available_reception_mode($user->{'reception'})){
	    $user->{'reception'} = $self->{'admin'}{'default_user_options'}{'reception'}
	}
	$user->{'update_date'} ||= $user->{'date'};

	do_log('debug2', '(email = %s)', $user->{'email'});
	if (defined $user->{custom_attribute}) {
	    do_log('debug2', '1. custom_attribute  = (%s)', $user->{custom_attribute});
	    my %custom_attr = &parseCustomAttribute($user->{'custom_attribute'});
	    $user->{'custom_attribute'} = \%custom_attr ;
	    do_log('debug2', '2. custom_attribute  = (%s)', %custom_attr);
	    do_log('debug2', '3. custom_attribute  = (%s)', $user->{custom_attribute});
	    my @k = sort keys %custom_attr ;
	    do_log('debug2', "keys custom_attribute  = @k");
	}
    }
    else {
	$sth->finish;
	$sth = pop @sth_stack;
	
	## Release lock
	my $lock = new Lock ($self->{'dir'}.'/include');
	unless (defined $lock) {
	    &do_log('err','Could not create new lock');
	    return undef;
	}
	unless ($lock->unlock()) {
	    return undef;
	}
    }
    
#	$self->{'total'}++;
    
    return $user;
}

## Loop for all subsequent admin users with the role defined in get_first_admin_user.
sub get_next_admin_user {
    my $self = shift;
    do_log('debug2', 'List::get_next_admin_user'); 

    unless (defined $sth) {
	&do_log('err','Statement handle not defined in get_next_admin_user for list %s', $self->{'name'});
	return undef;
    }
    
    my $admin_user = $sth->fetchrow_hashref('NAME_lc');

    if (defined $admin_user) {
	&do_log('err','Warning: entry with empty email address in list %s', $self->{'name'}) 
	    if (! $admin_user->{'email'});
	$admin_user->{'reception'} ||= 'mail';
	$admin_user->{'update_date'} ||= $admin_user->{'date'};
    }
    else {
	$sth->finish;
	$sth = pop @sth_stack;
	
	## Release the Shared lock
	my $lock = new Lock($self->{'dir'}.'/include_admin_user');
	unless (defined $lock) {
	    &do_log('err','Could not create new lock');
	    return undef;
	}
	
	unless ($lock->unlock()) {
	    return undef;
	}
    }
    return $admin_user;
}




## Returns the first bouncing user
sub get_first_bouncing_user {
    my $self = shift;
    do_log('debug2', 'List::get_first_bouncing_user');

    my $lock = new Lock ($self->{'dir'}.'/include');
    unless (defined $lock) {
	&do_log('err','Could not create new lock');
	return undef;
    }
    $lock->set_timeout(10*60); 

    ## Get an Shared lock
    unless ($lock->lock('read')) {
	return undef;
    }

    my $name = $self->{'name'};
    my $statement;
    my $date_field = sprintf $date_format{'read'}{$Conf::Conf{'db_type'}}, 'date_subscriber', 'date_subscriber';
    my $update_field = sprintf $date_format{'read'}{$Conf::Conf{'db_type'}}, 'update_subscriber', 'update_subscriber';
    
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }

    ## Additional subscriber fields
    my $additional;
    if ($Conf::Conf{'db_additional_subscriber_fields'}) {
	$additional = ',' . $Conf::Conf{'db_additional_subscriber_fields'};
    }

    $statement = sprintf "SELECT user_subscriber AS email, reception_subscriber AS reception, topics_subscriber AS topics, visibility_subscriber AS visibility, bounce_subscriber AS bounce,bounce_score_subscriber AS bounce_score, %s AS \"date\", %s AS update_date,suspend_subscriber AS suspend, suspend_start_date_subscriber AS startdate, suspend_end_date_subscriber AS enddate %s FROM subscriber_table WHERE (list_subscriber = %s AND robot_subscriber = %s AND bounce_subscriber is not NULL)", 
      $date_field, 
	$update_field, 
	  $additional, 
	    $dbh->quote($name),
	      $dbh->quote($self->{'domain'});

    push @sth_stack, $sth;

    unless ($sth = $dbh->prepare($statement)) {
	do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
	return undef;
    }
    
    unless ($sth->execute) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }
    
    my $user = $sth->fetchrow_hashref('NAME_lc');
	    
    if (defined $user) {
	&do_log('err','Warning: entry with empty email address in list %s', $self->{'name'}) 
	    if (! $user->{'email'});
    }else {
	$sth->finish;
	$sth = pop @sth_stack;
	
	## Release the Shared lock
	unless ($lock->unlock()) {
	    return undef;
	}
    }
    return $user;
}

## Loop for all subsequent bouncing users.
sub get_next_bouncing_user {
    my $self = shift;
    do_log('debug2', 'List::get_next_bouncing_user');

    unless (defined $sth) {
	&do_log('err', 'No handle defined, get_first_bouncing_user(%s) was not run', $self->{'name'});
	return undef;
    }
    
    my $user = $sth->fetchrow_hashref('NAME_lc');
    
    if (defined $user) {
	&do_log('err','Warning: entry with empty email address in list %s', $self->{'name'}) 
	    if (! $user->{'email'});
	
	if (defined $user->{custom_attribute}) {
	    	my %custom_attr = &parseCustomAttribute($user->{'custom_attribute'});
	    	$user->{'custom_attribute'} = \%custom_attr ;
	    }

    }else {
	$sth->finish;
	$sth = pop @sth_stack;
	
	## Release the Shared lock
	my $lock = new Lock ($self->{'dir'}.'/include');
	unless (defined $lock) {
	    &do_log('err','Could not create new lock');
	    return undef;
	}
	unless ($lock->unlock()) {
	    return undef;
	}
    }

    return $user;
}

sub get_info {
    my $self = shift;

    my $info;
    
    unless (open INFO, "$self->{'dir'}/info") {
	&do_log('err', 'Could not open %s : %s', $self->{'dir'}.'/info', $!);
	return undef;
    }
    
    while (<INFO>) {
	$info .= $_;
    }
    close INFO;

    return $info;
}

## Total bouncing subscribers
sub get_total_bouncing {
    my $self = shift;
    do_log('debug2', 'List::get_total_boucing');

    my $name = $self->{'name'};
    my $statement;
   
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }	   
    
    ## Query the Database
    $statement = sprintf "SELECT count(*) FROM subscriber_table WHERE (list_subscriber = %s  AND robot_subscriber = %s AND bounce_subscriber is not NULL)", $dbh->quote($name), $dbh->quote($self->{'domain'});
    
    push @sth_stack, $sth;

    unless ($sth = $dbh->prepare($statement)) {
	do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
	return undef;
    }
    
    unless ($sth->execute) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }
    
    my $total =  $sth->fetchrow;

    $sth->finish();

    $sth = pop @sth_stack;

    return $total;
}

## Is the person in user table (db only)
sub is_user_db {
   my $who = &tools::clean_email(pop);
   do_log('debug3', 'List::is_user_db(%s)', $who);

   return undef unless ($who);

   unless ($List::use_db) {
       &do_log('info', 'Sympa not setup to use DBI');
       return undef;
   }

   my $statement;
   
   ## Check database connection
   unless ($dbh and $dbh->ping) {
       return undef unless &db_connect();
   }	   
   
   ## Query the Database
   $statement = sprintf "SELECT count(*) FROM user_table WHERE email_user = %s", $dbh->quote($who);
   
   push @sth_stack, $sth;

   unless ($sth = $dbh->prepare($statement)) {
       do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
       return undef;
   }
   
   unless ($sth->execute) {
       do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
       return undef;
   }
   
   my $is_user = $sth->fetchrow();
   $sth->finish();
   
   $sth = pop @sth_stack;

   return $is_user;
}

## Is the indicated person a subscriber to the list?
sub is_user {
    my ($self, $who) = @_;
    $who = &tools::clean_email($who);
    do_log('debug3', 'List::is_user(%s)', $who);
    
    return undef unless ($self && $who);
    
    my $statement;
    my $name = $self->{'name'};
    
    ## Use cache
    if (defined $list_cache{'is_user'}{$self->{'domain'}}{$name}{$who}) {
	# &do_log('debug3', 'Use cache(%s,%s): %s', $name, $who, $list_cache{'is_user'}{$self->{'domain'}}{$name}{$who});
	return $list_cache{'is_user'}{$self->{'domain'}}{$name}{$who};
    }
    
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }	   
    
    ## Query the Database
    $statement = sprintf "SELECT count(*) FROM subscriber_table WHERE (list_subscriber = %s AND robot_subscriber = %s AND user_subscriber = %s)",$dbh->quote($name), $dbh->quote($self->{'domain'}), $dbh->quote($who);
    
    push @sth_stack, $sth;
    
    unless ($sth = $dbh->prepare($statement)) {
	do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
	return undef;
    }
    
    unless ($sth->execute) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }
    
    my $is_user = $sth->fetchrow;
    
    $sth->finish();
    
    $sth = pop @sth_stack;
    
    ## Set cache
    $list_cache{'is_user'}{$self->{'domain'}}{$name}{$who} = $is_user;
    
    return $is_user;
}

## Sets new values for the given user (except gecos)
sub update_user {
    my($self, $who, $values) = @_;
    do_log('debug2', 'List::update_user(%s)', $who);
    $who = &tools::clean_email($who);    

    my ($field, $value);
    
    my ($user, $statement, $table);
    my $name = $self->{'name'};
    
    ## mapping between var and field names
    my %map_field = ( reception => 'reception_subscriber',
		      topics => 'topics_subscriber',
		      visibility => 'visibility_subscriber',
		      date => 'date_subscriber',
		      update_date => 'update_subscriber',
		      gecos => 'comment_subscriber',
		      password => 'password_user',
		      bounce => 'bounce_subscriber',
		      score => 'bounce_score_subscriber',
		      email => 'user_subscriber',
		      subscribed => 'subscribed_subscriber',
		      included => 'included_subscriber',
		      id => 'include_sources_subscriber',
		      bounce_address => 'bounce_address_subscriber',
		      custom_attribute => 'custom_attribute_subscriber',
		      suspend => 'suspend_subscriber',
		      startdate_subscriber => 'suspend_start_date_subscriber',
		      enddate => 'suspend_end_date_subscriber'
		      );
    
    ## mapping between var and tables
    my %map_table = ( reception => 'subscriber_table',
		      topics => 'subscriber_table', 
		      visibility => 'subscriber_table',
		      date => 'subscriber_table',
		      update_date => 'subscriber_table',
		      gecos => 'subscriber_table',
		      password => 'user_table',
		      bounce => 'subscriber_table',
		      score => 'subscriber_table',
		      email => 'subscriber_table',
		      subscribed => 'subscriber_table',
		      included => 'subscriber_table',
		      id => 'subscriber_table',
		      bounce_address => 'subscriber_table',
		      custom_attribute => 'subscriber_table',
		      suspend => 'subscriber_table',
		      startdate => 'subscriber_table',
		      enddate => 'subscriber_table'
		      );
    
    ## additional DB fields
    if (defined $Conf::Conf{'db_additional_subscriber_fields'}) {
	foreach my $f (split ',', $Conf::Conf{'db_additional_subscriber_fields'}) {
	    $map_table{$f} = 'subscriber_table';
	    $map_field{$f} = $f;
	}
    }
    
    if (defined $Conf::Conf{'db_additional_user_fields'}) {
	foreach my $f (split ',', $Conf::Conf{'db_additional_user_fields'}) {
	    $map_table{$f} = 'user_table';
	    $map_field{$f} = $f;
	}
    }
    
    do_log('debug2', " custom_attribute id: $Conf::Conf{'custom_attribute'}");
    ## custom attributes
    if (defined $Conf::Conf{'custom_attribute'}){
	foreach my $f (sort keys %{$Conf::Conf{'custom_attribute'}}){
	    do_log('debug2', "List::update_user custom_attribute id: $Conf::Conf{'custom_attribute'}{id} name: $Conf::Conf{'custom_attribute'}{name} type: $Conf::Conf{'custom_attribute'}{type} ");
	    	
	}
    }
    
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }	   
    
    ## Update each table
    foreach $table ('user_table','subscriber_table') {
	
	my @set_list;
	while (($field, $value) = each %{$values}) {
	    
	    unless ($map_field{$field} and $map_table{$field}) {
		&do_log('err', 'Unknown database field %s', $field);
		next;
	    }
	    
	    if ($map_table{$field} eq $table) {
		if ($field eq 'date') {
		    $value = sprintf $date_format{'write'}{$Conf::Conf{'db_type'}}, $value, $value;
		}elsif ($field eq 'update_date') {
		    $value = sprintf $date_format{'write'}{$Conf::Conf{'db_type'}}, $value, $value;
		}elsif ($value eq 'NULL'){
		    if ($Conf::Conf{'db_type'} eq 'mysql') {
			$value = '\N';
		    }
		}else {
		    if ($numeric_field{$map_field{$field}}) {
			$value ||= 0; ## Can't have a null value
		    }else {
			$value = $dbh->quote($value);
		    }
		}
		my $set = sprintf "%s=%s", $map_field{$field}, $value;
		push @set_list, $set;
	    }
	}
	next unless @set_list;
	
	## Update field
	if ($table eq 'user_table') {
	    $statement = sprintf "UPDATE %s SET %s WHERE (email_user=%s)", $table, join(',', @set_list), $dbh->quote($who); 
	    
	}elsif ($table eq 'subscriber_table') {
	    if ($who eq '*') {
		$statement = sprintf "UPDATE %s SET %s WHERE (list_subscriber=%s AND robot_subscriber = %s)", 
		$table, 
		join(',', @set_list), 
		$dbh->quote($name), 
		$dbh->quote($self->{'domain'});
	    }else {
		$statement = sprintf "UPDATE %s SET %s WHERE (user_subscriber=%s AND list_subscriber=%s AND robot_subscriber = %s)", 
		$table, 
		join(',', @set_list), 
		$dbh->quote($who), 
		$dbh->quote($name),
		$dbh->quote($self->{'domain'});
	    }
	}
	
	unless ($dbh->do($statement)) {
	    do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	    return undef;
	}
    }

    ## Rename picture on disk if user email changed
    if ($values->{'email'}) {
	my $file_name = &tools::md5_fingerprint($who);
	my $picture_file_path = &Conf::get_robot_conf($self->{'domain'},'pictures_path').'/'.$self->{'name'}.'@'.$self->{'domain'};

	foreach my $extension ('gif','png','jpg','jpeg') {
	    if (-f $picture_file_path.'/'.$file_name.'.'.$extension) {
		my $new_file_name = &tools::md5_fingerprint($values->{'email'});
		unless (rename $picture_file_path.'/'.$file_name.'.'.$extension, $picture_file_path.'/'.$new_file_name.'.'.$extension) {
		    &do_log('err', "Failed to rename %s to %s : %s", $picture_file_path.'/'.$file_name.'.'.$extension, $picture_file_path.'/'.$new_file_name.'.'.$extension, $!);
		}
	    }
	}
    }
    
    ## Reset session cache
    $list_cache{'get_subscriber'}{$self->{'domain'}}{$name}{$who} = undef;
    
    return 1;
}


## Sets new values for the given admin user (except gecos)
sub update_admin_user {
    my($self, $who,$role, $values) = @_;
    do_log('debug2', 'List::update_admin_user(%s,%s)', $role, $who); 
    $who = &tools::clean_email($who);    

    my ($field, $value);
    
    my ($admin_user, $statement, $table);
    my $name = $self->{'name'};
    
    ## mapping between var and field names
    my %map_field = ( reception => 'reception_admin',
		      visibility => 'visibility_admin',
		      date => 'date_admin',
		      update_date => 'update_admin',
		      gecos => 'comment_admin',
		      password => 'password_user',
		      email => 'user_admin',
		      subscribed => 'subscribed_admin',
		      included => 'included_admin',
		      id => 'include_sources_admin',
		      info => 'info_admin',
		      profile => 'profile_admin',
		      role => 'role_admin'
		      );
    
    ## mapping between var and tables
    my %map_table = ( reception => 'admin_table',
		      visibility => 'admin_table',
		      date => 'admin_table',
		      update_date => 'admin_table',
		      gecos => 'admin_table',
		      password => 'user_table',
		      email => 'admin_table',
		      subscribed => 'admin_table',
		      included => 'admin_table',
		      id => 'admin_table',
		      info => 'admin_table',
		      profile => 'admin_table',
		      role => 'admin_table'
		      );
#### ??
    ## additional DB fields
#    if (defined $Conf::Conf{'db_additional_user_fields'}) {
#	foreach my $f (split ',', $Conf::Conf{'db_additional_user_fields'}) {
#	    $map_table{$f} = 'user_table';
#	    $map_field{$f} = $f;
#	}
#    }
    
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }	   
    
    ## Update each table
    foreach $table ('user_table','admin_table') {
	
	my @set_list;
	while (($field, $value) = each %{$values}) {
	    
	    unless ($map_field{$field} and $map_table{$field}) {
		&do_log('err', 'Unknown database field %s', $field);
		next;
	    }
	    
	    if ($map_table{$field} eq $table) {
		if ($field eq 'date') {
		    $value = sprintf $date_format{'write'}{$Conf::Conf{'db_type'}}, $value, $value;
		}elsif ($field eq 'update_date') {
		    $value = sprintf $date_format{'write'}{$Conf::Conf{'db_type'}}, $value, $value;
		}elsif ($value eq 'NULL'){
		    if ($Conf::Conf{'db_type'} eq 'mysql') {
			$value = '\N';
		    }
		}else {
		    if ($numeric_field{$map_field{$field}}) {
			$value ||= 0; ## Can't have a null value
		    }else {
			$value = $dbh->quote($value);
		    }
		}
		my $set = sprintf "%s=%s", $map_field{$field}, $value;

		push @set_list, $set;
	    }
	}
	next unless @set_list;
	
	## Update field
	if ($table eq 'user_table') {
	    $statement = sprintf "UPDATE %s SET %s WHERE (email_user=%s)", $table, join(',', @set_list), $dbh->quote($who); 
	    
	}elsif ($table eq 'admin_table') {
	    if ($who eq '*') {
		$statement = sprintf "UPDATE %s SET %s WHERE (list_admin=%s AND robot_admin=%s AND role_admin=%s)", 
		$table, 
		join(',', @set_list), 
		$dbh->quote($name), 
		$dbh->quote($self->{'domain'}),
		$dbh->quote($role);
	    }else {
		$statement = sprintf "UPDATE %s SET %s WHERE (user_admin=%s AND list_admin=%s AND robot_admin=%s AND role_admin=%s )", 
		$table, 
		join(',', @set_list), 
		$dbh->quote($who), 
		$dbh->quote($name), 
		$dbh->quote($self->{'domain'}),
		$dbh->quote($role);
	    }
	}
    }
    
    unless ($dbh->do($statement)) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }

    ## Reset session cache
    $list_cache{'get_admin_user'}{$self->{'domain'}}{$name}{$role}{$who} = undef;
    
    return 1;
}



## Sets new values for the given user in the Database
sub update_user_db {
    my($who, $values) = @_;
    do_log('debug', 'List::update_user_db(%s)', $who);

    $who = &tools::clean_email($who);

    unless ($List::use_db) {
	&do_log('info', 'Sympa not setup to use DBI');
	return undef;
    }

    ## use md5 fingerprint to store password   
    $values->{'password'} = &Auth::password_fingerprint($values->{'password'}) if ($values->{'password'});

    my ($field, $value);
    
    my ($user, $statement, $table);
    
    ## mapping between var and field names
    my %map_field = ( gecos => 'gecos_user',
		      password => 'password_user',
		      cookie_delay => 'cookie_delay_user',
		      lang => 'lang_user',
		      attributes => 'attributes_user',
		      email => 'email_user',
		      data => 'data_user',
		      last_login_date => 'last_login_date_user',
		      last_login_host => 'last_login_host_user',
		      wrong_login_count => 'wrong_login_count_user'
		      );
    
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }	   
    
    ## Update each table
    my @set_list;

    while (($field, $value) = each %{$values}) {
	unless ($map_field{$field}) {
	    do_log('err', 'unkown field "%s" in map_field internal error', $field);
	    next;
	};
	my $set;
	
	if ($numeric_field{$map_field{$field}})  {
	    $value ||= 0; ## Can't have a null value
	    $set = sprintf '%s=%s', $map_field{$field}, $value;
	}else { 
	    $set = sprintf '%s=%s', $map_field{$field}, $dbh->quote($value);
	}
	push @set_list, $set;
    }
    
    return undef unless @set_list;
    
    ## Update field

    # my $statement2 = sprintf "UPDATE user_table SET %s WHERE (email_user=%s)",$setlist,dbh->quote($who); 

    $statement = sprintf "UPDATE user_table SET %s WHERE (email_user=%s)"
	    , join(',', @set_list), $dbh->quote($who); 
    
    do_log('debug3', 'List::update_user_db()   statement : %s', $statement);
    unless ($dbh->do($statement)) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }
    
    return 1;
}

## Adds a new user to Database (in User table)
sub add_user_db {
    my($values) = @_;
    do_log('debug2', 'List::add_user_db');

    my ($field, $value);
    my ($user, $statement, $table);
    
    unless ($List::use_db) {
	&do_log('info', 'Sympa not setup to use DBI');
	return undef;
    }
 
    ## encrypt password   
    $values->{'password'} = &Auth::password_fingerprint($values->{'password'}) if ($values->{'password'});
    
    return undef unless (my $who = &tools::clean_email($values->{'email'}));
    
    return undef if (is_user_db($who));
    
    ## mapping between var and field names
    my %map_field = ( email => 'email_user',
		      gecos => 'gecos_user',
		      custom_attribute => 'custom_attribute',
		      password => 'password_user',
		      cookie_delay => 'cookie_delay_user',
		      lang => 'lang_user',
		      attributes => 'attributes_user'
		      );
    
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }	   
    
    ## Update each table
    my (@insert_field, @insert_value);
    while (($field, $value) = each %{$values}) {
	
	next unless ($map_field{$field});
	
	my $insert;
	if ($numeric_field{$map_field{$field}}) {
	    $value ||= 0; ## Can't have a null value
	    $insert = $value;
	}else {
	    $insert = sprintf "%s", $dbh->quote($value);
	}
	push @insert_value, $insert;
	push @insert_field, $map_field{$field}
    }
    
    return undef 
	unless @insert_field;
    
    ## Update field
    $statement = sprintf "INSERT INTO user_table (%s) VALUES (%s)"
	, join(',', @insert_field), join(',', @insert_value); 
    
    unless ($dbh->do($statement)) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }
    
    return 1;
}

## Adds a new user, no overwrite.
sub add_user {
    my($self, @new_users) = @_;
    &do_log('debug2', 'List::add_user');
    
    my $name = $self->{'name'};
    my $total = 0;
    
    my $subscriptions = $self->get_subscription_requests();

    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }	   
    
    foreach my $new_user (@new_users) {
	my $who = &tools::clean_email($new_user->{'email'});
	unless ($who) {
	    Log::do_log('err', 'Ignoring %s which is not a valid email',$new_user->{'email'});
	    next;
	}
	
	# Delete from exclusion_table and force a sync_include if new_user was excluded
	if(&insert_delete_exclusion($who, $name, $self->{'domain'}, 'delete')) {
		$self->sync_include();
		if($self->is_user($who)) {
		    $total++;
		    next;
		}
	}
	
	$new_user->{'date'} ||= time;
	$new_user->{'update_date'} ||= $new_user->{'date'};
	
	my %custom_attr = %{ $subscriptions->{$who}{'custom_attribute'} } if (defined $subscriptions->{$who}{'custom_attribute'} );
	$new_user->{'custom_attribute'} ||= &createXMLCustomAttribute(\%custom_attr) ;
	do_log('debug2', 'List::add_user custom_attribute = %s', $new_user->{'custom_attribute'});
	
	my $date_field = sprintf $date_format{'write'}{$Conf::Conf{'db_type'}}, $new_user->{'date'}, $new_user->{'date'};
	my $update_field = sprintf $date_format{'write'}{$Conf::Conf{'db_type'}}, $new_user->{'update_date'}, $new_user->{'update_date'};
	
	## Crypt password if it was not crypted
	unless ($new_user->{'password'} =~ /^crypt/) {
		$new_user->{'password'} = &tools::crypt_password($new_user->{'password'});
	}
	
	$list_cache{'is_user'}{$self->{'domain'}}{$name}{$who} = undef;
	
	my $statement;
	
	## Either is_included or is_subscribed must be set
	## default is is_subscriber for backward compatibility reason
	unless ($new_user->{'included'}) {
		$new_user->{'subscribed'} = 1;
	}
	
	unless ($new_user->{'included'}) {
		## Is the email in user table?
		if (! is_user_db($who)) {
		## Insert in User Table
		$statement = sprintf "INSERT INTO user_table (email_user, gecos_user, lang_user, password_user) VALUES (%s,%s,%s,%s)",$dbh->quote($who), $dbh->quote($new_user->{'gecos'}), $dbh->quote($new_user->{'lang'}), $dbh->quote($new_user->{'password'});
		
		unless ($dbh->do($statement)) {
			do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
			next;
		}
		}
	}	    
	
	$new_user->{'subscribed'} ||= 0;
	$new_user->{'included'} ||= 0;
	
	## Update Subscriber Table
	$statement = sprintf "INSERT INTO subscriber_table (user_subscriber, comment_subscriber, list_subscriber, robot_subscriber, date_subscriber, update_subscriber, reception_subscriber, topics_subscriber, visibility_subscriber,subscribed_subscriber,included_subscriber,include_sources_subscriber,custom_attribute_subscriber,suspend_subscriber,suspend_start_date_subscriber,suspend_end_date_subscriber) VALUES (%s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s)", 
	$dbh->quote($who), 
	$dbh->quote($new_user->{'gecos'}), 
	$dbh->quote($name), 
	$dbh->quote($self->{'domain'}),
	$date_field, 
	$update_field, 
	$dbh->quote($new_user->{'reception'}), 
	$dbh->quote($new_user->{'topics'}), 
	$dbh->quote($new_user->{'visibility'}), 
	$new_user->{'subscribed'}, 
	$new_user->{'included'}, 
	$dbh->quote($new_user->{'id'}),
	$dbh->quote($new_user->{'custom_attribute'}),
	$dbh->quote($new_user->{'suspend'}),
	$dbh->quote($new_user->{'startdate'}),
	$dbh->quote($new_user->{'enddate'});
	
	unless ($dbh->do($statement)) {
		do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
		next;
	}
	$total++;
    }

    $self->{'total'} += $total;
    $self->savestats();

    return $total;
}


## Adds a new admin user, no overwrite.
sub add_admin_user {
    my($self, $role, @new_admin_users) = @_;
    do_log('debug2', 'List::add_admin_user');
    
    my $name = $self->{'name'};
    my $total = 0;
    
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }	   
	
    foreach my $new_admin_user (@new_admin_users) {
	my $who = &tools::clean_email($new_admin_user->{'email'});
	
	next unless $who;
	
	$new_admin_user->{'date'} ||= time;
	$new_admin_user->{'update_date'} ||= $new_admin_user->{'date'};
	    
	my $date_field = sprintf $date_format{'write'}{$Conf::Conf{'db_type'}}, $new_admin_user->{'date'}, $new_admin_user->{'date'};
	my $update_field = sprintf $date_format{'write'}{$Conf::Conf{'db_type'}}, $new_admin_user->{'update_date'}, $new_admin_user->{'update_date'};
	    
	$list_cache{'is_admin_user'}{$self->{'domain'}}{$name}{$who} = undef;
	    
	my $statement;

	##  either is_included or is_subscribed must be set
	## default is is_subscriber for backward compatibility reason
	unless ($new_admin_user->{'included'}) {
	    $new_admin_user->{'subscribed'} = 1;
	}
	    
	unless ($new_admin_user->{'included'}) {
	    ## Is the email in user table?
	    if (! is_user_db($who)) {
		## Insert in User Table
		$statement = sprintf "INSERT INTO user_table (email_user, gecos_user, lang_user, password_user) VALUES (%s,%s,%s,%s)",$dbh->quote($who), $dbh->quote($new_admin_user->{'gecos'}), $dbh->quote($new_admin_user->{'lang'}), $dbh->quote($new_admin_user->{'password'});
		
		unless ($dbh->do($statement)) {
		    do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
		    next;
		}
	    }
	}	    

	$new_admin_user->{'subscribed'} ||= 0;
 	$new_admin_user->{'included'} ||= 0;

	## Update Admin Table
	$statement = sprintf "INSERT INTO admin_table (user_admin, comment_admin, list_admin, robot_admin, date_admin, update_admin, reception_admin, visibility_admin, subscribed_admin,included_admin,include_sources_admin, role_admin, info_admin, profile_admin) VALUES (%s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s)", 
	$dbh->quote($who), 
	$dbh->quote($new_admin_user->{'gecos'}), 
	$dbh->quote($name), 
	$dbh->quote($self->{'domain'}),
	$date_field, 
	$update_field, 
	$dbh->quote($new_admin_user->{'reception'}), 
	$dbh->quote($new_admin_user->{'visibility'}), 
	$new_admin_user->{'subscribed'}, 
	$new_admin_user->{'included'}, 
	$dbh->quote($new_admin_user->{'id'}), 
	$dbh->quote($role), 
	$dbh->quote($new_admin_user->{'info'}), 
	$dbh->quote($new_admin_user->{'profile'});
	
	unless ($dbh->do($statement)) {
	    do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	    next;
	}
	$total++;
    }

    return $total;
}

## Update subscribers and admin users (used while renaming a list)
sub rename_list_db {
    my($self, $new_listname, $new_robot) = @_;
    do_log('debug', 'List::rename_list_db(%s,%s,%s)', $self->{'name'},$new_listname, $new_robot);

    unless ($List::use_db) {
	&do_log('info', 'Sympa not setup to use DBI');
	return undef;
    }

    my $statement_subscriber;
    my $statement_admin;
    my $statement_list_cache;
    
    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }	   
    
    $statement_subscriber =  sprintf "UPDATE subscriber_table SET list_subscriber=%s, robot_subscriber=%s WHERE (list_subscriber=%s AND robot_subscriber=%s)", 
    $dbh->quote($new_listname), 
    $dbh->quote($new_robot),
    $dbh->quote($self->{'name'}),
    $dbh->quote($self->{'domain'}) ; 

    do_log('debug', 'List::rename_list_db statement : %s',  $statement_subscriber );

    unless ($dbh->do($statement_subscriber)) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement_subscriber, $dbh->errstr);
	return undef;
    }

    # admin_table is "alive" only in case include2
    $statement_admin =  sprintf "UPDATE admin_table SET list_admin=%s, robot_admin=%s WHERE (list_admin=%s AND robot_admin=%s)", 
    $dbh->quote($new_listname), 
    $dbh->quote($new_robot),
    $dbh->quote($self->{'name'}),
    $dbh->quote($self->{'domain'}) ; 
    
    do_log('debug', 'List::rename_list_db statement : %s',  $statement_admin );
    
    unless ($dbh->do($statement_admin)) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement_admin, $dbh->errstr);
	return undef;
    }
    
    if ($List::use_db) {
      $statement_admin =  sprintf "UPDATE list_table SET name_list=%s, robot_list=%s WHERE (name_list=%s AND robot_list=%s)",
      $dbh->quote($new_listname),
      $dbh->quote($new_robot),
      $dbh->quote($self->{'name'}),
      $dbh->quote($self->{'domain'}) ;

      do_log('debug', 'List::rename_list_db statement : %s',  $statement_admin );

      unless ($dbh->do($statement_admin)) {
        do_log('err','Unable to execute SQL statement "%s" : %s', $statement_admin, $dbh->errstr);
        return undef;
      }
    }

    return 1;
}


## Is the user listmaster
sub is_listmaster {
    my $who = shift;
    my $robot = shift;

    $who =~ y/A-Z/a-z/;

    return 0 unless ($who);

    if ($robot && (defined $Conf::Conf{'robots'}{$robot}) && $Conf::Conf{'robots'}{$robot}{'listmasters'}) {
	foreach my $listmaster (@{$Conf::Conf{'robots'}{$robot}{'listmasters'}}){
	    return 1 if (lc($listmaster) eq lc($who));
	} 
    }
	
    foreach my $listmaster (@{$Conf::Conf{'listmasters'}}){
	    return 1 if (lc($listmaster) eq lc($who));
	}    

    return 0;
}

## Does the user have a particular function in the list?
sub am_i {
    my($self, $function, $who, $options) = @_;
    do_log('debug2', 'List::am_i(%s, %s, %s)', $function, $self->{'name'}, $who);
    
    return undef unless ($self && $who);
    $function =~ y/A-Z/a-z/;
    $who =~ y/A-Z/a-z/;
    chomp($who);
    
    ## If 'strict' option is given, then listmaster does not inherit privileged
    unless (defined $options and $options->{'strict'}) {
	## Listmaster has all privileges except editor
	# sa contestable.
	if (($function eq 'owner' || $function eq 'privileged_owner') and &is_listmaster($who,$self->{'domain'})) {
	    $list_cache{'am_i'}{$function}{$self->{'domain'}}{$self->{'name'}}{$who} = 1;
	    return 1;
	}
    }
	
    ## Use cache
    if (defined $list_cache{'am_i'}{$function}{$self->{'domain'}}{$self->{'name'}}{$who} &&
	$function ne 'editor') { ## Defaults for editor may be owners) {
	# &do_log('debug3', 'Use cache(%s,%s): %s', $name, $who, $list_cache{'is_user'}{$self->{'domain'}}{$name}{$who});
	return $list_cache{'am_i'}{$function}{$self->{'domain'}}{$self->{'name'}}{$who};
    }

    ##Check editors
    if ($function =~ /^editor$/i){
	
	## Check cache first
	if ($list_cache{'am_i'}{$function}{$self->{'domain'}}{$self->{'name'}}{$who} == 1) {
	    return 1;
	}
	
	my $editor = $self->get_admin_user('editor',$who);
	
	if (defined $editor) {
	    return 1;
	}else {
	    ## Check if any editor is defined ; if not owners are editors
	    my $editors = $self->get_editors();
	    if ($#{$editors} < 0) {
		
		# if no editor defined, owners has editor privilege
		$editor = $self->get_admin_user('owner',$who);
		if (defined $editor){
		    ## Update cache
		    $list_cache{'am_i'}{'editor'}{$self->{'domain'}}{$self->{'name'}}{$who} = 1;
		    
		    return 1;
		}
	    }else {
		
		## Update cache
		$list_cache{'am_i'}{'editor'}{$self->{'domain'}}{$self->{'name'}}{$who} = 0;
		
		return undef;
	    }
	}
    }
    ## Check owners
    if ($function =~ /^owner$/i){
	my $owner = $self->get_admin_user('owner',$who);
	if (defined $owner) {		    
	    ## Update cache
	    $list_cache{'am_i'}{'owner'}{$self->{'domain'}}{$self->{'name'}}{$who} = 1;
	    
	    return 1;
	}else {
	    
	    ## Update cache
	    $list_cache{'am_i'}{'owner'}{$self->{'domain'}}{$self->{'name'}}{$who} = 0;
	    
	    return undef;
	}
    }elsif ($function =~ /^privileged_owner$/i) {
	my $privileged = $self->get_admin_user('owner',$who);
	if ($privileged->{'profile'} eq 'privileged') {
	    
	    ## Update cache
	    $list_cache{'am_i'}{'privileged_owner'}{$self->{'domain'}}{$self->{'name'}}{$who} = 1;
	    
	    return 1;
	}else {
	    
	    ## Update cache
	    $list_cache{'am_i'}{'privileged_owner'}{$self->{'domain'}}{$self->{'name'}}{$who} = 0;
	    
	    return undef;
	}
    }
}

## Check list authorizations
## Higher level sub for request_action
sub check_list_authz {
    my $self = shift;
    my $operation = shift;
    my $auth_method = shift;
    my $context = shift;
    my $debug = shift;
    &do_log('debug', 'List::check_list_authz %s,%s',$operation,$auth_method);

    $context->{'list_object'} = $self;

    return &Scenario::request_action($operation, $auth_method, $self->{'domain'}, $context, $debug);
}

## Initialize internal list cache
sub init_list_cache {
    &do_log('debug2', 'List::init_list_cache()');
    
    undef %list_cache;
}

## May the indicated user edit the indicated list parameter or not?
sub may_edit {

    my($self,$parameter, $who) = @_;
    do_log('debug3', 'List::may_edit(%s, %s)', $parameter, $who);

    my $role;

    return undef unless ($self);

    my $edit_conf;

    # Load edit_list.conf: track by file, not domain (file may come from server, robot, family or list context)
    my $edit_conf_file = &tools::get_filename('etc',{},'edit_list.conf',$self->{'domain'},$self); 
    if (! $edit_list_conf{$edit_conf_file} || ((stat($edit_conf_file))[9] > $mtime{'edit_list_conf'}{$edit_conf_file})) {

        $edit_conf = $edit_list_conf{$edit_conf_file} = &tools::load_edit_list_conf($self->{'domain'}, $self);
	$mtime{'edit_list_conf'}{$edit_conf_file} = time;
    }else {
        $edit_conf = $edit_list_conf{$edit_conf_file};
    }

    ## What privilege?
    if (&is_listmaster($who,$self->{'domain'})) {
	$role = 'listmaster';
    }elsif ( $self->am_i('privileged_owner',$who) ) {
	$role = 'privileged_owner';
	
    }elsif ( $self->am_i('owner',$who) ) {
	$role = 'owner';
	
    }elsif ( $self->am_i('editor',$who) ) {
	$role = 'editor';
	
#    }elsif ( $self->am_i('subscriber',$who) ) {
#	$role = 'subscriber';
#	
    }else {
	return ('user','hidden');
    }

    ## What privilege does he/she has?
    my ($what, @order);

    if (($parameter =~ /^(\w+)\.(\w+)$/) &&
	($parameter !~ /\.tt2$/)) {
	my $main_parameter = $1;
	@order = ($edit_conf->{$parameter}{$role},
		  $edit_conf->{$main_parameter}{$role}, 
		  $edit_conf->{'default'}{$role}, 
		  $edit_conf->{'default'}{'default'})
    }else {
	@order = ($edit_conf->{$parameter}{$role}, 
		  $edit_conf->{'default'}{$role}, 
		  $edit_conf->{'default'}{'default'})
    }
    
    foreach $what (@order) {
	if (defined $what) {
	    return ($role,$what);
	}
    }
    
    return ('user','hidden');
}


## May the indicated user edit a paramter while creating a new list
# sa cette procédure est appelée nul part, je lui ajoute malgrès tout le paramêtre robot
# edit_conf devrait être aussi dépendant du robot
sub may_create_parameter {

    my($self, $parameter, $who,$robot) = @_;
    do_log('debug3', 'List::may_create_parameter(%s, %s, %s)', $parameter, $who,$robot);

    if ( &is_listmaster($who,$robot)) {
	return 1;
    }
    my $edit_conf = &tools::load_edit_list_conf($robot,$self);
    $edit_conf->{$parameter} ||= $edit_conf->{'default'};
    if (! $edit_conf->{$parameter}) {
	do_log('notice','tools::load_edit_list_conf privilege for parameter $parameter undefined');
	return undef;
    }
    if ($edit_conf->{$parameter}  =~ /^(owner|privileged_owner)$/i ) {
	return 1;
    }else{
	return 0;
    }

}


## May the indicated user do something with the list or not?
## Action can be : send, review, index, get
##                 add, del, reconfirm, purge
sub may_do {
   my($self, $action, $who) = @_;
   do_log('debug3', 'List::may_do(%s, %s)', $action, $who);

   my $i;

   ## Just in case.
   return undef unless ($self && $action);
   my $admin = $self->{'admin'};
   return undef unless ($admin);

   $action =~ y/A-Z/a-z/;
   $who =~ y/A-Z/a-z/;

   if ($action =~ /^(index|get)$/io) {
       my $arc_access = $admin->{'archive'}{'access'};
       if ($arc_access =~ /^public$/io)  {
	   return 1;
       }elsif ($arc_access =~ /^private$/io) {
	   return 1 if ($self->is_user($who));
	   return $self->am_i('owner', $who);
       }elsif ($arc_access =~ /^owner$/io) {
	   return $self->am_i('owner', $who);
       }
       return undef;
   }

   if ($action =~ /^(review)$/io) {
       foreach $i (@{$admin->{'review'}}) {
	   if ($i =~ /^public$/io) {
	       return 1;
	   }elsif ($i =~ /^private$/io) {
	       return 1 if ($self->is_user($who));
	       return $self->am_i('owner', $who);
	   }elsif ($i =~ /^owner$/io) {
	       return $self->am_i('owner', $who);
	   }
	   return undef;
       }
   }

   if ($action =~ /^send$/io) {
      if ($admin->{'send'} =~/^(private|privateorpublickey|privateoreditorkey)$/i) {

         return undef unless ($self->is_user($who) || $self->am_i('owner', $who));
      }elsif ($admin->{'send'} =~ /^(editor|editorkey|privateoreditorkey)$/i) {
         return undef unless ($self->am_i('editor', $who));
      }elsif ($admin->{'send'} =~ /^(editorkeyonly|publickey|privatekey)$/io) {
         return undef;
      }
      return 1;
   }

   if ($action =~ /^(add|del|remind|reconfirm|purge)$/io) {
      return $self->am_i('owner', $who);
   }

   if ($action =~ /^(modindex)$/io) {
       return undef unless ($self->am_i('editor', $who));
       return 1;
   }

   if ($action =~ /^auth$/io) {
       if ($admin->{'send'} =~ /^(privatekey)$/io) {
	   return 1 if ($self->is_user($who) || $self->am_i('owner', $who));
       } elsif ($admin->{'send'} =~ /^(privateorpublickey)$/io) {
	   return 1 unless ($self->is_user($who) || $self->am_i('owner', $who));
       }elsif ($admin->{'send'} =~ /^(publickey)$/io) {
	   return 1;
       }
       return undef; #authent
   } 
   return undef;
}

## Does the list support digest mode
sub is_digest {
   return (shift->{'admin'}{'digest'});
}

## Does the file exist?
sub archive_exist {
   my($self, $file) = @_;
   do_log('debug', 'List::archive_exist (%s)', $file);

   return undef unless ($self->is_archived());
   my $dir = &Conf::get_robot_conf($self->{'domain'},'arc_path').'/'.$self->get_list_id();
   Archive::exist($dir, $file);

}


## List the archived files
sub archive_ls {
   my $self = shift;
   do_log('debug2', 'List::archive_ls');

   my $dir = &Conf::get_robot_conf($self->{'domain'},'arc_path').'/'.$self->get_list_id();

   Archive::list($dir) if ($self->is_archived());
}

## Archive 

our $serial_number = 0; # incremented on each archived mail

sub archive_msg {
    my($self, $message) = @_;
    Log::do_log('debug2', 'List::archive_msg for %s',$self->{'name'});

    if ($self->is_archived()) {
        my $msg = $message->{'msg'};
        if (($message->{'smime_crypted'} eq 'smime_crypted') &&
            ($self->{admin}{archive_crypted_msg} eq 'original')) {
            $msg = $message->{'orig_msg'};
        }

        Archive::store_last($self, $msg);

        ## copie a message in outgoing spool using a unique file name based on
        ## listname

        ## ignoring message with a no-archive flag
        if (   ref($msg)
            && ($Conf::Conf{'ignore_x_no_archive_header_feature'} ne 'on')
            && (   ($msg->head->get('X-no-archive') =~ /yes/i)
                || ($msg->head->get('Restrict') =~ /no\-external\-archive/i))
            ) {
            Log::do_log('info',
                "Do not archive message with no-archive flag for list %s",
                $self->get_list_id);
            return 1;
        }

        ## Create the archive directory if needed
        my $queue = $Conf::Conf{'queueoutgoing'};
        unless (-d $queue) {
            mkdir($queue, 0775);
            chmod 0774, $queue;
            Log::do_log('info', "creating $queue");
        }

        my @now = localtime(time);

        # my $prefix = sprintf("%04d-%02d-%02d-%02d-%02d-%02d",
        #     1900+$now[5],$now[4]+1,$now[3],$now[2],$now[1],$now[0]);
        # my $filename = "$queue"."/"."$prefix-$list_id";
        my $filename = sprintf '%s/%s.%d.%d.%d',
            $queue, $self->get_list_id, time, $$, $serial_number;
        $serial_number = ($serial_number + 1) % 100000;
        unless (open(OUT, "> $filename")) {
            Log::do_log('info',
                "error unable open outgoing dir %s for list %s",
                $queue, $self->get_list_id);
            return undef;
        }
        Log::do_log('debug', "put message in $filename");
        if (ref($msg)) {
            $msg->print(\*OUT);
        } else {
            print OUT $msg;
        }
        close(OUT);
    }
}

## Is the list moderated?                                                          
sub is_moderated {
    
    return 1 if (defined shift->{'admin'}{'editor'});
                                                          
    return 0;
}

## Is the list archived?
sub is_archived {
    do_log('debug', 'List::is_archived');    
    if (shift->{'admin'}{'web_archive'}{'access'}) {do_log('debug', 'List::is_archived : 1'); return 1 ;}  
    do_log('debug', 'List::is_archived : undef');
    return undef;
}

## Is the list web archived?
sub is_web_archived {
    my $self = shift;
    return 1 if (ref $self->{'admin'}{'web_archive'} eq 'HASH' and $self->{'admin'}{'web_archive'}{'access'});
    return undef;
}

## Returns 1 if the  digest  must be send 
sub get_nextdigest {
    my $self = shift;
    do_log('debug3', 'List::get_nextdigest (%s)');

    my $digest = $self->{'admin'}{'digest'};
    my $listname = $self->{'name'};

    ## Reverse compatibility concerns
    my $filename;
    foreach my $f ("$Conf::Conf{'queuedigest'}/$listname",
 		   $Conf::Conf{'queuedigest'}.'/'.$self->get_list_id()) {
 	$filename = $f if (-f $f);
    }
    
    return undef unless (defined $filename);

    unless ($digest) {
	return undef;
    }
    
    my @days = @{$digest->{'days'}};
    my ($hh, $mm) = ($digest->{'hour'}, $digest->{'minute'});
     
    my @now  = localtime(time);
    my $today = $now[6]; # current day
    my @timedigest = localtime( (stat $filename)[9]);

    ## 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 == 1);

    if (($now[2] * 60 + $now[1]) >= ($hh * 60 + $mm) and 
	(timelocal(0, $mm, $hh, $now[3], $now[4], $now[5]) > timelocal(0, $timedigest[1], $timedigest[2], $timedigest[3], $timedigest[4], $timedigest[5]))
        ){
	return 1;
    }

    return undef;
}

	
## Loads all scenari for an action
sub load_scenario_list {
    my ($self, $action,$robot) = @_;
    do_log('debug3', 'List::load_scenario_list(%s,%s)', $action,$robot);

    my $directory = "$self->{'dir'}";
    my %list_of_scenario;
    my %skip_scenario;
    my @list_of_scenario_dir;
    if (defined $self->{'admin'}{'family_name'} ) {
	@list_of_scenario_dir = (
	    "$directory/scenari",
	    "$Conf::Conf{'etc'}/$robot/families/$self->{'admin'}{'family_name'}/scenari",
	    "$Conf::Conf{'etc'}/families/$self->{'admin'}{'family_name'}/scenari",
	    "$Conf::Conf{'etc'}/$robot/scenari",
	    "$Conf::Conf{'etc'}/scenari",
	    Sympa::Constants::DEFAULTDIR . '/scenari'
	);
    }else{
	@list_of_scenario_dir = (
	    "$directory/scenari",
	    "$Conf::Conf{'etc'}/$robot/scenari",
	    "$Conf::Conf{'etc'}/scenari",
	    Sympa::Constants::DEFAULTDIR . '/scenari'
	);
    }
    foreach my $dir (@list_of_scenario_dir) {
	next unless (-d $dir);
	
	my $scenario_regexp = &tools::get_regexp('scenario');

	while (<$dir/$action.*:ignore>) {
	    if (/$action\.($scenario_regexp):ignore$/) {
		my $name = $1;
		$skip_scenario{$name} = 1;
	    }
	}

	while (<$dir/$action.*>) {
	    next unless (/$action\.($scenario_regexp)$/);
	    my $name = $1;
	    
	    next if (defined $list_of_scenario{$name});
	    next if (defined $skip_scenario{$name});

	    my $scenario = new Scenario ('robot' => $robot,
					 'directory' => $directory,
					 'function' => $action,
					 'name' => $name);
	    $list_of_scenario{$name} = $scenario;

	    ## Set the title in the current language
	    if (defined  $scenario->{'title'}{&Language::GetLang()}) {
		$list_of_scenario{$name}{'web_title'} = $scenario->{'title'}{&Language::GetLang()};
	    }elsif (defined $scenario->{'title'}{'gettext'}) {
		$list_of_scenario{$name}{'web_title'} = gettext($scenario->{'title'}{'gettext'});
	    }elsif (defined $scenario->{'title'}{'us'}) {
		$list_of_scenario{$name}{'web_title'} = gettext($scenario->{'title'}{'us'});
	    }else {
		$list_of_scenario{$name}{'web_title'} = $name;		     
	    }
	    $list_of_scenario{$name}{'name'} = $name;	    
	}
    }

    ## Return a copy of the data to prevent unwanted changes in the central scenario data structure
    return &tools::dup_var(\%list_of_scenario);
}

sub load_task_list {
    my ($self, $action,$robot) = @_;
    do_log('debug2', 'List::load_task_list(%s,%s)', $action,$robot);

    my $directory = "$self->{'dir'}";
    my %list_of_task;
    
    foreach my $dir (
        "$directory/list_task_models",
        "$Conf::Conf{'etc'}/$robot/list_task_models",
        "$Conf::Conf{'etc'}/list_task_models",
        Sympa::Constants::DEFAULTDIR . '/list_task_models'
    ) {

	next unless (-d $dir);

	foreach my $file (<$dir/$action.*>) {
	    next unless ($file =~ /$action\.(\w+)\.task$/);
	    my $name = $1;
	    
	    next if (defined $list_of_task{$name});
	    
	    $list_of_task{$name}{'name'} = $name;

	    my $titles = &List::_load_task_title ($file);

	    ## Set the title in the current language
	    if (defined  $titles->{&Language::GetLang()}) {
		$list_of_task{$name}{'title'} = $titles->{&Language::GetLang()};
	    }elsif (defined $titles->{'gettext'}) {
		$list_of_task{$name}{'title'} = gettext( $titles->{'gettext'});
	    }elsif (defined $titles->{'us'}) {
		$list_of_task{$name}{'title'} = gettext( $titles->{'us'});		
	    }else {
		$list_of_task{$name}{'title'} = $name;		     
	    }

	}
    }

    return \%list_of_task;
}

sub _load_task_title {
    my $file = shift;
    do_log('debug3', 'List::_load_task_title(%s)', $file);
    my $title = {};

    unless (open TASK, $file) {
	do_log('err', 'Unable to open file "%s"' , $file);
	return undef;
    }

    while (<TASK>) {
	last if /^\s*$/;

	if (/^title\.([\w-]+)\s+(.*)\s*$/) {
	    $title->{$1} = $2;
	}
    }

    close TASK;

    return $title;
}

## Loads all data sources
sub load_data_sources_list {
    my ($self, $robot) = @_;
    do_log('debug3', 'List::load_data_sources_list(%s,%s)', $self->{'name'},$robot);

    my $directory = "$self->{'dir'}";
    my %list_of_data_sources;

    foreach my $dir (
        "$directory/data_sources",
        "$Conf::Conf{'etc'}/$robot/data_sources",
        "$Conf::Conf{'etc'}/data_sources",
        Sympa::Constants::DEFAULTDIR . '/data_sources'
    ) {

	next unless (-d $dir);
	
	while  (my $f = <$dir/*.incl>) {
	    
	    next unless ($f =~ /([\w\-]+)\.incl$/);
	    
	    my $name = $1;
	    
	    next if (defined $list_of_data_sources{$name});
	    
	    $list_of_data_sources{$name}{'title'} = $name;
	    $list_of_data_sources{$name}{'name'} = $name;
	}
    }
    
    return \%list_of_data_sources;
}

## Loads the statistics information
sub _load_stats_file {
    my $file = shift;
    do_log('debug3', 'List::_load_stats_file(%s)', $file);

   ## Create the initial stats array.
   my ($stats, $total, $last_sync, $last_sync_admin_user);
 
   if (open(L, $file)){     
       if (<L> =~ /^(\d+)\s+(\d+)\s+(\d+)\s+(\d+)(\s+(\d+))?(\s+(\d+))?(\s+(\d+))?/) {
	   $stats = [ $1, $2, $3, $4];
	   $total = $6;
	   $last_sync = $8;
	   $last_sync_admin_user = $10;
	   
       } else {
	   $stats = [ 0, 0, 0, 0];
	   $total = 0;
	   $last_sync = 0;
	   $last_sync_admin_user = 0;
       }
       close(L);
   } else {
       $stats = [ 0, 0, 0, 0];
       $total = 0;
       $last_sync = 0;
       $last_sync_admin_user = 0;
   }

   ## Return the array.
   return ($stats, $total, $last_sync, $last_sync_admin_user);
}

## Loads the list of subscribers as a tied hash
sub _load_users {
    my $file = shift;
    do_log('debug2', 'List::_load_users(%s)', $file);

    ## Create the in memory btree using DB_File.
    my %users;
    my @users_list = (&_load_users_file($file)) ;     
    my $btree = new DB_File::BTREEINFO;
    return undef unless ($btree);
    $btree->{'compare'} = \&_compare_addresses;
    $btree->{'cachesize'} = 200 * ( $#users_list + 1 ) ;
    my $ref = tie %users, 'DB_File', undef, O_CREAT|O_RDWR, 0600, $btree;
    return undef unless ($ref);

    ## Counters.
    my $total = 0;

    foreach my $user ( @users_list ) {
	my $email = $user->{'email'};
	unless ($users{$email}) {
	    $total++;
	    $users{$email} = join("\n", %{$user});
	    unless ( defined ( $users{$email} )) { 
		# $btree->{'cachesize'} under-sized
		&do_log('err', '_load_users : cachesise too small : (%d users)', $total);
		return undef;  
	    }
	}
    }

    my $l = {
	'ref'	=>	$ref,
	'users'	=>	\%users,
	'total'	=>	$total
	};
    
    $l;
}

## Loads the list of subscribers.
sub _load_users_file {
    my $file = shift;
    do_log('debug2', 'List::_load_users_file(%s)', $file);
    
    ## Open the file and switch to paragraph mode.
    open(L, $file) || return undef;
    
    ## Process the lines
    local $/;
    my $data = <L>;

    my @users;
    foreach (split /\n\n/, $data) {
	my(%user, $email);
	$user{'email'} = $email = $1 if (/^\s*email\s+(.+)\s*$/om);
	$user{'gecos'} = $1 if (/^\s*gecos\s+(.+)\s*$/om);
	$user{'date'} = $1 if (/^\s*date\s+(\d+)\s*$/om);
	$user{'update_date'} = $1 if (/^\s*update_date\s+(\d+)\s*$/om);
	$user{'reception'} = $1 if (/^\s*reception\s+(digest|nomail|summary|notice|txt|html|urlize|not_me)\s*$/om);
	$user{'visibility'} = $1 if (/^\s*visibility\s+(conceal|noconceal)\s*$/om);

	push @users, \%user;
    }
    close(L);
    
    return @users;
}

## include a remote sympa list as subscribers.
sub _include_users_remote_sympa_list {
    my ($self, $users, $param, $dir, $robot, $default_user_options , $tied) = @_;

    my $host = $param->{'host'};
    my $port = $param->{'port'} || '443';
    my $path = $param->{'path'};
    my $cert = $param->{'cert'} || 'list';

    my $id = Datasource::_get_datasource_id($param);

    do_log('debug', 'List::_include_users_remote_sympa_list(%s) https://%s:%s/%s using cert %s,', $self->{'name'}, $host, $port, $path, $cert);
    
    my $total = 0; 
    my $get_total = 0;

    my $cert_file ; my $key_file ;

    $cert_file = $dir.'/cert.pem';
    $key_file = $dir.'/private_key';
    if ($cert eq 'list') {
	$cert_file = $dir.'/cert.pem';
	$key_file = $dir.'/private_key';
    }elsif($cert eq 'robot') {
	$cert_file = &tools::get_filename('etc',{},'cert.pem',$robot,$self);
	$key_file =  &tools::get_filename('etc',{},'private_key',$robot,$self);
    }
    unless ((-r $cert_file) && ( -r $key_file)) {
	do_log('err', 'Include remote list https://%s:%s/%s using cert %s, unable to open %s or %s', $host, $port, $path, $cert,$cert_file,$key_file);
	return undef;
    }
    
    my $getting_headers = 1;

    my %user ;
    my $email ;


    foreach my $line ( &Fetch::get_https($host,$port,$path,$cert_file,$key_file,{'key_passwd' => $Conf::Conf{'key_passwd'},
                                                                               'cafile'    => $Conf::Conf{'cafile'},
                                                                               'capath' => $Conf::Conf{'capath'}})
		){	
	chomp $line;

	if ($getting_headers) { # ignore http headers
	    next unless ($line =~ /^(date|update_date|email|reception|visibility)/);
	}
	undef $getting_headers;

	if ($line =~ /^\s*email\s+(.+)\s*$/o) {
	    $user{'email'} = $email = $1;
	    do_log('debug',"email found $email");
	    $get_total++;
	}
	$user{'gecos'} = $1 if ($line =~ /^\s*gecos\s+(.+)\s*$/o);
        
  	next unless ($line =~ /^$/) ;
	
	unless ($user{'email'}) {
	    do_log('debug','ignoring block without email definition');
	    next;
	}
	my %u;
	## Check if user has already been included
	if ($users->{$email}) {
	    do_log('debug3',"ignore $email because already member");
	    if ($tied) {
		%u = split "\n",$users->{$email};
	    }else {
		%u = %{$users->{$email}};
	    }
	}else{
	    do_log('debug3',"add new subscriber $email");
	    %u = %{$default_user_options};
	    $total++;
	}	    
	$u{'email'} = $user{'email'};
	$u{'id'} = join (',', split(',', $u{'id'}), $id);
	$u{'gecos'} = $user{'gecos'};delete $user{'gecos'};
	
	$u{'visibility'} = $default_user_options->{'visibility'} if (defined $default_user_options->{'visibility'});
	$u{'reception'} = $default_user_options->{'reception'} if (defined $default_user_options->{'reception'});
	$u{'profile'} = $default_user_options->{'profile'} if (defined $default_user_options->{'profile'});
	$u{'info'} = $default_user_options->{'info'} if (defined $default_user_options->{'info'});
	
	if ($tied) {
	    $users->{$email} = join("\n", %u);
	}else{
	    $users->{$email} = \%u;
	}
	delete $user{$email};undef $email;

    }
    do_log('info','Include %d users from list (%d subscribers) https://%s:%s%s',$total,$get_total,$host,$port,$path);
    return $total ;    
}



## include a list as subscribers.
sub _include_users_list {
    my ($users, $includelistname, $robot, $default_user_options, $tied) = @_;
    do_log('debug2', 'List::_include_users_list');

    my $total = 0;
    
    my $includelist;
    
    ## The included list is local or in another local robot
    if ($includelistname =~ /\@/) {
	$includelist = new List ($includelistname);
    }else {
	$includelist = new List ($includelistname, $robot);
    }

    unless ($includelist) {
	do_log('info', 'Included list %s unknown' , $includelistname);
	return undef;
    }
    
    my $id = Datasource::_get_datasource_id($includelistname);

    for (my $user = $includelist->get_first_user(); $user; $user = $includelist->get_next_user()) {
	my %u;

	## Check if user has already been included
	if ($users->{$user->{'email'}}) {
	    if ($tied) {
		%u = split "\n",$users->{$user->{'email'}};
	    }else {
		%u = %{$users->{$user->{'email'}}};
	    }
	}else {
	    %u = %{$default_user_options};
	    $total++;
	}
	    
	my $email =  $u{'email'} = $user->{'email'};
	$u{'gecos'} = $user->{'gecos'};
	$u{'id'} = join (',', split(',', $u{'id'}), $id);

	$u{'visibility'} = $default_user_options->{'visibility'} if (defined $default_user_options->{'visibility'});
	$u{'reception'} = $default_user_options->{'reception'} if (defined $default_user_options->{'reception'});
	$u{'profile'} = $default_user_options->{'profile'} if (defined $default_user_options->{'profile'});
	$u{'info'} = $default_user_options->{'info'} if (defined $default_user_options->{'info'});

	if ($tied) {
	    $users->{$email} = join("\n", %u);
	}else {
	    $users->{$email} = \%u;
	}
    }
    do_log('info',"Include %d users from list %s",$total,$includelistname);
    return $total ;
}

## include a lists owners lists privileged_owners or lists_editors.
sub _include_users_admin {
    my ($users, $selection, $role, $default_user_options,$tied) = @_;
#   il faut préparer une liste de hash avec le nom de liste, le nom de robot, le répertoire de la liset pour appeler
#    load_admin_file décommanter le include_admin
    my $lists;
    
    unless ($role eq 'listmaster') {
	
	if ($selection =~ /^\*\@(\S+)$/) {
	    $lists = &get_lists($1);
	    my $robot = $1;
	}else{
	    $selection =~ /^(\S+)@(\S+)$/ ;
	    $lists->[0] = $1;
	}
	
	foreach my $list (@$lists) {
	    #my $admin = _load_admin_file($dir, $domain, 'config');
	}
    }
}
    
sub _include_users_file {
    my ($users, $filename, $default_user_options,$tied) = @_;
    do_log('debug2', 'List::_include_users_file(%s)', $filename);

    my $total = 0;
    
    unless (open(INCLUDE, "$filename")) {
	do_log('err', 'Unable to open file "%s"' , $filename);
	return undef;
    }
    do_log('debug2','including file %s' , $filename);

    my $id = Datasource::_get_datasource_id($filename);
    my $lines = 0;
    my $emails_found = 0;
    my $email_regexp = &tools::get_regexp('email');
    
    while (<INCLUDE>) {
	if($lines > 49 && $emails_found == 0){
	    &do_log('err','Too much errors in file %s (%s lines, %s emails found). Source file probably corrupted. Cancelling.',$filename, $lines, $emails_found);
	    return undef;
	}
	next if /^\s*$/;
	next if /^\s*\#/;

	unless (/^\s*($email_regexp)(\s*(\S.*))?\s*$/) {
	    &do_log('err', 'Not an email address: %s', $_);
	}

	my $email = &tools::clean_email($1);
        $lines++;
	next unless $email;
	my $gecos = $5;
	$emails_found++;

	my %u;
	## Check if user has already been included
	if ($users->{$email}) {
	    if ($tied) {
		%u = split "\n",$users->{$email};
	    }else {
		%u = %{$users->{$email}};
	    }
	}else {
	    %u = %{$default_user_options};
	    $total++;
	}
	$u{'email'} = $email;
	$u{'gecos'} = $gecos;
	$u{'id'} = join (',', split(',', $u{'id'}), $id);

	$u{'visibility'} = $default_user_options->{'visibility'} if (defined $default_user_options->{'visibility'});
	$u{'reception'} = $default_user_options->{'reception'} if (defined $default_user_options->{'reception'});
	$u{'profile'} = $default_user_options->{'profile'} if (defined $default_user_options->{'profile'});
	$u{'info'} = $default_user_options->{'info'} if (defined $default_user_options->{'info'});

	if ($tied) {
	    $users->{$email} = join("\n", %u);
	}else {
	    $users->{$email} = \%u;
	}
    }
    close INCLUDE ;
    
    
    do_log('info',"include %d new users from file %s",$total,$filename);
    return $total ;
}
    
sub _include_users_remote_file {
    my ($users, $param, $default_user_options,$tied) = @_;

    my $url = $param->{'url'};
    
    do_log('debug', "List::_include_users_remote_file($url)");

    my $total = 0;
    my $id = Datasource::_get_datasource_id($param);

    ## WebAgent package is part of Fetch.pm and inherites from LWP::UserAgent

    my $fetch = WebAgent->new (agent => 'Sympa/'. Sympa::Constants::VERSION);

    my $req = HTTP::Request->new(GET => $url);
    
    if (defined $param->{'user'} && defined $param->{'passwd'}) {
	&WebAgent::set_basic_credentials($param->{'user'},$param->{'passwd'});
    }

    my $res = $fetch->request($req);  

    # check the outcome
    if ($res->is_success) {
	my @remote_file = split(/\n/,$res->content);
	my $lines = 0;
	my $emails_found = 0;
	my $email_regexp = &tools::get_regexp('email');

	# forgot headers (all line before one that contain a email
	foreach my $line (@remote_file) {
	    if($lines > 49 && $emails_found == 0){
		&do_log('err','Too much errors in file %s (%s lines, %s emails found). Source file probably corrupted. Cancelling.',$url, $lines, $emails_found);
		return undef;
	    }
	    next if ($line =~ /^\s*$/);
	    next if ($line =~ /^\s*\#/);

	    unless ( $line =~ /^\s*($email_regexp)(\s*(\S.*))?\s*$/) {
		&do_log('err', 'Not an email address: %s', $_);
	    }     
	    my $email = &tools::clean_email($1);
	    $lines++;
	    next unless $email;
	    my $gecos = $5;		
	    $emails_found++;

	    my %u;
	    ## Check if user has already been included
	    if ($users->{$email}) {
		if ($tied) {
		    %u = split "\n",$users->{$email};
		}else{
		    %u = %{$users->{$email}};
		    foreach my $k (keys %u) {
		    }
		}
	    }else {
		%u = %{$default_user_options};
		$total++;
	    }
	    $u{'email'} = $email;
	    $u{'gecos'} = $gecos;
	    $u{'id'} = join (',', split(',', $u{'id'}), $id);
	    
	    $u{'visibility'} = $default_user_options->{'visibility'} if (defined $default_user_options->{'visibility'});
	    $u{'reception'} = $default_user_options->{'reception'} if (defined $default_user_options->{'reception'});
	    $u{'profile'} = $default_user_options->{'profile'} if (defined $default_user_options->{'profile'});
	    $u{'info'} = $default_user_options->{'info'} if (defined $default_user_options->{'info'});
	    
	    if ($tied) {
		$users->{$email} = join("\n", %u);
	    }else {
		$users->{$email} = \%u;
	    }
	}
    }
    else {
	do_log ('err',"List::include_users_remote_file: Unable to fetch remote file $url : %s", $res->message());
	return undef; 
    }

    ## Reset http credentials
    &WebAgent::set_basic_credentials('','');

    do_log('info',"include %d new subscribers from remote file %s",$total,$url);
    return $total ;
}


## Returns a list of subscribers extracted from a remote LDAP Directory
sub _include_users_ldap {
    my ($users, $param, $default_user_options, $tied) = @_;
    do_log('debug2', 'List::_include_users_ldap');
    
    my $id = Datasource::_get_datasource_id($param);

    my $user = $param->{'user'};
    my $passwd = $param->{'passwd'};
    my $ldap_suffix = $param->{'suffix'};
    my $ldap_filter = $param->{'filter'};
    my $ldap_attrs = $param->{'attrs'};
    my $ldap_select = $param->{'select'};
    
    ## LDAP and query handler
    my ($ldaph, $fetch);

    ## Connection timeout (default is 120)
    #my $timeout = 30; 
    
    my $param2 = &tools::dup_var($param);
    my $ds = new Datasource('LDAP', $param2);
    if (defined $user) {
	$param2->{'bind_dn'} = $user;
	$param2->{'bind_password'} = $passwd;
    }
    
    unless (defined $ds && ($ldaph = $ds->connect())) {
	&do_log('err',"Unable to connect to the LDAP server '%s'", $param2->{'host'});
	    return undef;
	}
    
    do_log('debug2', 'Searching on server %s ; suffix %s ; filter %s ; attrs: %s', $param->{'host'}, $ldap_suffix, $ldap_filter, $ldap_attrs);
    $fetch = $ldaph->search ( base => "$ldap_suffix",
			      filter => "$ldap_filter",
			      attrs => [ "$ldap_attrs" ],
			      scope => "$param->{'scope'}");
    if ($fetch->code()) {
	do_log('err','Ldap search (single level) failed : %s (searching on server %s ; suffix %s ; filter %s ; attrs: %s)', 
	       $fetch->error(), $param->{'host'}, $ldap_suffix, $ldap_filter, $ldap_attrs);
        return undef;
    }
    
    ## Counters.
    my $total = 0;
    my $dn; 
    my @emails;
    my %emailsViewed;

    while (my $e = $fetch->shift_entry) {

	my $entry = $e->get_value($ldap_attrs, asref => 1);
	
	## Multiple values
	if (ref($entry) eq 'ARRAY') {
	    foreach my $email (@{$entry}) {
		my $cleanmail = &tools::clean_email($email);
		next if ($emailsViewed{$cleanmail});
		push @emails, $cleanmail;
		$emailsViewed{$cleanmail} = 1;
		last if ($ldap_select eq 'first');
	    }
	}else {
	    my $cleanmail = &tools::clean_email($entry);
	    unless ($emailsViewed{$cleanmail}) {
		push @emails, $cleanmail;
		$emailsViewed{$cleanmail} = 1;
	    }
	}
    }
    
    unless ($ds->disconnect()) {
	do_log('notice','Can\'t unbind from  LDAP server %s', $param->{'host'});
	return undef;
    }
    
    foreach my $email (@emails) {
	next if ($email =~ /^\s*$/);

	$email = &tools::clean_email($email);
	my %u;
	## Check if user has already been included
	if ($users->{$email}) {
	    if ($tied) {
		%u = split "\n",$users->{$email};
	    }else {
		%u = %{$users->{$email}};
	    }
	}else {
	    %u = %{$default_user_options};
	    $total++;
	}

	$u{'email'} = $email;
	$u{'date'} = time;
	$u{'update_date'} = time;
	$u{'id'} = join (',', split(',', $u{'id'}), $id);

	$u{'visibility'} = $default_user_options->{'visibility'} if (defined $default_user_options->{'visibility'});
	$u{'reception'} = $default_user_options->{'reception'} if (defined $default_user_options->{'reception'});
	$u{'profile'} = $default_user_options->{'profile'} if (defined $default_user_options->{'profile'});
	$u{'info'} = $default_user_options->{'info'} if (defined $default_user_options->{'info'});

	if ($tied) {
	    $users->{$email} = join("\n", %u);
	}else {
	    $users->{$email} = \%u;
	}
    }

    do_log('debug2',"unbinded from LDAP server %s ", $param->{'host'});
    do_log('info','%d new users included from LDAP query',$total);

    return $total;
}

## Returns a list of subscribers extracted indirectly from a remote LDAP
## Directory using a two-level query
sub _include_users_ldap_2level {
    my ($users, $param, $default_user_options,$tied) = @_;
    do_log('debug2', 'List::_include_users_ldap_2level');
    
    unless (eval "require Net::LDAP") {
	do_log('err',"Unable to use LDAP library, install perl-ldap (CPAN) first");
	return undef;
    }
    require Net::LDAP;

    my $id = Datasource::_get_datasource_id($param);

    my $user = $param->{'user'};
    my $passwd = $param->{'passwd'};
    my $ldap_suffix1 = $param->{'suffix1'};
    my $ldap_filter1 = $param->{'filter1'};
    my $ldap_attrs1 = $param->{'attrs1'};
    my $ldap_select1 = $param->{'select1'};
    my $ldap_scope1 = $param->{'scope1'};
    my $ldap_regex1 = $param->{'regex1'};
    my $ldap_suffix2 = $param->{'suffix2'};
    my $ldap_filter2 = $param->{'filter2'};
    my $ldap_attrs2 = $param->{'attrs2'};
    my $ldap_select2 = $param->{'select2'};
    my $ldap_scope2 = $param->{'scope2'};
    my $ldap_regex2 = $param->{'regex2'};
    my @sync_errors = ();
    
    ## LDAP and query handler
    my ($ldaph, $fetch);

    my $param2 = &tools::dup_var($param);
    my $ds = new Datasource('LDAP', $param2);
    if (defined $user) {
	$param2->{'bind_dn'} = $user;
	$param2->{'bind_password'} = $passwd;
    }
    
    unless (defined $ds && ($ldaph = $ds->connect())) {
	&do_log('err',"Unable to connect to the LDAP server '%s'", $param2->{'host'});
	    return undef;
	}
    
    do_log('debug2', 'Searching on server %s ; suffix %s ; filter %s ; attrs: %s', $param->{'host'}, $ldap_suffix1, $ldap_filter1, $ldap_attrs1) ;
    $fetch = $ldaph->search ( base => "$ldap_suffix1",
			      filter => "$ldap_filter1",
			      attrs => [ "$ldap_attrs1" ],
			      scope => "$ldap_scope1");
    if ($fetch->code()) {
	do_log('err','LDAP search (1st level) failed : %s (searching on server %s ; suffix %s ; filter %s ; attrs: %s)', 
	       $fetch->error(), $param2->{'host'}, $ldap_suffix1, $ldap_filter1, $ldap_attrs1);
        return undef;
    }
    
    ## Counters.
    my $total = 0;
    my $dn; 
   
    ## returns a reference to a HASH where the keys are the DNs
    ##  the second level hash's hold the attributes

    my (@attrs, @emails);
 
    while (my $e = $fetch->shift_entry) {
	my $entry = $e->get_value($ldap_attrs1, asref => 1);
	## Multiple values
	if (ref($entry) eq 'ARRAY') {
	    foreach my $attr (@{$entry}) {
		next if (($ldap_select1 eq 'regex') && ($attr !~ /$ldap_regex1/));
		push @attrs, $attr;
		last if ($ldap_select1 eq 'first');
	    }
	}else {
	    push @attrs, $entry
		unless (($ldap_select1 eq 'regex') && ($entry !~ /$ldap_regex1/));
	}
    }

    my %emailsViewed;

    my ($suffix2, $filter2);
    foreach my $attr (@attrs) {
	# Escape LDAP characters occurring in attribute
	my $escaped_attr = $attr;
	$escaped_attr =~ s/([\\\(\*\)\0])/sprintf "\\%02X", ord($1)/eg;

	($suffix2 = $ldap_suffix2) =~ s/\[attrs1\]/$escaped_attr/g;
	($filter2 = $ldap_filter2) =~ s/\[attrs1\]/$escaped_attr/g;

	do_log('debug2', 'Searching on server %s ; suffix %s ; filter %s ; attrs: %s', $param->{'host'}, $suffix2, $filter2, $ldap_attrs2);
	$fetch = $ldaph->search(
	    base => "$suffix2",
	    filter => "$filter2",
	    attrs => [ "$ldap_attrs2" ], # FIXME: multiple attrs?
	    scope => "$ldap_scope2"
	);
	if ($fetch->code()) {
	    do_log('err','LDAP search (2nd level) failed : %s. Node: %s (searching on server %s ; suffix %s ; filter %s ; attrs: %s)', 
		   $fetch->error(), $attr, $param->{'host'}, $suffix2, $filter2, $ldap_attrs2);
	    push @sync_errors, {'error',$fetch->error(), 'host', $param->{'host'}, 'suffix2', $suffix2, 'fliter2', $filter2,'ldap_attrs2', $ldap_attrs2};
	}

	## returns a reference to a HASH where the keys are the DNs
	##  the second level hash's hold the attributes
	
	while (my $e = $fetch->shift_entry) {
	    my $entry = $e->get_value($ldap_attrs2, asref => 1);

	    ## Multiple values
	    if (ref($entry) eq 'ARRAY') {
		foreach my $email (@{$entry}) {
		    my $cleanmail = &tools::clean_email($email);
		    next if (($ldap_select2 eq 'regex') && ($cleanmail !~ /$ldap_regex2/));
		    next if ($emailsViewed{$cleanmail});
		    push @emails, $cleanmail;
		    $emailsViewed{$cleanmail} = 1;
		    last if ($ldap_select2 eq 'first');
		}
	    }else {
		my $cleanmail = &tools::clean_email($entry);
		unless( (($ldap_select2 eq 'regex') && ($cleanmail !~ /$ldap_regex2/))||$emailsViewed{$cleanmail}) {
		    push @emails, $cleanmail;
		    $emailsViewed{$cleanmail} = 1;
		}
	    }
	}
    }
    
    unless ($ds->disconnect()) {
	do_log('err','Can\'t unbind from  LDAP server %s', $param->{'host'});
	return undef;
    }
    
    foreach my $email (@emails) {
	next if ($email =~ /^\s*$/);

	$email = &tools::clean_email($email);
	my %u;
	## Check if user has already been included
	if ($users->{$email}) {
	    if ($tied) {
		%u = split "\n",$users->{$email};
	    }else {
		%u = %{$users->{$email}};
	    }
	}else {
	    %u = %{$default_user_options};
	    $total++;
	}

	$u{'email'} = $email;
	$u{'date'} = time;
	$u{'update_date'} = time;
	$u{'id'} = join (',', split(',', $u{'id'}), $id);

	$u{'visibility'} = $default_user_options->{'visibility'} if (defined $default_user_options->{'visibility'});
	$u{'reception'} = $default_user_options->{'reception'} if (defined $default_user_options->{'reception'});
	$u{'profile'} = $default_user_options->{'profile'} if (defined $default_user_options->{'profile'});
	$u{'info'} = $default_user_options->{'info'} if (defined $default_user_options->{'info'});

	if ($tied) {
	    $users->{$email} = join("\n", %u);
	}else {
	    $users->{$email} = \%u;
	}
    }

    do_log('debug2',"unbinded from LDAP server %s ", $param->{'host'}) ;
    do_log('info','%d new users included from LDAP query',$total);

    my $result;
    $result->{'total'} = $total;
    if ($#sync_errors > -1) {$result->{'errors'} = \@sync_errors;}
    return $result;
}

## Returns a list of subscribers extracted from an remote Database
sub _include_users_sql {
    my ($users, $param, $default_user_options, $tied, $fetch_timeout) = @_;

    &do_log('debug2','List::_include_users_sql()');

    my $id = Datasource::_get_datasource_id($param);
    my $ds = new Datasource('SQL', $param);
    unless ($ds->connect && ($ds->query($param->{'sql_query'}))) {
        return undef;
    }
    ## Counters.
    my $total = 0;
    
    ## Process the SQL results
    $ds->set_fetch_timeout($fetch_timeout);
    my $array_of_users = $ds->fetch;
	
    unless (defined $array_of_users && ref($array_of_users) eq 'ARRAY') {
	&do_log('err', 'Failed to include users from ',$param->{'name'});
	return undef;
    }

    foreach my $row (@{$array_of_users}) {
	my $email = $row->[0]; ## only get first field
	## Empty value
	next if ($email =~ /^\s*$/);

	$email = &tools::clean_email($email);
	my %u;
	## Check if user has already been included
	if ($users->{$email}) {
	    if ($tied eq 'tied') {
		%u = split "\n",$users->{$email};
	    }else {
		%u = %{$users->{$email}};
	    }
	}else {
	    %u = %{$default_user_options};
	    $total++;
	}

	$u{'email'} = $email;
	$u{'date'} = time;
	$u{'update_date'} = time;
	$u{'id'} = join (',', split(',', $u{'id'}), $id);

	$u{'visibility'} = $default_user_options->{'visibility'} if (defined $default_user_options->{'visibility'});
	$u{'reception'} = $default_user_options->{'reception'} if (defined $default_user_options->{'reception'});
	$u{'profile'} = $default_user_options->{'profile'} if (defined $default_user_options->{'profile'});
	$u{'info'} = $default_user_options->{'info'} if (defined $default_user_options->{'info'});

	if ($tied eq 'tied') {
	    $users->{$email} = join("\n", %u);
	}else {
	    $users->{$email} = \%u;
	}
    }
    $ds->disconnect();
    
    do_log('info','%d included users from SQL query', $total);
    return $total;
}

## Loads the list of subscribers from an external include source
sub _load_users_include {
    my $self = shift;
    my $db_file = shift;
    my $use_cache = shift;
    my $name = $self->{'name'}; 
    my $admin = $self->{'admin'};
    my $dir = $self->{'dir'};
    do_log('debug2', '(%s, %s, %s)', $name, $db_file, $use_cache);

    my (%users, $depend_on, $ref);
    my $total = 0;

    ## Create in memory btree using DB_File.
    my $btree = new DB_File::BTREEINFO;
    return undef unless ($btree);
    $btree->{'compare'} = \&_compare_addresses;

    if (!$use_cache && (-f $db_file)) {
        rename $db_file, $db_file.'old';
    }

    unless ($use_cache) {
	unless ($ref = tie %users, 'DB_File', $db_file, O_CREAT|O_RDWR, 0600, $btree) {
	    &do_log('err', '(no cache) Could not tie to DB_File %s',$db_file);
	    return undef;
	}

	## Lock DB_File
	my $fd = $ref->fd;

	unless (open DB_FH, "+<&$fd") {
	    &do_log('err', 'Cannot open %s: %s', $db_file, $!);
	    return undef;
	}
	unless (flock (DB_FH, LOCK_EX | LOCK_NB)) {
	    &do_log('notice','Waiting for writing lock on %s', $db_file);
	    unless (flock (DB_FH, LOCK_EX)) {
		&do_log('err', 'Failed locking %s: %s', $db_file, $!);
		return undef;
	    }
	}
	&do_log('debug3', 'Got lock for writing on %s', $db_file);

	foreach my $type ('include_list','include_remote_sympa_list','include_file','include_ldap_query','include_ldap_2level_query','include_sql_query','include_remote_file') {
	    last unless (defined $total);
	    
	    foreach my $tmp_incl (@{$admin->{$type}}) {
		my $included;
		
		## Work with a copy of admin hash branch to avoid including temporary variables into the actual admin hash.[bug #3182]
		my $incl = &tools::dup_var($tmp_incl);

		## get the list of users
		if ($type eq 'include_sql_query') {
		    $included = _include_users_sql(\%users, $incl, $admin->{'default_user_options'}, 'tied', $admin->{'sql_fetch_timeout'});
		}elsif ($type eq 'include_ldap_query') {
		    $included = _include_users_ldap(\%users, $incl, $admin->{'default_user_options'}, 'tied');
		}elsif ($type eq 'include_ldap_2level_query') {
		    my $result = _include_users_ldap_2level(\%users, $incl, $admin->{'default_user_options'}, 'tied');
		    if (defined $result) {
			$included = $result->{'total'};
			if (defined $result->{'errors'}){
			    &do_log('err', 'Errors occurred during the second LDAP passe for list %s, source "%s"', $self->{'name'}, );
			}
		    }else{
			$included = undef;
		    }
		}elsif ($type eq 'include_list') {
		    $depend_on->{$name} = 1 ;
		    if (&_inclusion_loop ($name,$incl,$depend_on)) {
			do_log('err','loop detection in list inclusion : could not include again %s in %s',$incl,$name);
		    }else{
			$depend_on->{$incl} = 1;
			$included = _include_users_list (\%users, $incl, $self->{'domain'}, $admin->{'default_user_options'}, 'tied');

		    }
		}elsif ($type eq 'include_remote_sympa_list') {
		    $included = $self->_include_users_remote_sympa_list(\%users, $incl, $dir, $self->{'domain'}, $admin->{'default_user_options'}, 'tied');
		}elsif ($type eq 'include_file') {
		    $included = _include_users_file (\%users, $incl, $admin->{'default_user_options'}, 'tied');
		}elsif ($type eq 'include_remote_file') {
		    $included = _include_users_remote_file (\%users, $incl, $admin->{'default_user_options'}, 'tied');
		}
		unless (defined $included) {
		    &do_log('err', 'Inclusion %s failed in list %s', $type, $name);
		    next;
		}
		
		$total += $included;
	    }
	}
  
	## Unlock
	$ref->sync;
	flock(DB_FH,LOCK_UN);
	&do_log('debug3', 'Release lock on %s', $db_file);
	undef $ref;
	untie %users;
	close DB_FH;
	
	unless (defined $total) {
	    if (-f $db_file.'old') {
	        unlink $db_file;
		rename $db_file.'old', $db_file;
		$total = 0;
	    }
	}
    }

    unless ($ref = tie %users, 'DB_File', $db_file, O_CREAT|O_RDWR, 0600, $btree) {
	&do_log('err', '(use cache) Could not tie to DB_File %s',$db_file);
	return undef;
    }

    ## Lock DB_File
    my $fd = $ref->fd;
    unless (open DB_FH, "+<&$fd") {
	&do_log('err', 'Cannot open %s: %s', $db_file, $!);
	return undef;
    }
    unless (flock (DB_FH, LOCK_SH | LOCK_NB)) {
	&do_log('notice','Waiting for reading lock on %s', $db_file);
	unless (flock (DB_FH, LOCK_SH)) {
	    &do_log('err', 'Failed locking %s: %s', $db_file, $!);
	    return undef;
	}
    }
    &do_log('debug3', 'Got lock for reading on %s', $db_file);

    ## Unlock DB_file
    flock(DB_FH,LOCK_UN);
    &do_log('debug3', 'Release lock on %s', $db_file);
    
    ## Inclusion failed, clear cache
    unless (defined $total) {
	undef $ref;
	#untie %users;
	close DB_FH;
	unlink $db_file;
	return undef;
    }

    my $l = {	 'ref'    => $ref,
		 'users'  => \%users
	     };
    $l->{'total'} = $total
	if $total;

    undef $ref;
    #untie %users;
    close DB_FH;
    $l;
}

## Loads the list of subscribers from an external include source
sub _load_users_include2 {
    my $self = shift;
    my $name = $self->{'name'}; 
    my $admin = $self->{'admin'};
    my $dir = $self->{'dir'};
    do_log('debug2', 'List::_load_users_include for list %s',$name);
    my (%users, $depend_on, $ref);
    my $total = 0;
    my @errors;
    my $result;

    foreach my $type ('include_list','include_remote_sympa_list','include_file','include_ldap_query','include_ldap_2level_query','include_sql_query','include_remote_file') {
	last unless (defined $total);
	    
	foreach my $tmp_incl (@{$admin->{$type}}) {
	    my $included;
	    ## Work with a copy of admin hash branch to avoid including temporary variables into the actual admin hash.[bug #3182]
	    my $incl = &tools::dup_var($tmp_incl);

	    ## get the list of users
	    if ($type eq 'include_sql_query') {
		$included = _include_users_sql(\%users, $incl, $admin->{'default_user_options'}, 'untied', $admin->{'sql_fetch_timeout'});
		unless (defined $included){
		    push @errors, {'type' => $type, 'name' => $incl->{'name'}};
		}
	    }elsif ($type eq 'include_ldap_query') {
		$included = _include_users_ldap(\%users, $incl, $admin->{'default_user_options'});
		unless (defined $included){
		    push @errors, {'type' => $type, 'name' => $incl->{'name'}};
		}
	    }elsif ($type eq 'include_ldap_2level_query') {
		my $result = _include_users_ldap_2level(\%users, $incl, $admin->{'default_user_options'});
		if (defined $result) {
		    $included = $result->{'total'};
		    if (defined $result->{'errors'}){
			&do_log('err', 'Errors occurred during the second LDAP passe');
			push @errors, {'type' => $type, 'name' => $incl->{'name'}};
		    }
		}else{
		    $included = undef;
		    push @errors, {'type' => $type, 'name' => $incl->{'name'}};
		}
	    }elsif ($type eq 'include_remote_sympa_list') {
		$included = $self->_include_users_remote_sympa_list(\%users, $incl, $dir, $self->{'domain'}, $admin->{'default_user_options'});
		unless (defined $included){
		    push @errors, {'type' => $type, 'name' => $incl->{'name'}};
		}
	    }elsif ($type eq 'include_list') {
		$depend_on->{$name} = 1 ;
		if (&_inclusion_loop ($name,$incl,$depend_on)) {
		    do_log('err','loop detection in list inclusion : could not include again %s in %s',$incl,$name);
		}else{
		    $depend_on->{$incl} = 1;
		    $included = _include_users_list (\%users, $incl, $self->{'domain'}, $admin->{'default_user_options'});
		    unless (defined $included){
			push @errors, {'type' => $type, 'name' => $incl};
		    }
		}
	    }elsif ($type eq 'include_file') {
		$included = _include_users_file (\%users, $incl, $admin->{'default_user_options'});
		unless (defined $included){
		    push @errors, {'type' => $type, 'name' => $incl};
		}
	    }elsif ($type eq 'include_remote_file') {
		$included = _include_users_remote_file (\%users, $incl, $admin->{'default_user_options'});
		unless (defined $included){
		    push @errors, {'type' => $type, 'name' => $incl->{'name'}};
		}
	    }
	    unless (defined $included) {
		&do_log('err', 'Inclusion %s failed in list %s', $type, $name);
		next;
	    }
	    $total += $included;
	}
    }

    ## If an error occurred, return an undef value
    $result->{'users'} = \%users;
    $result->{'errors'} = \@errors;
    return $result;
}

## Loads the list of admin users from an external include source
sub _load_admin_users_include {
    my $self = shift;
    my $role = shift;
    my $name = $self->{'name'};
   
    &do_log('debug2', 'List::_load_admin_users_include(%s) for list %s',$role, $name); 

    my (%admin_users, $depend_on, $ref);
    my $total = 0;
    my $list_admin = $self->{'admin'};
    my $dir = $self->{'dir'};

    foreach my $entry (@{$list_admin->{$role."_include"}}) {
    
	next unless (defined $entry); 

	my %option;
	$option{'reception'} = $entry->{'reception'} if (defined $entry->{'reception'});
	$option{'visibility'} = $entry->{'visibility'} if (defined $entry->{'visibility'});
	$option{'profile'} = $entry->{'profile'} if (defined $entry->{'profile'} && ($role eq 'owner'));
	

      	my $include_file = &tools::get_filename('etc',{},"data_sources/$entry->{'source'}\.incl",$self->{'domain'},$self);

        unless (defined $include_file){
	    &do_log('err', '_load_admin_users_include : the file %s.incl doesn\'t exist',$entry->{'source'});
	    return undef;
	}

	my $include_admin_user;
	## the file has parameters
	if (defined $entry->{'source_parameters'}) {
	    my %parsing;
	    
	    $parsing{'data'} = $entry->{'source_parameters'};
	    $parsing{'template'} = "$entry->{'source'}\.incl";
	    
	    my $name = "$entry->{'source'}\.incl";
	    
	    my $include_path = $include_file;
	    if ($include_path =~ s/$name$//) {
		$parsing{'include_path'} = $include_path;
		$include_admin_user = &_load_include_admin_user_file($self->{'domain'},$include_path,\%parsing);	
	    } else {
		&do_log('err', '_load_admin_users_include : errors to get path of the the file %s.incl',$entry->{'source'});
		return undef;
	    }
	    
	    
	} else {
	    $include_admin_user = &_load_include_admin_user_file($self->{'domain'},$include_file);
	}
	foreach my $type ('include_list','include_remote_sympa_list','include_file','include_ldap_query','include_ldap_2level_query','include_sql_query','include_remote_file') {
	    last unless (defined $total);
	    
	    foreach my $tmp_incl (@{$include_admin_user->{$type}}) {
		my $included;
		
		## Work with a copy of admin hash branch to avoid including temporary variables into the actual admin hash.[bug #3182]
		my $incl = &tools::dup_var($tmp_incl);

		## get the list of admin users
		## does it need to define a 'default_admin_user_option'?
		if ($type eq 'include_sql_query') {
		    $included = _include_users_sql(\%admin_users, $incl,\%option, 'untied', $list_admin->{'sql_fetch_timeout'}); 
		}elsif ($type eq 'include_ldap_query') {
		    $included = _include_users_ldap(\%admin_users, $incl,\%option); 
		}elsif ($type eq 'include_ldap_2level_query') {
		    my $result = _include_users_ldap_2level(\%admin_users, $incl,\%option); 
		    if (defined $result) {
			$included = $result->{'total'};
			if (defined $result->{'errors'}){
			    &do_log('err', 'Errors occurred during the second LDAP passe. Please verify your LDAP query.');
			}
		    }else{
			$included = undef;
		    }
		}elsif ($type eq 'include_remote_sympa_list') {
		    $included = $self->_include_users_remote_sympa_list(\%admin_users, $incl, $dir, $self->{'domain'}, \%option);
		}elsif ($type eq 'include_list') {
		    $depend_on->{$name} = 1 ;
		    if (&_inclusion_loop ($name,$incl,$depend_on)) {
			do_log('err','loop detection in list inclusion : could not include again %s in %s',$incl,$name);
		    }else{
			$depend_on->{$incl} = 1;
			$included = _include_users_list (\%admin_users, $incl, $self->{'domain'}, \%option);
		    }
		}elsif ($type eq 'include_file') {
		    $included = _include_users_file (\%admin_users, $incl, \%option);
		}elsif ($type eq 'include_remote_file') {
		    $included = _include_users_remote_file (\%admin_users, $incl, \%option);
		}
		unless (defined $included) {
		    &do_log('err', 'Inclusion %s %s failed in list %s', $role, $type, $name);
		    next;
		}
		$total += $included;
	    }
	}

	## If an error occurred, return an undef value
	unless (defined $total) {
	    return undef;
	}
    }
   
    return \%admin_users;
}


# Load an include admin user file (xx.incl)
sub _load_include_admin_user_file {
    my ($robot, $file, $parsing) = @_;
    &do_log('debug2', 'List::_load_include_admin_user_file(%s,%s)',$robot, $file); 
    
    my %include;
    my (@paragraphs);
    
    # the file has parmeters
    if (defined $parsing) {
	my @data = split(',',$parsing->{'data'});
        my $vars = {'param' => \@data};
	my $output = '';
	
	unless (&tt2::parse_tt2($vars,$parsing->{'template'},\$output,[$parsing->{'include_path'}])) {
	    &do_log('err', 'Failed to parse %s', $parsing->{'template'});
	    return undef;
	}
	
	my @lines = split('\n',$output);
	
	my $i = 0;
	foreach my $line (@lines) {
	    if ($line =~ /^\s*$/) {
		$i++ if $paragraphs[$i];
	    }else {
		push @{$paragraphs[$i]}, $line;
	    }
	}
    } else {
	unless (open INCLUDE, $file) {
	    &do_log('info', 'Cannot open %s', $file);
	}
	
	## Just in case...
	local $/ = "\n";
	
	## Split in paragraphs
	my $i = 0;
	while (<INCLUDE>) {
	    if (/^\s*$/) {
		$i++ if $paragraphs[$i];
	    }else {
		push @{$paragraphs[$i]}, $_;
	    }
	}
	close INCLUDE;
    }
    
    for my $index (0..$#paragraphs) {
	my @paragraph = @{$paragraphs[$index]};
	
	my $pname;
	
	## Clean paragraph, keep comments
	for my $i (0..$#paragraph) {
	    my $changed = undef;
	    for my $j (0..$#paragraph) {
		if ($paragraph[$j] =~ /^\s*\#/) {
		    chomp($paragraph[$j]);
		    push @{$include{'comment'}}, $paragraph[$j];
		    splice @paragraph, $j, 1;
		    $changed = 1;
		}elsif ($paragraph[$j] =~ /^\s*$/) {
		    splice @paragraph, $j, 1;
		    $changed = 1;
		}
		
		last if $changed;
	    }
	    
	    last unless $changed;
	}
	
	## Empty paragraph
	next unless ($#paragraph > -1);
	
	## Look for first valid line
	unless ($paragraph[0] =~ /^\s*([\w-]+)(\s+.*)?$/) {
	    &do_log('info', 'Bad paragraph "%s" in %s', @paragraph, $file);
	    next;
	}
	
	$pname = $1;   
	
	unless(($pname eq 'include_list')||($pname eq 'include_remote_sympa_list')||($pname eq 'include_file')||($pname eq 'include_remote_file')||
	       ($pname eq 'include_ldap_query')||($pname eq 'include_ldap_2level_query')||($pname eq 'include_sql_query'))   {
	    &do_log('info', 'Unknown parameter "%s" in %s', $pname, $file);
	    next;
	}
	
	## Uniqueness
	if (defined $include{$pname}) {
	    unless (($::pinfo{$pname}{'occurrence'} eq '0-n') or
		    ($::pinfo{$pname}{'occurrence'} eq '1-n')) {
		&do_log('info', 'Multiple parameter "%s" in %s', $pname, $file);
	    }
	}
	
	## Line or Paragraph
	if (ref $::pinfo{$pname}{'file_format'} eq 'HASH') {
	    ## This should be a paragraph
	    unless ($#paragraph > 0) {
		&do_log('info', 'Expecting a paragraph for "%s" parameter in %s, ignore it', $pname, $file);
		next;
	    }
	    
	    ## Skipping first line
	    shift @paragraph;
	    
	    my %hash;
	    for my $i (0..$#paragraph) {	    
		next if ($paragraph[$i] =~ /^\s*\#/);
		
		unless ($paragraph[$i] =~ /^\s*(\w+)\s*/) {
		    &do_log('info', 'Bad line "%s" in %s',$paragraph[$i], $file);
		}
		
		my $key = $1;
		
		unless (defined $::pinfo{$pname}{'file_format'}{$key}) {
		    &do_log('info', 'Unknown key "%s" in paragraph "%s" in %s', $key, $pname, $file);
		    next;
		}
		
		unless ($paragraph[$i] =~ /^\s*$key\s+($::pinfo{$pname}{'file_format'}{$key}{'file_format'})\s*$/i) {
		    chomp($paragraph[$i]);
		    &do_log('info', 'Bad entry "%s" for key "%s", paragraph "%s" in %s', $paragraph[$i], $key, $pname, $file);
		    next;
		}
	       
		$hash{$key} = &_load_list_param($robot,$key, $1, $::pinfo{$pname}{'file_format'}{$key});
	    }

	    ## Apply defaults & Check required keys
	    my $missing_required_field;
	    foreach my $k (keys %{$::pinfo{$pname}{'file_format'}}) {

		## Default value
		unless (defined $hash{$k}) {
		    if (defined $::pinfo{$pname}{'file_format'}{$k}{'default'}) {
			$hash{$k} = &_load_list_param($robot,$k, 'default', $::pinfo{$pname}{'file_format'}{$k});
		    }
		}
		## Required fields
		if ($::pinfo{$pname}{'file_format'}{$k}{'occurrence'} eq '1') {
		    unless (defined $hash{$k}) {
			&do_log('info', 'Missing key "%s" in param "%s" in %s', $k, $pname, $file);
			$missing_required_field++;
		    }
		}
	    }

	    next if $missing_required_field;

	    ## Should we store it in an array
	    if (($::pinfo{$pname}{'occurrence'} =~ /n$/)) {
		push @{$include{$pname}}, \%hash;
	    }else {
		$include{$pname} = \%hash;
	    }
	}else {
	    ## This should be a single line
	    unless ($#paragraph == 0) {
		&do_log('info', 'Expecting a single line for "%s" parameter in %s', $pname, $file);
	    }

	    unless ($paragraph[0] =~ /^\s*$pname\s+($::pinfo{$pname}{'file_format'})\s*$/i) {
		chomp($paragraph[0]);
		&do_log('info', 'Bad entry "%s" in %s', $paragraph[0], $file);
		next;
	    }

	    my $value = &_load_list_param($robot,$pname, $1, $::pinfo{$pname});

	    if (($::pinfo{$pname}{'occurrence'} =~ /n$/)
		&& ! (ref ($value) =~ /^ARRAY/)) {
		push @{$include{$pname}}, $value;
	    }else {
		$include{$pname} = $value;
	    }
	}
    }
    
    return \%include;
}

sub sync_include {
    my ($self) = shift;
    my $option = shift;
    my $name=$self->{'name'};
    &do_log('debug', 'List:sync_include(%s)', $name);
    
    my %old_subscribers;
    my $total=0;
    my $errors_occurred=0;

    ## Load a hash with the old subscribers
    for (my $user=$self->get_first_user(); $user; $user=$self->get_next_user()) {
	$old_subscribers{lc($user->{'email'})} = $user;
	
	## User neither included nor subscribed = > set subscribed to 1 
	unless ($old_subscribers{lc($user->{'email'})}{'included'} || $old_subscribers{lc($user->{'email'})}{'subscribed'}) {
	    &do_log('notice','Update user %s neither included nor subscribed', $user->{'email'});
	    unless( $self->update_user(lc($user->{'email'}),  {'update_date' => time,
							       'subscribed' => 1 }) ) {
		&do_log('err', 'List:sync_include(%s): Failed to update %s', $name, lc($user->{'email'}));
		next;
	    }			    
	    $old_subscribers{lc($user->{'email'})}{'subscribed'} = 1;
	}

	$total++;
    }
    
    ## Load a hash with the new subscriber list
    my $new_subscribers;
    unless ($option eq 'purge') {
	my $result = $self->_load_users_include2();
	$new_subscribers = $result->{'users'};
	my $tmp_errors = $result->{'errors'};
	my @errors = @$tmp_errors;
	## If include sources were not available, do not update subscribers
	## Use DB cache instead and warn the listmaster.
	if($#errors > -1) {
	    &do_log('err', 'Errors occurred while synchronizing datasources for list: %s', $name);
	    $errors_occurred = 1;
	    unless (&List::send_notify_to_listmaster('sync_include_failed', $self->{'domain'}, {'errors' => \@errors, 'listname' => $self->{'name'}})) {
		&do_log('notice',"Unable to send notify 'sync_include_failed' to listmaster");
	    }
	    return undef;
	}
    }

    my $data_exclu;
    my @subscriber_exclusion;

    ## Récupérer un array d'emails pour une liste donnée in 'exclusion_table'
    $data_exclu = &get_exclusion($name,$self->{'domain'});

    my $key =0;
    while ($data_exclu->{'emails'}->[$key]){
	push @subscriber_exclusion, $data_exclu->{'emails'}->[$key];
	$key = $key + 1;
    }
    

    my $users_added = 0;
    my $users_updated = 0;

    ## Get an Exclusive lock
    my $lock = new Lock ($self->{'dir'}.'/include');
    unless (defined $lock) {
	&do_log('err','Could not create new lock');
	return undef;
    }
    $lock->set_timeout(10*60); 
    unless ($lock->lock('write')) {
	return undef;
    }

    ## Go through new users
    my @add_tab;
    $users_added = 0;
    foreach my $email (keys %{$new_subscribers}) {
	my $compare = 0;
	foreach my $sub_exclu (@subscriber_exclusion){
	    if ($email eq $sub_exclu){
		$compare = 1;
		last;
	    }
	}
	if($compare == 1){
	    delete $new_subscribers->{$email};
	    next;
	}
	if (defined($old_subscribers{$email}) ) {

	    if ($old_subscribers{$email}{'included'}) {

	      ## If one user attribute has changed, then we should update the user entry
	      foreach my $attribute ('id','gecos') {
		if ($old_subscribers{$email}{$attribute} ne $new_subscribers->{$email}{$attribute}) {
		  &do_log('debug', 'List:sync_include: updating %s to list %s', $email, $name);
		  unless( $self->update_user($email,  {'update_date' => time,
						       $attribute => $new_subscribers->{$email}{$attribute} }) ) {
		    &do_log('err', 'List:sync_include(%s): Failed to update %s', $name, $email);
		    next;
		  }
		  $users_updated++;
		}
	      }
		## User was already subscribed, update include_sources_subscriber in DB
	    }else {
		&do_log('debug', 'List:sync_include: updating %s to list %s', $email, $name);
		unless( $self->update_user($email,  {'update_date' => time,
						     'included' => 1,
						     'id' => $new_subscribers->{$email}{'id'} }) ) {
		    &do_log('err', 'List:sync_include(%s): Failed to update %s',
			    $name, $email);
		    next;
		}
		$users_updated++;
	    }

	    ## Add new included user
	}else {
	    &do_log('debug3', 'List:sync_include: adding %s to list %s', $email, $name);
	    my $u = $new_subscribers->{$email};
	    $u->{'included'} = 1;
	    $u->{'date'} = time;
	    @add_tab = ($u);
	    my $user_added = 0;
	    unless( $user_added = $self->add_user( @add_tab ) ) {
		&do_log('err', 'List:sync_include(%s): Failed to add new users', $name);
		return undef;
	    }
	    if ($user_added) {
		$users_added++;
		## Send notification if the list config authorizes it only.
		if ($self->{'admin'}{'inclusion_notification_feature'} eq 'on') {
		    unless ($self->send_file('welcome', $u->{'email'}, $self->{'domain'},{})) {
			&do_log('err',"Unable to send template 'welcome' to $u->{'email'}");
		    }
		}
	    }
	}
    }

    if ($users_added) {
        &do_log('notice', 'List:sync_include(%s): %d users added', $name, $users_added);
    }

    ## Go though previous list of users
    my $users_removed = 0;
    my $user_removed;
    my @deltab;
    foreach my $email (keys %old_subscribers) {
	unless( defined($new_subscribers->{$email}) ) {
	    ## User is also subscribed, update DB entry
	    if ($old_subscribers{$email}{'subscribed'}) {
		&do_log('debug', 'List:sync_include: updating %s to list %s', $email, $name);
		unless( $self->update_user($email,  {'update_date' => time,
						     'included' => 0,
						     'id' => ''}) ) {
		    &do_log('err', 'List:sync_include(%s): Failed to update %s',  $name, $email);
		    next;
		}
		
		$users_updated++;

		## Tag user for deletion
	    }else {
		&do_log('debug3', 'List:sync_include: removing %s from list %s', $email, $name);
		@deltab = ($email);
		unless($user_removed = $self->delete_user('users' => \@deltab)) {
		    &do_log('err', 'List:sync_include(%s): Failed to delete %s', $name, $user_removed);
		    return undef;
		}
		if ($user_removed) {
		    $users_removed++;
		    ## Send notification if the list config authorizes it only.
		    if ($self->{'admin'}{'inclusion_notification_feature'} eq 'on') {
			unless ($self->send_file('removed', $email, $self->{'domain'},{})) {
			    &do_log('err',"Unable to send template 'removed' to $email");
			}
		    }
		}
	    }
	}
    }
    if ($users_removed > 0) {
	&do_log('notice', 'List:sync_include(%s): %d users removed', $name, $users_removed);
    }
    &do_log('notice', 'List:sync_include(%s): %d users updated', $name, $users_updated);

    ## Release lock
    unless ($lock->unlock()) {
	return undef;
    }

    ## Get and save total of subscribers
    $self->{'total'} = $self->_load_total_db('nocache');
    $self->{'last_sync'} = time;
    $self->savestats();

    return 1;
}

## The previous function (sync_include) is to be called by the task_manager.
## This one is to be called from anywhere else. This function deletes the scheduled
## sync_include task. If this deletion happened in sync_include(), it would disturb
## the normal task_manager.pl functionning.

sub on_the_fly_sync_include {
    my $self = shift;
    my %options = @_;

    my $pertinent_ttl = $self->{'admin'}{'distribution_ttl'}||$self->{'admin'}{'ttl'};
    &do_log('debug2','List::on_the_fly_sync_include(%s)',$pertinent_ttl);
    if ( $options{'use_ttl'} != 1 || $self->{'last_sync'} < time - $pertinent_ttl) { 
	&do_log('notice', "Synchronizing list members...");
	if ($self->sync_include()) {
	    $self->remove_task('sync_include');
	    return 1;
	}
	else {
	    return undef;
	}
    }
    return 1;
}

sub sync_include_admin {
    my ($self) = shift;
    my $option = shift;
    
    my $name=$self->{'name'};
    &do_log('debug2', 'List:sync_include_admin(%s)', $name);

    ## don't care about listmaster role
    foreach my $role ('owner','editor'){
	my $old_admin_users = {};
        ## Load a hash with the old admin users
	for (my $admin_user=$self->get_first_admin_user($role); $admin_user; $admin_user=$self->get_next_admin_user()) {
	    $old_admin_users->{lc($admin_user->{'email'})} = $admin_user;
	}
	
	## Load a hash with the new admin user list from an include source(s)
	my $new_admin_users_include;
	## Load a hash with the new admin user users from the list config
	my $new_admin_users_config;
	unless ($option eq 'purge') {
	    
	    $new_admin_users_include = $self->_load_admin_users_include($role);
	    
	    ## If include sources were not available, do not update admin users
	    ## Use DB cache instead
	    unless (defined $new_admin_users_include) {
		&do_log('err', 'Could not get %ss from an include source for list %s', $role, $name);
		unless (&List::send_notify_to_listmaster('sync_include_admin_failed', $self->{'domain'}, [$name])) {
		    &do_log('notice',"Unable to send notify 'sync_include_admmin_failed' to listmaster");
		}
		return undef;
	    }

	    $new_admin_users_config = $self->_load_admin_users_config($role);
	    
	    unless (defined $new_admin_users_config) {
		&do_log('err', 'Could not get %ss from config for list %s', $role, $name);
		return undef;
	    }
	}
	
	my @add_tab;
	my $admin_users_added = 0;
	my $admin_users_updated = 0;
	
	## Get an Exclusive lock
	my $lock = new Lock ($self->{'dir'}.'/include_admin_user');
	unless (defined $lock) {
	    &do_log('err','Could not create new lock');
	    return undef;
	}
	$lock->set_timeout(20); 
	unless ($lock->lock('write')) {
	    return undef;
	}
	
	## Go through new admin_users_include
	foreach my $email (keys %{$new_admin_users_include}) {
	    
	    # included and subscribed
	    if (defined $new_admin_users_config->{$email}) {
		my $param;
		foreach my $p ('reception','visibility','gecos','info','profile') {
		    #  config parameters have priority on include parameters in case of conflict
		    $param->{$p} = $new_admin_users_config->{$email}{$p} if (defined $new_admin_users_config->{$email}{$p});
		    $param->{$p} ||= $new_admin_users_include->{$email}{$p};
		}

                #Admin User was already in the DB
		if (defined $old_admin_users->{$email}) {

		    $param->{'included'} = 1;
		    $param->{'id'} = $new_admin_users_include->{$email}{'id'};
		    $param->{'subscribed'} = 1;
		   
		    my $param_update = &is_update_param($param,$old_admin_users->{$email});
		    
		    # updating
		    if (defined $param_update) {
			if (%{$param_update}) {
			    &do_log('debug', 'List:sync_include_admin : updating %s %s to list %s',$role, $email, $name);
			    $param_update->{'update_date'} = time;
			    
			    unless ($self->update_admin_user($email, $role,$param_update)) {
				&do_log('err', 'List:sync_include_admin(%s): Failed to update %s %s', $name,$role,$email);
				next;
			    }
			    $admin_users_updated++;
			}
		    }
		    #for the next foreach (sort of new_admin_users_config that are not included)
		    delete ($new_admin_users_config->{$email});
		    
		# add a new included and subscribed admin user 
		}else {
		    &do_log('debug2', 'List:sync_include_admin: adding %s %s to list %s',$email,$role, $name);
		    
		    foreach my $key (keys %{$param}) {  
			$new_admin_users_config->{$email}{$key} = $param->{$key};
		    }
		    $new_admin_users_config->{$email}{'included'} = 1;
		    $new_admin_users_config->{$email}{'subscribed'} = 1;
		    push (@add_tab,$new_admin_users_config->{$email});
		    
                    #for the next foreach (sort of new_admin_users_config that are not included)
		    delete ($new_admin_users_config->{$email});
		}
		
	    # only included
	    }else {
		my $param = $new_admin_users_include->{$email};

                #Admin User was already in the DB
		if (defined($old_admin_users->{$email}) ) {

		    $param->{'included'} = 1;
		    $param->{'id'} = $new_admin_users_include->{$email}{'id'};
		    $param->{'subscribed'} = 0;

		    my $param_update = &is_update_param($param,$old_admin_users->{$email});
		   
		    # updating
		    if (defined $param_update) {
			if (%{$param_update}) {
			    &do_log('debug', 'List:sync_include_admin : updating %s %s to list %s', $role, $email, $name);
			    $param_update->{'update_date'} = time;
			    
			    unless ($self->update_admin_user($email, $role,$param_update)) {
				&do_log('err', 'List:sync_include_admin(%s): Failed to update %s %s', $name, $role,$email);
				next;
			    }
			    $admin_users_updated++;
			}
		    }
		# add a new included admin user 
		}else {
		    &do_log('debug2', 'List:sync_include_admin: adding %s %s to list %s', $role, $email, $name);
		    
		    foreach my $key (keys %{$param}) {  
			$new_admin_users_include->{$email}{$key} = $param->{$key};
		    }
		    $new_admin_users_include->{$email}{'included'} = 1;
		    push (@add_tab,$new_admin_users_include->{$email});
		}
	    }
	}   

	## Go through new admin_users_config (that are not included : only subscribed)
	foreach my $email (keys %{$new_admin_users_config}) {

	    my $param = $new_admin_users_config->{$email};
	    
	    #Admin User was already in the DB
	    if (defined($old_admin_users->{$email}) ) {

		$param->{'included'} = 0;
		$param->{'id'} = '';
		$param->{'subscribed'} = 1;
		my $param_update = &is_update_param($param,$old_admin_users->{$email});

		# updating
		if (defined $param_update) {
		    if (%{$param_update}) {
			&do_log('debug', 'List:sync_include_admin : updating %s %s to list %s', $role, $email, $name);
			$param_update->{'update_date'} = time;
			
			unless ($self->update_admin_user($email, $role,$param_update)) {
			    &do_log('err', 'List:sync_include_admin(%s): Failed to update %s %s', $name, $role, $email);
			    next;
			}
			$admin_users_updated++;
		    }
		}
	    # add a new subscribed admin user 
	    }else {
		&do_log('debug2', 'List:sync_include_admin: adding %s %s to list %s', $role, $email, $name);
		
		foreach my $key (keys %{$param}) {  
		    $new_admin_users_config->{$email}{$key} = $param->{$key};
		}
		$new_admin_users_config->{$email}{'subscribed'} = 1;
		push (@add_tab,$new_admin_users_config->{$email});
	    }
	}
	
	if ($#add_tab >= 0) {
	    unless( $admin_users_added = $self->add_admin_user($role,@add_tab ) ) {
		&do_log('err', 'List:sync_include_admin(%s): Failed to add new %ss',  $role, $name);
		return undef;
	    }
	}
	
	if ($admin_users_added) {
	    &do_log('debug', 'List:sync_include_admin(%s): %d %s(s) added',
		    $name, $admin_users_added, $role);
	}
	
	&do_log('debug', 'List:sync_include_admin(%s): %d %s(s) updated', $name, $admin_users_updated, $role);

	## Go though old list of admin users
	my $admin_users_removed = 0;
	my @deltab;
	
	foreach my $email (keys %$old_admin_users) {
	    unless (defined($new_admin_users_include->{$email}) || defined($new_admin_users_config->{$email})) {
		&do_log('debug2', 'List:sync_include_admin: removing %s %s to list %s', $role, $email, $name);
		push(@deltab, $email);
	    }
	}
	
	if ($#deltab >= 0) {
	    unless($admin_users_removed = $self->delete_admin_user($role,@deltab)) {
		&do_log('err', 'List:sync_include_admin(%s): Failed to delete %s %s',
			$name, $role, $admin_users_removed);
		return undef;
	    }
	    &do_log('debug', 'List:sync_include_admin(%s): %d %s(s) removed',
		    $name, $admin_users_removed, $role);
	}

	## Release lock
	unless ($lock->unlock()) {
	    return undef;
	}
    }	
   
    $self->{'last_sync_admin_user'} = time;
    $self->savestats();
 
    return $self->get_nb_owners;
}

## Load param admin users from the config of the list
sub _load_admin_users_config {
    my $self = shift;
    my $role = shift; 
    my $name = $self->{'name'};
    my %admin_users;

    &do_log('debug2', 'List::_load_admin_users_config(%s) for list %s',$role, $name);  

    foreach my $entry (@{$self->{'admin'}{$role}}) {
	my $email = lc($entry->{'email'});
	my %u;
  
	$u{'email'} = $email;
	$u{'reception'} = $entry->{'reception'};
	$u{'visibility'} = $entry->{'visibility'};
	$u{'gecos'} = $entry->{'gecos'};
	$u{'info'} = $entry->{'info'};
	$u{'profile'} = $entry->{'profile'} if ($role eq 'owner');
 
	$admin_users{$email} = \%u;
    }
    return \%admin_users;
}

## return true if new_param has changed from old_param
#  $new_param is changed to return only entries that need to
# be updated (only deals with admin user parameters, editor or owner)
sub is_update_param {
    my $new_param = shift;
    my $old_param = shift;
    my $resul = {};
    my $update = 0;

    &do_log('debug2', 'List::is_update_param ');  

    foreach my $p ('reception','visibility','gecos','info','profile','id','included','subscribed') {
	if (defined $new_param->{$p}) {
	    if ($new_param->{$p} ne $old_param->{$p}) {
		$resul->{$p} = $new_param->{$p};
		$update = 1;
	    }
	}else {
	    if (defined $old_param->{$p} && ($old_param->{$p} ne '')) {
		$resul->{$p} = '';
		$update = 1;
	    }
	}
    }
    if ($update) {
	return $resul;
    }else {
	return undef;
    }
}



sub _inclusion_loop {

    my $name = shift;
    my $incl = shift;
    my $depend_on = shift;

    return 1 if ($depend_on->{$incl}) ; 
    
    return undef;
}

sub _load_total_db {
    my $self = shift;
    my $option = shift;
    do_log('debug2', 'List::_load_total_db(%s)', $self->{'name'});

    unless ($List::use_db) {
	&do_log('info', 'Sympa not setup to use DBI');
	return undef;
    }
    
    ## Use session cache
    if (($option ne 'nocache') && (defined $list_cache{'load_total_db'}{$self->{'domain'}}{$self->{'name'}})) {
	return $list_cache{'load_total_db'}{$self->{'domain'}}{$self->{'name'}};
    }

    my ($statement);

    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }	   

    ## Query the Database
    $statement = sprintf "SELECT count(*) FROM subscriber_table WHERE (list_subscriber = %s AND robot_subscriber = %s)", $dbh->quote($self->{'name'}), $dbh->quote($self->{'domain'});
       
    push @sth_stack, $sth;

    unless ($sth = $dbh->prepare($statement)) {
	do_log('debug','Unable to prepare SQL statement : %s', $dbh->errstr);
	return undef;
    }
    
    unless ($sth->execute) {
	do_log('debug','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }
    
    my $total = $sth->fetchrow;

    $sth->finish();

    $sth = pop @sth_stack;

    ## Set session cache
    $list_cache{'load_total_db'}{$self->{'domain'}}{$self->{'name'}} = $total;

    return $total;
}

## Writes to disk the stats data for a list.
sub _save_stats_file {
    my $file = shift;
    my $stats = shift;
    my $total = shift;
    my $last_sync = shift;
    my $last_sync_admin_user = shift;
    
    unless (defined $stats && ref ($stats) eq 'ARRAY') {
	&do_log('err', 'List_save_stats_file() : incorrect parameter');
	return undef;
    }

    do_log('debug2', '(%s, %s, %s, %s)',
	$file, $total, $last_sync, $last_sync_admin_user);
    my $untainted_filename = sprintf ("%s",$file);
    open(L, "> $untainted_filename") || return undef;
    printf L "%d %.0f %.0f %.0f %d %d %d\n", @{$stats}, $total, $last_sync, $last_sync_admin_user;
    close(L);
}

## Writes the user list to disk
sub _save_users_file {
    my($self, $file) = @_;
    do_log('debug3', 'List::_save_users_file(%s)', $file);
    
    my($k, $s);
    
    do_log('debug2','Saving user file %s', $file);
    
    rename("$file", "$file.old");
    open SUB, "> $file" or return undef;
    
    for ($s = $self->get_first_user(); $s; $s = $self->get_next_user()) {
	foreach $k ('date','update_date','email','gecos','reception','visibility') {
	    printf SUB "%s %s\n", $k, $s->{$k} unless ($s->{$k} eq '');
	    
	}
	print SUB "\n";
    }
    close SUB;
    return 1;
}

sub _compare_addresses {
   my ($a, $b) = @_;

   my ($ra, $rb);

   $a =~ tr/A-Z/a-z/;
   $b =~ tr/A-Z/a-z/;

   $ra = reverse $a;
   $rb = reverse $b;

   return ($ra cmp $rb);
}

## Does the real job : stores the message given as an argument into
## the digest of the list.
sub store_digest {
    my($self, $message) = @_;
    do_log('debug3', 'List::store_digest');

    my($filename, $newfile);
    my $separator = &tools::get_separator();  

    unless ( -d "$Conf::Conf{'queuedigest'}") {
	return;
    }
    
    my @now  = localtime(time);

    ## Reverse compatibility concern
    if (-f "$Conf::Conf{'queuedigest'}/$self->{'name'}") {
  	$filename = "$Conf::Conf{'queuedigest'}/$self->{'name'}";
    }else {
 	$filename = $Conf::Conf{'queuedigest'}.'/'.$self->get_list_id();
    }

    $newfile = !(-e $filename);
    my $oldtime=(stat $filename)[9] unless($newfile);
  
    open(OUT, ">> $filename") || return;
    if ($newfile) {
	## create header
	printf OUT "\nThis digest for list has been created on %s\n\n",
      strftime("%a %b %e %H:%M:%S %Y", @now);
	print OUT "------- THIS IS A RFC934 COMPLIANT DIGEST, YOU CAN BURST IT -------\n\n";
	printf OUT "\n%s\n\n", &tools::get_separator();

       # send the date of the next digest to the users
    }

    my $msg = $message->{'msg'};
    #$msg->head->delete('Received') if ($msg->head->get('received'));
    $msg->print(\*OUT);
    printf OUT "\n%s\n\n", &tools::get_separator();
    close(OUT);
    
    #replace the old time
    utime $oldtime,$oldtime,$filename   unless($newfile);
}

## List of lists hosted a robot
## Returns a ref to an array of List objects
sub get_lists {
    my $robot_context = shift || '*';
    my $options = shift || {};
    my $requested_lists = shift; ## Optional parameter to load only a subset of all lists
    my $use_files;
    my $cond_perl;
    my $cond_sql;

    my(@lists, $l,@robots);
    do_log('debug2', 'List::get_lists(%s)',$robot_context);

    # Determin if files are used instead of list_table DB cache.
    if ($Conf::Conf{'db_list_cache'} ne 'on' or defined $requested_lists) {
	$use_files = 1;
    } else {
	$use_files = $options->{'use_files'};
    }

    # Build query: Perl expression for files and SQL expression for list_table.
    my @query = (@{$options->{'filter_query'} || []});
    my @clause_perl = ();
    my @clause_sql = ();
    while (1 < scalar @query) {
        my @expr_perl = ();
        my @expr_sql = ();
        my @keys = split /[|]/, shift @query;
        my @vals = split /[|]/, shift @query;

        foreach my $k (@keys) {
            next unless $k =~ /\S/;
            $k =~ s/^\s+//;
            $k =~ s/\s+$//;

            foreach my $v (@vals) {
                if ($k eq 'web_archive') {
                    push @expr_perl, sprintf '&is_web_archived($list) == %d',
                                             ($v+0 ? 1 : 0);
                } elsif ($k =~ /^(name|robot)$/) {
                    push @expr_perl, sprintf '$list->{"%s"} eq "%s"',
                                             quotemeta $k, quotemeta $v;
                } elsif ($k =~ /^(status|subject)$/) {
                    push @expr_perl, sprintf '$list->{"admin"}{"%s"} eq "%s"',
                                             quotemeta $k, quotemeta $v;
                } else {
                    do_log('err', "bug in logic. Ask developer");
                    return undef;
                }
                if ($k eq 'web_archive') {
                    push @expr_sql, sprintf 'web_archive_list = %d',
                                            ($v+0 ? 1 : 0);
                } else {
                    push @expr_sql, sprintf '%s_list = %s',
                                            $k, $dbh->quote($v);
                }
            }
        }
        if (scalar @expr_perl) {
            push @clause_perl, join ' || ', @expr_perl;
            push @clause_sql, join ' OR ', @expr_sql;
        }
    }
    if (scalar @clause_perl) {
        $cond_perl = join ' && ', map { "($_)" } @clause_perl;
        $cond_sql = join ' AND ', map { "($_)" } @clause_sql;
        do_log('debug2', 'query %s; %s', $cond_perl, $cond_sql);
    } else {
        $cond_perl = undef;
        $cond_sql = undef;
    }

    if ($robot_context eq '*') {
	@robots = &get_robots ;
    }else{
	push @robots, $robot_context ;
    }
    
    foreach my $robot (@robots) {
	## Check cache first
	if (defined $list_cache{'get_lists'}{$robot}) {
	    if (defined $cond_perl) {
		foreach my $list (@{$list_cache{'get_lists'}{$robot}}) {
		    next unless eval $cond_perl;
		    push @lists, $list;
		}
	    } else {
		push @lists, @{$list_cache{'get_lists'}{$robot}};
	    }
	} else {
	    my $robot_dir =  $Conf::Conf{'home'}.'/'.$robot ;
	    $robot_dir = $Conf::Conf{'home'}  unless ((-d $robot_dir) || ($robot ne $Conf::Conf{'host'}));
	    
	    unless (-d $robot_dir) {
		do_log('err',"unknown robot $robot, Unable to open $robot_dir");
		return undef ;
	    }
	    
	    ## Load only requested lists if $requested_list is set
	    ## otherwise load all lists
	    my @files;
	    if (defined($requested_lists)){
		@files = sort @{$requested_lists};
	    } elsif ($use_files) {
		unless (opendir(DIR, $robot_dir)) {
		    do_log('err',"Unable to open $robot_dir");
		    return undef;
		}
		@files = sort readdir(DIR);
		closedir DIR;
	    } else {
		# get list names from list cache table
		my $where = sprintf 'robot_list = %s', $dbh->quote($robot);  
		if (defined $cond_sql) {
		    $where .= " AND $cond_sql";
		}
		my $files = &get_lists_db($where);
		@files = @{$files};
	    }

	    foreach my $l (@files) {
		next if (($l =~ /^\./o) || (! -d "$robot_dir/$l") || (! -f "$robot_dir/$l/config"));
		$options->{'optional_sync_admin'} = 1;
		my $list = new List ($l, $robot, $options);
		
		next unless (defined $list);

		if ($use_files and defined $cond_perl) {
		    next unless eval $cond_perl;
		}
		
		push @lists, $list;
		
		## Also feed the cache
		## Unless we only loaded a subset of all lists ($requested_lists parameter used)
		unless (defined $requested_lists or defined $cond_perl) {
		    push @{$list_cache{'get_lists'}{$robot}}, $list;
		}
		
	    }
	}
    }
    return \@lists;
}

## List of robots hosted by Sympa
sub get_robots {

    my(@robots, $r);
    do_log('debug2', 'List::get_robots()');

    unless (opendir(DIR, $Conf::Conf{'etc'})) {
	do_log('err',"Unable to open $Conf::Conf{'etc'}");
	return undef;
    }
    my $use_default_robot = 1 ;
    foreach $r (sort readdir(DIR)) {
	next unless (($r !~ /^\./o) && (-d "$Conf::Conf{'home'}/$r"));
	next unless (-r "$Conf::Conf{'etc'}/$r/robot.conf");
	push @robots, $r;
	undef $use_default_robot if ($r eq $Conf::Conf{'host'});
    }
    closedir DIR;

    push @robots, $Conf::Conf{'host'} if ($use_default_robot);
    return @robots ;
}

## List of lists in database mode which e-mail parameter is member of
## Results concern ALL robots
sub get_which_db {
    my $email = shift;
    my $function = shift;
    do_log('debug3', 'List::get_which_db(%s,%s)', $email, $function);

    unless ($List::use_db) {
	&do_log('info', 'Sympa not setup to use DBI');
	return undef;
    }
    
    my ($l, %which, $statement);

    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }	   

    if ($function eq 'member') {
 	## Get subscribers
	$statement = sprintf "SELECT list_subscriber, robot_subscriber, bounce_subscriber, reception_subscriber, topics_subscriber, include_sources_subscriber, subscribed_subscriber, included_subscriber  FROM subscriber_table WHERE user_subscriber = %s",$dbh->quote($email);
	
	push @sth_stack, $sth;
	
	&do_log('debug2','SQL: %s', $statement);
	unless ($sth = $dbh->prepare($statement)) {
	    do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
	    return undef;
	}
	
	unless ($sth->execute) {
	    do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	    return undef;
	}

	while ($l = $sth->fetchrow_hashref('NAME_lc')) {
	    my ($name, $robot) = ($l->{'list_subscriber'}, $l->{'robot_subscriber'});
	    $name =~ s/\s*$//;  ## usefull for PostgreSQL
	    $which{$robot}{$name}{'member'} = 1;
	    $which{$robot}{$name}{'reception'} = $l->{'reception_subscriber'};
	    $which{$robot}{$name}{'bounce'} = $l->{'bounce_subscriber'};
	    $which{$robot}{$name}{'topic'} = $l->{'topic_subscriber'};
	    $which{$robot}{$name}{'included'} = $l->{'included_subscriber'};
	    $which{$robot}{$name}{'subscribed'} = $l->{'subscribed_subscriber'};
	    $which{$robot}{$name}{'include_sources'} = $l->{'include_sources_subscriber'};
	}	
	$sth->finish();	
	$sth = pop @sth_stack;

    }else {
	## Get admin
	$statement = sprintf "SELECT list_admin, robot_admin, role_admin FROM admin_table WHERE user_admin = %s",$dbh->quote($email);

	push @sth_stack, $sth;
	
	unless ($sth = $dbh->prepare($statement)) {
	    do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
 	return undef;
	}
	
	&do_log('debug2','SQL: %s', $statement);

	unless ($sth->execute) {
	    do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	    return undef;
	}
	
	while ($l = $sth->fetchrow_hashref('NAME_lc')) {
	    $which{$l->{'robot_admin'}}{$l->{'list_admin'}}{$l->{'role_admin'}} = 1;
	}
	
	$sth->finish();
	
	$sth = pop @sth_stack;
    }

    return \%which;
}

## get idp xref to locally validated email address
sub get_netidtoemail_db {
    my $robot = shift;
    my $netid = shift;
    my $idpname = shift;
    do_log('debug', 'List::get_netidtoemail_db(%s, %s)', $netid, $idpname);

    unless ($List::use_db) {
	&do_log('err', 'Sympa not setup to use DBI');
	return undef;
    }
    
    my ($l, %which, $statement, $email);

    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }	   

    $statement = sprintf "SELECT email_netidmap FROM netidmap_table WHERE netid_netidmap = %s and serviceid_netidmap = %s and robot_netidmap = %s", $dbh->quote($netid), $dbh->quote($idpname), $dbh->quote($robot);

    push @sth_stack, $sth;

    unless ($sth = $dbh->prepare($statement)) {
	do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
	return undef;
    }

    unless ($sth->execute) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }

    $email = $sth->fetchrow;

    $sth->finish();

    $sth = pop @sth_stack;

    return $email;
}

## set idp xref to locally validated email address
sub set_netidtoemail_db {
    my $robot = shift;
    my $netid = shift;
    my $idpname = shift;
    my $email = shift; 
    do_log('debug', 'List::set_netidtoemail_db(%s, %s, %s)', $netid, $idpname, $email);

    unless ($List::use_db) {
	&do_log('info', 'Sympa not setup to use DBI');
	return undef;
    }
    
    my ($l, %which, $statement);

    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }	   

    $statement = sprintf "INSERT INTO netidmap_table (netid_netidmap,serviceid_netidmap,email_netidmap,robot_netidmap) VALUES (%s, %s, %s, %s)", $dbh->quote($netid), $dbh->quote($idpname), $dbh->quote($email), $dbh->quote($robot);


     unless ($dbh->do($statement)) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }

    return 1;
}

## Update netidmap table when user email address changes
sub update_email_netidmap_db{
    my ($robot, $old_email, $new_email) = @_;
    my $statement;	
    
    unless (defined $robot && 
	    defined $old_email &&
	    defined $new_email) {
	&do_log('err', 'Missing parameter');
	return undef;
    } 

    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }
    
    $statement = sprintf "UPDATE netidmap_table SET email_netidmap = %s WHERE (email_netidmap = %s AND robot_netidmap = %s)",$dbh->quote($new_email), $dbh->quote($old_email), $dbh->quote($robot);
    
    
    unless ($dbh->do($statement)) {
	do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	return undef;
    }

    return 1;
}

## &get_which(<email>,<robot>,<type>)
## Get lists of lists where <email> assumes this <type> (owner, editor or member) of
## function to any list in <robot>.
sub get_which {
    my $email = shift;
    my $robot =shift;
    my $function = shift;
    do_log('debug2', 'List::get_which(%s, %s)', $email, $function);

    my ($l, @which);

    ## WHICH in Database
    my $db_which = {};
    my $requested_lists;

    if (defined $Conf::Conf{'db_type'} && $List::use_db) {
	$db_which = &get_which_db($email,  $function);
	@{$requested_lists} = keys %{$db_which->{$robot}};
    }

    ## This call is required too 
    my $all_lists = &get_lists($robot, {}, $requested_lists);

    foreach my $list (@$all_lists){
 
	my $l = $list->{'name'};
	# next unless (($list->{'admin'}{'host'} eq $robot) || ($robot eq '*')) ;

	## Skip closed lists unless the user is Listmaster
	if ($list->{'admin'}{'status'} =~ /closed/) {
	    next;
	}

        if ($function eq 'member') {
	    if ($db_which->{$robot}{$l}{'member'}) {
		$list->{'user'}{'reception'} = $db_which->{$robot}{$l}{'reception'};
		$list->{'user'}{'topic'} = $db_which->{$robot}{$l}{'topic'};
		$list->{'user'}{'bounce'} = $db_which->{$robot}{$l}{'bounce'};
		$list->{'user'}{'subscribed'} = $db_which->{$robot}{$l}{'subscribed'};
		$list->{'user'}{'included'} = $db_which->{$robot}{$l}{'included'};
		
		push @which, $list ;
		
		## Update cache
		$list_cache{'is_user'}{$list->{'domain'}}{$l}{$email} = 1;
	    }else {
		## Update cache
		$list_cache{'is_user'}{$list->{'domain'}}{$l}{$email} = 0;		    
	    }
	    
	}elsif ($function eq 'owner') {
	    if ($db_which->{$robot}{$l}{'owner'} == 1) {
		push @which, $list ;
		
		## Update cache
		$list_cache{'am_i'}{'owner'}{$list->{'domain'}}{$l}{$email} = 1;
	    }else {
		## Update cache
		$list_cache{'am_i'}{'owner'}{$list->{'domain'}}{$l}{$email} = 0;		    
	    }
	}elsif ($function eq 'editor') {
	    if ($db_which->{$robot}{$l}{'editor'} == 1) {
		push @which, $list ;
		
		## Update cache
		$list_cache{'am_i'}{'editor'}{$list->{'domain'}}{$l}{$email} = 1;
	    }else {
		## Update cache
		$list_cache{'am_i'}{'editor'}{$list->{'domain'}}{$l}{$email} = 0;		    
	    }
	}else {
	    do_log('err',"Internal error, unknown or undefined parameter $function  in get_which");
            return undef ;
	}
    }
    
    return @which;
}



## return total of messages awaiting moderation
sub get_mod_spool_size {
    my $self = shift;
    do_log('debug3', 'List::get_mod_spool_size()');    
    my @msg;
    
    unless (opendir SPOOL, $Conf::Conf{'queuemod'}) {
	&do_log('err', 'Unable to read spool %s', $Conf::Conf{'queuemod'});
	return undef;
    }

    my $list_name = $self->{'name'};
    my $list_id = $self->get_list_id();
    @msg = sort grep(/^($list_id|$list_name)\_\w+$/, readdir SPOOL);

    closedir SPOOL;
    return ($#msg + 1);
}

### moderation for shared

# return the status of the shared
sub get_shared_status {
    my $self = shift;
    do_log('debug3', '(%s)', $self->{'name'});
    
    if (-e $self->{'dir'}.'/shared') {
	return 'exist';
    }elsif (-e $self->{'dir'}.'/pending.shared') {
	return 'deleted';
    }else{
	return 'none';
    }
}

# return the list of documents shared waiting for moderation 
sub get_shared_moderated {
    my $self = shift;
    do_log('debug3', 'List::get_shared_moderated()');  
    my $shareddir = $self->{'dir'}.'/shared';

    unless (-e "$shareddir") {
	return undef;
    }
    
    ## sort of the shared
    my @mod_dir = &sort_dir_to_get_mod("$shareddir");
    return \@mod_dir;
}

# return the list of documents awaiting for moderation in a dir and its subdirs
sub sort_dir_to_get_mod {
    #dir to explore
    my $dir = shift;
    do_log('debug3', 'List::sort_dir_to_get_mod()');  
    
    # listing of all the shared documents of the directory
    unless (opendir DIR, "$dir") {
	do_log('err',"sort_dir_to_get_mod : cannot open $dir : $!");
	return undef;
    }
    
    # array of entry of the directory DIR 
    my @tmpdir = readdir DIR;
    closedir DIR;

    # private entry with documents not yet moderated
    my @moderate_dir = grep (/(\.moderate)$/, @tmpdir);
    @moderate_dir = grep (!/^\.desc\./, @moderate_dir);

    foreach my $d (@moderate_dir) {
	$d = "$dir/$d";
    }
   
    my $path_d;
    foreach my $d (@tmpdir) {
	# current document
        $path_d = "$dir/$d";

	if ($d =~ /^\.+$/){
	    next;
	}

	if (-d $path_d) {
	    push(@moderate_dir,&sort_dir_to_get_mod($path_d));
	}
    }
	
    return @moderate_dir;
    
 } 


## Get the type of a DB field
sub get_db_field_type {
    my ($table, $field) = @_;

    return undef unless ($Conf::Conf{'db_type'} eq 'mysql');

    ## Is the Database defined
    unless ($Conf::Conf{'db_name'}) {
	&do_log('info', 'No db_name defined in configuration file');
	return undef;
    }

    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }
	
    unless ($sth = $dbh->prepare("SHOW FIELDS FROM $table")) {
	do_log('err','Unable to prepare SQL query : %s', $dbh->errstr);
	return undef;
    }
    
    unless ($sth->execute) {
	do_log('err','Unable to execute SQL query : %s', $dbh->errstr);
	return undef;
    }
	    
    while (my $ref = $sth->fetchrow_hashref('NAME_lc')) {
	next unless ($ref->{'Field'} eq $field);

	return $ref->{'Type'};
    }

    return undef;
}

## Just check if DB connection is ok
sub check_db_connect {
    
    ## Is the Database defined
    unless ($Conf::Conf{'db_name'}) {
	&do_log('err', 'No db_name defined in configuration file');
	return undef;
    }
    
    unless ($dbh and $dbh->ping) {
	unless (&db_connect('just_try')) {
	    &do_log('err', 'Failed to connect to database');	   
	    return undef;
	}
    }

    ## Used by List subroutines to check that the DB is available
    $List::use_db = 1;

    return 1;
}



## Lowercase field from database
sub lowercase_field {
    my ($table, $field) = @_;

    my $total = 0;

    ## Check database connection
    unless ($dbh and $dbh->ping) {
	return undef unless &db_connect();
    }

    unless ($sth = $dbh->prepare("SELECT $field from $table")) {
	do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
	return undef;
    }

    unless ($sth->execute) {
	do_log('err','Unable to execute SQL statement : %s', $dbh->errstr);
	return undef;
    }

    while (my $user = $sth->fetchrow_hashref('NAME_lc')) {
	my $lower_cased = lc($user->{$field});
	next if ($lower_cased eq $user->{$field});

	$total++;

	## Updating Db
	my $statement = sprintf "UPDATE $table SET $field=%s WHERE ($field=%s)", $dbh->quote($lower_cased), $dbh->quote($user->{$field});
	
	unless ($dbh->do($statement)) {
	    do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	    return undef;
	}
    }
    $sth->finish();

    return $total;
}

## Loads the list of topics if updated
sub load_topics {
    
    my $robot = shift ;
    do_log('debug2', 'List::load_topics(%s)',$robot);

    my $conf_file = &tools::get_filename('etc',{},'topics.conf',$robot);

    unless ($conf_file) {
	&do_log('err','No topics.conf defined');
	return undef;
    }

    my $topics = {};

    ## Load if not loaded or changed on disk
    if (! $list_of_topics{$robot} || ((stat($conf_file))[9] > $mtime{'topics'}{$robot})) {

	## delete previous list of topics
	%list_of_topics = undef;

	unless (-r $conf_file) {
	    &do_log('err',"Unable to read $conf_file");
	    return undef;
	}
	
	unless (open (FILE, "<", $conf_file)) {
	    &do_log('err',"Unable to open config file $conf_file");
	    return undef;
	}
	
	## Raugh parsing
	my $index = 0;
	my (@raugh_data, $topic);
	while (<FILE>) {
	    Encode::from_to($_, $Conf::Conf{'filesystem_encoding'}, 'utf8');
	    if (/^([\-\w\/]+)\s*$/) {
		$index++;
		$topic = {'name' => $1,
			  'order' => $index
			  };
	    }elsif (/^([\w\.]+)\s+(.+)\s*$/) {
		next unless (defined $topic->{'name'});
		
		$topic->{$1} = $2;
	    }elsif (/^\s*$/) {
		if (defined $topic->{'name'}) {
		    push @raugh_data, $topic;
		    $topic = {};
		}
	    }	    
	}
	close FILE;

	## Last topic
	if (defined $topic->{'name'}) {
	    push @raugh_data, $topic;
	    $topic = {};
	}

	$mtime{'topics'}{$robot} = (stat($conf_file))[9];

	unless ($#raugh_data > -1) {
	    &do_log('notice', 'No topic defined in %s/topics.conf', $Conf::Conf{'etc'});
	    return undef;
	}

	## Analysis
	foreach my $topic (@raugh_data) {
	    my @tree = split '/', $topic->{'name'};
	    
	    if ($#tree == 0) {
		my $title = _get_topic_titles($topic);
		$list_of_topics{$robot}{$tree[0]}{'title'} = $title;
		$list_of_topics{$robot}{$tree[0]}{'visibility'} = $topic->{'visibility'}||'default';
		#$list_of_topics{$robot}{$tree[0]}{'visibility'} = &_load_scenario_file('topics_visibility', $robot,$topic->{'visibility'}||'default');
		$list_of_topics{$robot}{$tree[0]}{'order'} = $topic->{'order'};
	    }else {
		my $subtopic = join ('/', @tree[1..$#tree]);
		my $title = _get_topic_titles($topic);
		$list_of_topics{$robot}{$tree[0]}{'sub'}{$subtopic} = &_add_topic($subtopic,$title);
	    }
	}

	## Set undefined Topic (defined via subtopic)
	foreach my $t (keys %{$list_of_topics{$robot}}) {
	    unless (defined $list_of_topics{$robot}{$t}{'visibility'}) {
		#$list_of_topics{$robot}{$t}{'visibility'} = &_load_scenario_file('topics_visibility', $robot,'default');
	    }
	    
	    unless (defined $list_of_topics{$robot}{$t}{'title'}) {
		$list_of_topics{$robot}{$t}{'title'} = {'default' => $t};
	    }	
	}
    }

    ## Set the title in the current language
    my $lang = &Language::GetLang();
    foreach my $top (keys %{$list_of_topics{$robot}}) {
	my $topic = $list_of_topics{$robot}{$top};
	$topic->{'current_title'} = $topic->{'title'}{$lang} || $topic->{'title'}{'default'} || $top;

	foreach my $subtop (keys %{$topic->{'sub'}}) {
	$topic->{'sub'}{$subtop}{'current_title'} = $topic->{'sub'}{$subtop}{'title'}{$lang} || $topic->{'sub'}{$subtop}{'title'}{'default'} || $subtop;	    
	}
    }

    return %{$list_of_topics{$robot}};
}

sub _get_topic_titles {
    my $topic = shift;

    my $title;
    foreach my $key (%{$topic}) {
	if ($key =~ /^title(.(\w+))?$/) {
	    my $lang = $2 || 'default';
	    $title->{$lang} = $topic->{$key};
	}
    }
    
    return $title;
}

## Inner sub used by load_topics()
sub _add_topic {
    my ($name, $title) = @_;
    my $topic = {};

    my @tree = split '/', $name;
    if ($#tree == 0) {
	return {'title' => $title};
    }else {
	$topic->{'sub'}{$name} = &_add_topic(join ('/', @tree[1..$#tree]), $title);
	return $topic;
    }
}

############ THIS IS RELATED TO NEW LOAD_ADMIN_FILE #############

## Sort function for writing config files
sub by_order {
    ($::pinfo{$main::a}{'order'} <=> $::pinfo{$main::b}{'order'}) || ($main::a cmp $main::b);
}

## Apply defaults to parameters definition (%::pinfo)
sub _apply_defaults {
    do_log('debug3', 'List::_apply_defaults()');

    ## List of available languages
    $::pinfo{'lang'}{'format'} = &Language::GetSupportedLanguages();

    ## Parameter order
    foreach my $index (0..$#param_order) {
	if ($param_order[$index] eq '*') {
	    $default{'order'} = $index;
	}else {
	    $::pinfo{$param_order[$index]}{'order'} = $index;
	}
    }

    ## Parameters
    foreach my $p (keys %::pinfo) {

	## Apply defaults to %pinfo
	foreach my $d (keys %default) {
	    unless (defined $::pinfo{$p}{$d}) {
		$::pinfo{$p}{$d} = $default{$d};
	    }
	}

	## Scenario format
	if ($::pinfo{$p}{'scenario'}) {
	    $::pinfo{$p}{'format'} = &tools::get_regexp('scenario');
	    $::pinfo{$p}{'default'} = 'default';
	}

	## Task format
	if ($::pinfo{$p}{'task'}) {
	    $::pinfo{$p}{'format'} = &tools::get_regexp('task');
	}

	## Datasource format
	if ($::pinfo{$p}{'datasource'}) {
	    $::pinfo{$p}{'format'} = &tools::get_regexp('datasource');
	}

	## Enumeration
	if (ref ($::pinfo{$p}{'format'}) eq 'ARRAY') {
	    $::pinfo{$p}{'file_format'} ||= join '|', @{$::pinfo{$p}{'format'}};
	}


	## Set 'format' as default for 'file_format'
	$::pinfo{$p}{'file_format'} ||= $::pinfo{$p}{'format'};
	
	if (($::pinfo{$p}{'occurrence'} =~ /n$/) 
	    && $::pinfo{$p}{'split_char'}) {
	    my $format = $::pinfo{$p}{'file_format'};
	    my $char = $::pinfo{$p}{'split_char'};
	    $::pinfo{$p}{'file_format'} = "($format)*(\\s*$char\\s*($format))*";
	}


	next unless ((ref $::pinfo{$p}{'format'} eq 'HASH')
		     && (ref $::pinfo{$p}{'file_format'} eq 'HASH'));
	
	## Parameter is a Paragraph)
	foreach my $k (keys %{$::pinfo{$p}{'format'}}) {
	    ## Defaults
	    foreach my $d (keys %default) {
		unless (defined $::pinfo{$p}{'format'}{$k}{$d}) {
		    $::pinfo{$p}{'format'}{$k}{$d} = $default{$d};
		}
	    }
	    
	    ## Scenario format
	    if (ref($::pinfo{$p}{'format'}{$k}) && $::pinfo{$p}{'format'}{$k}{'scenario'}) {
		$::pinfo{$p}{'format'}{$k}{'format'} = &tools::get_regexp('scenario');
		$::pinfo{$p}{'format'}{$k}{'default'} = 'default' unless (($p eq 'web_archive') && ($k eq 'access'));
	    }

	    ## Task format
	    if (ref($::pinfo{$p}{'format'}{$k}) && $::pinfo{$p}{'format'}{$k}{'task'}) {
		$::pinfo{$p}{'format'}{$k}{'format'} = &tools::get_regexp('task');
	    }

	    ## Datasource format
	    if (ref($::pinfo{$p}{'format'}{$k}) && $::pinfo{$p}{'format'}{$k}{'datasource'}) {
		$::pinfo{$p}{'format'}{$k}{'format'} = &tools::get_regexp('datasource');
	    }

	    ## Enumeration
	    if (ref ($::pinfo{$p}{'format'}{$k}{'format'}) eq 'ARRAY') {
		$::pinfo{$p}{'file_format'}{$k}{'file_format'} ||= join '|', @{$::pinfo{$p}{'format'}{$k}{'format'}};
	    }

	    
	    if (($::pinfo{$p}{'file_format'}{$k}{'occurrence'} =~ /n$/) 
		&& $::pinfo{$p}{'file_format'}{$k}{'split_char'}) {
		my $format = $::pinfo{$p}{'file_format'}{$k}{'file_format'};
		my $char = $::pinfo{$p}{'file_format'}{$k}{'split_char'};
		$::pinfo{$p}{'file_format'}{$k}{'file_format'} = "($format)*(\\s*$char\\s*($format))*";
	    }

	}

	next unless (ref $::pinfo{$p}{'file_format'} eq 'HASH');

	foreach my $k (keys %{$::pinfo{$p}{'file_format'}}) {
	    ## Set 'format' as default for 'file_format'
	    $::pinfo{$p}{'file_format'}{$k}{'file_format'} ||= $::pinfo{$p}{'file_format'}{$k}{'format'};
	}
    }

    return \%::pinfo;
}

## Save a parameter
sub _save_list_param {
    my ($key, $p, $defaults, $fd) = @_;
    &do_log('debug3', '_save_list_param(%s)', $key);

    ## Ignore default value
    return 1 if ($defaults == 1);
#    next if ($defaults == 1);

    return 1 unless (defined ($p));
#    next  unless (defined ($p));

    if (defined ($::pinfo{$key}{'scenario'}) ||
        defined ($::pinfo{$key}{'task'}) ) {
	return 1 if ($p->{'name'} eq 'default');

	$fd->print(sprintf "%s %s\n", $key, $p->{'name'});
	$fd->print("\n");

    }elsif (ref($::pinfo{$key}{'file_format'})) {
	$fd->print(sprintf "%s\n", $key);
	foreach my $k (keys %{$p}) {

	    if (defined ($::pinfo{$key}{'file_format'}{$k}{'scenario'}) ) {
		## Skip if empty value
		next if ($p->{$k}{'name'} =~ /^\s*$/);

		$fd->print(sprintf "%s %s\n", $k, $p->{$k}{'name'});

	    }elsif (($::pinfo{$key}{'file_format'}{$k}{'occurrence'} =~ /n$/)
		    && $::pinfo{$key}{'file_format'}{$k}{'split_char'}) {
		
		$fd->print(sprintf "%s %s\n", $k, join($::pinfo{$key}{'file_format'}{$k}{'split_char'}, @{$p->{$k}}));
	    }else {
		## Skip if empty value
		next if ($p->{$k} =~ /^\s*$/);

		$fd->print(sprintf "%s %s\n", $k, $p->{$k});
	    }
	}
	$fd->print("\n");

    }else {
	if (($::pinfo{$key}{'occurrence'} =~ /n$/)
	    && $::pinfo{$key}{'split_char'}) {
	    ################" avant de debugger do_edit_list qui crée des nouvelles entrées vides
 	    my $string = join($::pinfo{$key}{'split_char'}, @{$p});
 	    $string =~ s/\,\s*$//;
	    
 	    $fd->print(sprintf "%s %s\n\n", $key, $string);
	}elsif ($key eq 'digest') {
	    my $value = sprintf '%s %d:%d', join(',', @{$p->{'days'}})
		,$p->{'hour'}, $p->{'minute'};
	    $fd->print(sprintf "%s %s\n\n", $key, $value);
	}else {
	    $fd->print(sprintf "%s %s\n\n", $key, $p);
	}
    }
    
    return 1;
}

## Load a single line
sub _load_list_param {
    my ($robot,$key, $value, $p, $directory) = @_;
    &do_log('debug3','_load_list_param(%s,\'%s\',\'%s\')', $robot,$key, $value);
    
    ## Empty value
    if ($value =~ /^\s*$/) {
	return undef;
    }

    ## Default
    if ($value eq 'default') {
	$value = $p->{'default'};
    }

    ## Search configuration file
    if (ref($value) && defined $value->{'conf'}) {
	$value = &Conf::get_robot_conf($robot, $value->{'conf'});
    }

    ## Synonyms
    if (defined $p->{'synonym'}{$value}) {
	$value = $p->{'synonym'}{$value};
    }

    ## Scenario
    if ($p->{'scenario'}) {
	$value =~ y/,/_/;
	my $scenario = new Scenario ('function' => $p->{'scenario'},
				     'robot' => $robot, 
				     'name' => $value, 
				     'directory' => $directory);

	## We store the path of the scenario in the sstructure
	## Later &Scenario::request_action() will look for the scenario in %Scenario::all_scenarios through Scenario::new()
	$value = {'file_path' => $scenario->{'file_path'},
		  'name' => $scenario->{'name'}};
    }elsif ($p->{'task'}) {
	$value = {'name' => $value};
    }

    ## Do we need to split param if it is not already an array
    if (($p->{'occurrence'} =~ /n$/)
	&& $p->{'split_char'}
	&& !(ref($value) eq 'ARRAY')) {
	my @array = split /$p->{'split_char'}/, $value;
	foreach my $v (@array) {
	    $v =~ s/^\s*(.+)\s*$/$1/g;
	}
	
	return \@array;
    }else {
	return $value;
    }
}



## Load the certificat file
sub get_cert {

    my $self = shift;
    my $format = shift;

    ## Default format is PEM (can be DER)
    $format ||= 'pem';

    do_log('debug2', 'List::load_cert(%s)',$self->{'name'});

    # we only send the encryption certificate: this is what the user
    # needs to send mail to the list; if he ever gets anything signed,
    # it will have the respective cert attached anyways.
    # (the problem is that netscape, opera and IE can't only
    # read the first cert in a file)
    my($certs,$keys) = tools::smime_find_keys($self->{dir},'encrypt');

    my @cert;
    if ($format eq 'pem') {
	unless(open(CERT, $certs)) {
	    do_log('err', "List::get_cert(): Unable to open $certs: $!");
	    return undef;
	}
	
	my $state;
	while(<CERT>) {
	    chomp;
	    if($state == 1) {
		# convert to CRLF for windows clients
		push(@cert, "$_\r\n");
		if(/^-+END/) {
		    pop @cert;
		    last;
		}
	    }elsif (/^-+BEGIN/) {
		$state = 1;
	    }
	}
	close CERT ;
    }elsif ($format eq 'der') {
	unless (open CERT, "$Conf::Conf{'openssl'} x509 -in $certs -outform DER|") {
	    do_log('err', "$Conf::Conf{'openssl'} x509 -in $certs -outform DER|");
	    do_log('err', "List::get_cert(): Unable to open get $certs in DER format: $!");
	    return undef;
	}

	@cert = <CERT>;
	close CERT;
    }else {
	do_log('err', "List::get_cert(): unknown '$format' certificate format");
	return undef;
    }
    
    return @cert;
}

## Load a config file of a list
sub _load_admin_file {
    my ($directory,$robot, $file) = @_;
    do_log('debug3', 'List::_load_admin_file(%s, %s, %s)', $directory, $robot, $file);

    my $config_file = $directory.'/'.$file;

    my %admin;
    my (@paragraphs);

    ## Just in case...
    local $/ = "\n";

    ## Set defaults to 1
    foreach my $pname (keys %::pinfo) {
	$admin{'defaults'}{$pname} = 1 unless ($::pinfo{$pname}{'internal'});
    }

    ## Lock file
    my $lock = new Lock ($config_file);
    unless (defined $lock) {
	&do_log('err','Could not create new lock on %s',$config_file);
	return undef;
    }
    $lock->set_timeout(5); 
    unless ($lock->lock('read')) {
	&do_log('err','Could not put a read lock on the config file %s',$config_file);
	return undef;
    }   

    unless (open CONFIG, "<", $config_file) {
	&do_log('info', 'Cannot open %s', $config_file);
    }

    ## Split in paragraphs
    my $i = 0;
    while (<CONFIG>) {
	if (/^\s*$/) {
	    $i++ if $paragraphs[$i];
	}else {
	    push @{$paragraphs[$i]}, $_;
	}
    }

    for my $index (0..$#paragraphs) {
	my @paragraph = @{$paragraphs[$index]};

	my $pname;

	## Clean paragraph, keep comments
	for my $i (0..$#paragraph) {
	    my $changed = undef;
	    for my $j (0..$#paragraph) {
		if ($paragraph[$j] =~ /^\s*\#/) {
		    chomp($paragraph[$j]);
		    push @{$admin{'comment'}}, $paragraph[$j];
		    splice @paragraph, $j, 1;
		    $changed = 1;
		}elsif ($paragraph[$j] =~ /^\s*$/) {
		    splice @paragraph, $j, 1;
		    $changed = 1;
		}

		last if $changed;
	    }

	    last unless $changed;
	}

	## Empty paragraph
	next unless ($#paragraph > -1);
	
	## Look for first valid line
	unless ($paragraph[0] =~ /^\s*([\w-]+)(\s+.*)?$/) {
	    &do_log('err', 'Bad paragraph "%s" in %s, ignore it', @paragraph, $config_file);
	    next;
	}
	    
	$pname = $1;

	## Parameter aliases (compatibility concerns)
	if (defined $alias{$pname}) {
	    $paragraph[0] =~ s/^\s*$pname/$alias{$pname}/;
	    $pname = $alias{$pname};
	}
	
	unless (defined $::pinfo{$pname}) {
	    &do_log('err', 'Unknown parameter "%s" in %s, ignore it', $pname, $config_file);
	    next;
	}

	## Uniqueness
	if (defined $admin{$pname}) {
	    unless (($::pinfo{$pname}{'occurrence'} eq '0-n') or
		    ($::pinfo{$pname}{'occurrence'} eq '1-n')) {
		&do_log('err', 'Multiple occurrences of a unique parameter "%s" in %s', $pname, $config_file);
	    }
	}
	
	## Line or Paragraph
	if (ref $::pinfo{$pname}{'file_format'} eq 'HASH') {
	    ## This should be a paragraph
	    unless ($#paragraph > 0) {
		&do_log('err', 'Expecting a paragraph for "%s" parameter in %s, ignore it', $pname, $config_file);
		next;
	    }
	    
	    ## Skipping first line
	    shift @paragraph;

	    my %hash;
	    for my $i (0..$#paragraph) {	    
		next if ($paragraph[$i] =~ /^\s*\#/);
		
		unless ($paragraph[$i] =~ /^\s*(\w+)\s*/) {
		    &do_log('err', 'Bad line "%s" in %s',$paragraph[$i], $config_file);
		}
		
		my $key = $1;
		
		unless (defined $::pinfo{$pname}{'file_format'}{$key}) {
		    &do_log('err', 'Unknown key "%s" in paragraph "%s" in %s', $key, $pname, $config_file);
		    next;
		}
		
		unless ($paragraph[$i] =~ /^\s*$key\s+($::pinfo{$pname}{'file_format'}{$key}{'file_format'})\s*$/i) {
		    chomp($paragraph[$i]);
		    &do_log('err', 'Bad entry "%s" for key "%s", paragraph "%s" in file "%s"', $paragraph[$i], $key, $pname, $config_file);
		    next;
		}

		$hash{$key} = &_load_list_param($robot,$key, $1, $::pinfo{$pname}{'file_format'}{$key}, $directory);
	    }

	    ## Apply defaults & Check required keys
	    my $missing_required_field;
	    foreach my $k (keys %{$::pinfo{$pname}{'file_format'}}) {

		## Default value
		unless (defined $hash{$k}) {
		    if (defined $::pinfo{$pname}{'file_format'}{$k}{'default'}) {
			$hash{$k} = &_load_list_param($robot,$k, 'default', $::pinfo{$pname}{'file_format'}{$k}, $directory);
		    }
		}

		## Required fields
		if ($::pinfo{$pname}{'file_format'}{$k}{'occurrence'} eq '1') {
		    unless (defined $hash{$k}) {
			&do_log('info', 'Missing key "%s" in param "%s" in %s', $k, $pname, $config_file);
			$missing_required_field++;
		    }
		}
	    }

	    next if $missing_required_field;

	    delete $admin{'defaults'}{$pname};

	    ## Should we store it in an array
	    if (($::pinfo{$pname}{'occurrence'} =~ /n$/)) {
		push @{$admin{$pname}}, \%hash;
	    }else {
		$admin{$pname} = \%hash;
	    }
	}else {
	    ## This should be a single line
	    unless ($#paragraph == 0) {
		&do_log('info', 'Expecting a single line for "%s" parameter in %s', $pname, $config_file);
	    }

	    unless ($paragraph[0] =~ /^\s*$pname\s+($::pinfo{$pname}{'file_format'})\s*$/i) {
		chomp($paragraph[0]);
		&do_log('info', 'Bad entry "%s" in %s', $paragraph[0], $config_file);
		next;
	    }

	    my $value = &_load_list_param($robot,$pname, $1, $::pinfo{$pname}, $directory);

	    delete $admin{'defaults'}{$pname};

	    if (($::pinfo{$pname}{'occurrence'} =~ /n$/)
		&& ! (ref ($value) =~ /^ARRAY/)) {
		push @{$admin{$pname}}, $value;
	    }else {
		$admin{$pname} = $value;
	    }
	}
    }
    
    close CONFIG;

    ## Release the lock
    unless ($lock->unlock()) {
	&do_log('err', 'Could not remove the read lock on file %s',$config_file);
	return undef;
    }

    ## Apply defaults & check required parameters
    foreach my $p (keys %::pinfo) {

	## Defaults
	unless (defined $admin{$p}) {

	    ## Simple (versus structured) parameter case
	    if (defined $::pinfo{$p}{'default'}) {
		$admin{$p} = &_load_list_param($robot,$p, $::pinfo{$p}{'default'}, $::pinfo{$p}, $directory);

	    ## Sructured parameters case : the default values are defined at the next level
	    }elsif ((ref $::pinfo{$p}{'format'} eq 'HASH')
		    && ($::pinfo{$p}{'occurrence'} =~ /1$/)) {
		## If the paragraph is not defined, try to apply defaults
		my $hash;
		
		foreach my $key (keys %{$::pinfo{$p}{'format'}}) {

		    ## Skip keys without default value.
		    unless (defined $::pinfo{$p}{'format'}{$key}{'default'}) {
			next;
		    }
		    
		    $hash->{$key} = &_load_list_param($robot,$key, $::pinfo{$p}{'format'}{$key}{'default'}, $::pinfo{$p}{'format'}{$key}, $directory);
		}

		$admin{$p} = $hash if (defined $hash);

	    }

#	    $admin{'defaults'}{$p} = 1;
	}
	
	## Required fields
	if ($::pinfo{$p}{'occurrence'} =~ /^1(-n)?$/ ) {
	    unless (defined $admin{$p}) {
		&do_log('info','Missing parameter "%s" in %s', $p, $config_file);
	    }
	}
    }

    ## "Original" parameters
    if (defined ($admin{'digest'})) {
	if ($admin{'digest'} =~ /^(.+)\s+(\d+):(\d+)$/) {
	    my $digest = {};
	    $digest->{'hour'} = $2;
	    $digest->{'minute'} = $3;
	    my $days = $1;
	    $days =~ s/\s//g;
	    @{$digest->{'days'}} = split /,/, $days;

	    $admin{'digest'} = $digest;
	}
    }
    # The 'host' parameter is ignored if the list is stored on a 
    #  virtual robot directory
   
    # $admin{'host'} = $self{'domain'} if ($self{'dir'} ne '.'); 

	
    if (defined ($admin{'custom_subject'})) {
	if ($admin{'custom_subject'} =~ /^\s*\[\s*(\w+)\s*\]\s*$/) {
	    $admin{'custom_subject'} = $1;
	}
    }

    ## Format changed for reply_to parameter
    ## New reply_to_header parameter
    if (($admin{'forced_reply_to'} && ! $admin{'defaults'}{'forced_reply_to'}) ||
	($admin{'reply_to'} && ! $admin{'defaults'}{'reply_to'})) {
	my ($value, $apply, $other_email);
	$value = $admin{'forced_reply_to'} || $admin{'reply_to'};
	$apply = 'forced' if ($admin{'forced_reply_to'});
	if ($value =~ /\@/) {
	    $other_email = $value;
	    $value = 'other_email';
	}

	$admin{'reply_to_header'} = {'value' => $value,
				     'other_email' => $other_email,
				     'apply' => $apply};

	## delete old entries
	$admin{'reply_to'} = undef;
	$admin{'forced_reply_to'} = undef;
    }

    ############################################
    ## Below are constraints between parameters
    ############################################

    ## Do we have a database config/access
    unless ($List::use_db) {
	&do_log('info', 'Sympa not setup to use DBI or no database access');
	## We should notify the listmaster here...
	#return undef;
    }

    ## This default setting MUST BE THE LAST ONE PERFORMED
#    if ($admin{'status'} ne 'open') {
#	## requested and closed list are just list hidden using visibility parameter
#	## and with send parameter set to closed.
#	$admin{'send'} = &_load_list_param('.','send', 'closed', $::pinfo{'send'}, $directory);
#	$admin{'visibility'} = &_load_list_param('.','visibility', 'conceal', $::pinfo{'visibility'}, $directory);
#    }

    ## reception of default_user_options must be one of reception of
    ## available_user_options. If none, warning and put reception of
    ## default_user_options in reception of available_user_options
    if (! grep (/^$admin{'default_user_options'}{'reception'}$/,
		@{$admin{'available_user_options'}{'reception'}})) {
      push @{$admin{'available_user_options'}{'reception'}}, $admin{'default_user_options'}{'reception'};
      do_log('info','reception is not compatible between default_user_options and available_user_options in %s',$directory);
    }

    return \%admin;
}

## Save a config file
sub _save_admin_file {
    my ($config_file, $old_config_file, $admin) = @_;
    do_log('debug3', 'List::_save_admin_file(%s, %s, %s)', $config_file,$old_config_file, $admin);

    unless (rename $config_file, $old_config_file) {
	&do_log('notice', 'Cannot rename %s to %s', $config_file, $old_config_file);
	return undef;
    }

    unless (open CONFIG, ">", $config_file) {
	&do_log('info', 'Cannot open %s', $config_file);
	return undef;
    }
    my $config = '';
    my $fd = new IO::Scalar \$config;
    
    foreach my $c (@{$admin->{'comment'}}) {
	$fd->print(sprintf "%s\n", $c);
    }
    $fd->print("\n");

    foreach my $key (sort by_order keys %{$admin}) {

	next if ($key =~ /^(comment|defaults)$/);
	next unless (defined $admin->{$key});

	## Multiple parameter (owner, custom_header,...)
	if ((ref ($admin->{$key}) eq 'ARRAY') &&
	    ! $::pinfo{$key}{'split_char'}) {
	    foreach my $elt (@{$admin->{$key}}) {
		&_save_list_param($key, $elt, $admin->{'defaults'}{$key}, $fd);
	    }
	}else {
	    &_save_list_param($key, $admin->{$key}, $admin->{'defaults'}{$key}, $fd);
	}

    }
    print CONFIG $config;
    close CONFIG;

    return 1;
}

# Is a reception mode in the parameter reception of the available_user_options
# section?
sub is_available_reception_mode {
  my ($self,$mode) = @_;
  $mode =~ y/[A-Z]/[a-z]/;
  
  return undef unless ($self && $mode);

  my @available_mode = @{$self->{'admin'}{'available_user_options'}{'reception'}};
  
  foreach my $m (@available_mode) {
    if ($m eq $mode) {
      return $mode;
    }
  }

  return undef;
}

# List the parameter reception of the available_user_options section 
# Note: Since Sympa 6.1.18, this returns an array under array context.
sub available_reception_mode {
    my $self = shift;
    return @{$self->{'admin'}{'available_user_options'}{'reception'} || []}
	if wantarray;
    return join(' ', @{$self->{'admin'}{'available_user_options'}{'reception'} || []});
}

########################################################################################
#                       FUNCTIONS FOR MESSAGE TOPICS                                   #
########################################################################################
#                                                                                      #
#                                                                                      #


####################################################
# is_there_msg_topic
####################################################
#  Test if some msg_topic are defined
# 
# IN : -$self (+): ref(List)
#      
# OUT : 1 - some are defined | 0 - not defined
####################################################
sub is_there_msg_topic {
    my ($self) = shift;
    
    if (defined $self->{'admin'}{'msg_topic'}) {
	if (ref($self->{'admin'}{'msg_topic'}) eq "ARRAY") {
	    if ($#{$self->{'admin'}{'msg_topic'}} >= 0) {
		return 1;
	    }
	}
    }
    return 0;
}

 
####################################################
# is_available_msg_topic
####################################################
#  Checks for a topic if it is available in the list
# (look foreach list parameter msg_topic.name)
# 
# IN : -$self (+): ref(List)
#      -$topic (+): string
# OUT : -$topic if it is available  | undef
####################################################
sub is_available_msg_topic {
    my ($self,$topic) = @_;
    
    my @available_msg_topic;
    foreach my $msg_topic (@{$self->{'admin'}{'msg_topic'}}) {
	return $topic
	    if ($msg_topic->{'name'} eq $topic);
    }
    
    return undef;
}


####################################################
# get_available_msg_topic
####################################################
#  Return an array of available msg topics (msg_topic.name)
# 
# IN : -$self (+): ref(List)
#
# OUT : -\@topics : ref(ARRAY)
####################################################
sub get_available_msg_topic {
    my ($self) = @_;
    
    my @topics;
    foreach my $msg_topic (@{$self->{'admin'}{'msg_topic'}}) {
	if ($msg_topic->{'name'}) {
	    push @topics,$msg_topic->{'name'};
	}
    }
    
    return \@topics;
}

####################################################
# is_msg_topic_tagging_required
####################################################
# Checks for the list parameter msg_topic_tagging
# if it is set to 'required'
#
# IN : -$self (+): ref(List)
#
# OUT : 1 - the msg must must be tagged 
#       | 0 - the msg can be no tagged
####################################################
sub is_msg_topic_tagging_required {
    my ($self) = @_;
    
    if ($self->{'admin'}{'msg_topic_tagging'} =~ /required/) {
	return 1;
    } else {
	return 0;
    }
}

####################################################
# automatic_tag
####################################################
#  Compute the topic(s) of the message and tag it.
#
# IN : -$self (+): ref(List)
#      -$msg (+): ref(MIME::Entity)
#      -$robot (+): robot
#
# OUT : string of tag(s), can be separated by ',', can be empty
#        | undef 
####################################################
sub automatic_tag {
    my ($self,$msg,$robot) = @_;
    my $msg_id = $msg->head->get('Message-ID');
    chomp($msg_id);
    &do_log('debug3','automatic_tag(%s,%s)',$self->{'name'},$msg_id);


    my $topic_list = $self->compute_topic($msg,$robot);

    if ($topic_list) {
	my $filename = $self->tag_topic($msg_id,$topic_list,'auto');

	unless ($filename) {
	    &do_log('err','Unable to tag message %s with topic "%s"',$msg_id,$topic_list);
	    return undef;
	}
    } 
	
    return $topic_list;
}


####################################################
# compute_topic
####################################################
#  Compute the topic of the message. The topic is got
#  from applying a regexp on the message, regexp 
#  based on keywords defined in list_parameter
#  msg_topic.keywords. The regexp is applied on the 
#  subject and/or the body of the message according
#  to list parameter msg_topic_keywords_apply_on
#
# IN : -$self (+): ref(List)
#      -$msg (+): ref(MIME::Entity)
#      -$robot(+) : robot
#
# OUT : string of tag(s), can be separated by ',', can be empty
####################################################
sub compute_topic {
    my ($self,$msg,$robot) = @_;
    my $msg_id = $msg->head->get('Message-ID');
    chomp($msg_id);
    &do_log('debug3','compute_topic(%s,%s)',$self->{'name'},$msg_id);
    my @topic_array;
    my %topic_hash;
    my %keywords;


    ## TAGGING INHERITED BY THREAD
    # getting reply-to
    my $reply_to = $msg->head->get('In-Reply-To');
    $reply_to =  &tools::clean_msg_id($reply_to);
    my $info_msg_reply_to = $self->load_msg_topic_file($reply_to,$robot);

    # is msg reply to already tagged?	
    if (ref($info_msg_reply_to) eq "HASH") { 
	return $info_msg_reply_to->{'topic'};
    }
     


    ## TAGGING BY KEYWORDS
    # getting keywords
    foreach my $topic (@{$self->{'admin'}{'msg_topic'}}) {

	my $list_keyw = &tools::get_array_from_splitted_string($topic->{'keywords'});

	foreach my $keyw (@{$list_keyw}) {
	    $keywords{$keyw} = $topic->{'name'}
	}
    }

    # getting string to parse
    # We convert it to Unicode for case-ignore match with non-ASCII keywords.
    my $mail_string = '';
    if ($self->{'admin'}{'msg_topic_keywords_apply_on'} eq 'subject'){
	$mail_string = Encode::decode_utf8(&tools::decode_header($msg, 'Subject'))."\n";
    }
    unless ($self->{'admin'}{'msg_topic_keywords_apply_on'} eq 'subject') {
	# get bodies of any text/* parts, not digging nested subparts.
	my @parts;
	if ($msg->effective_type =~ /^(multipart|message)\//i) {
	    @parts = $msg->parts();
	} else {
	    @parts = ($msg);
	}
	foreach my $part (@parts) {
	    next unless $part->effective_type =~ /^text\//i;
	    my $charset = $part->head->mime_attr("Content-Type.Charset");
	    $charset = MIME::Charset->new($charset);
	    if (defined $part->bodyhandle) {
		my $body = $part->bodyhandle->as_string();
		my $converted;
		eval {
		    $converted = $charset->decode($body);
		};
		if ($@) {
		    $converted = Encode::decode('US-ASCII', $body);
		}
		$mail_string .= $converted."\n";
	    }
	}
    }

    # parsing
    foreach my $keyw (keys %keywords) {
	my $k = $keywords{$keyw};
	$keyw = Encode::decode_utf8($keyw);
	$keyw = &tools::escape_regexp($keyw);
	if ($mail_string =~ /$keyw/i){
	    $topic_hash{$k} = 1;
	}
    }


    
    # for no double
    foreach my $k (keys %topic_hash) {
	push @topic_array,$k if ($topic_hash{$k});
    }
    
    if ($#topic_array <0) {
	return '';

    } else {
	return (join(',',@topic_array));
    }
}

####################################################
# tag_topic
####################################################
#  tag the message by creating the msg topic file
# 
# IN : -$self (+): ref(List)
#      -$msg_id (+): string, msg_id of the msg to tag
#      -$topic_list (+): string (splitted by ',')
#      -$method (+) : 'auto'|'editor'|'sender'
#         the method used for tagging
#
# OUT : string - msg topic filename
#       | undef
####################################################
sub tag_topic {
    my ($self,$msg_id,$topic_list,$method) = @_;
    &do_log('debug3','tag_topic(%s,%s,"%s",%s)',$self->{'name'},$msg_id,$topic_list,$method);

    my $robot = $self->{'domain'};
    my $queuetopic = &Conf::get_robot_conf($robot, 'queuetopic');
    my $list_id = $self->get_list_id();
    $msg_id = &tools::clean_msg_id($msg_id);
    $msg_id =~ s/>$//;
    my $file = $list_id.'.'.$msg_id;

    unless (open (FILE, ">$queuetopic/$file")) {
	&do_log('info','Unable to create msg topic file %s/%s : %s', $queuetopic,$file, $!);
	return undef;
    }

    print FILE "TOPIC   $topic_list\n";
    print FILE "METHOD  $method\n";

    close FILE;

    return "$queuetopic/$file";
}



####################################################
# load_msg_topic_file
####################################################
#  Looks for a msg topic file from the msg_id of 
# the message, loads it and return contained information 
# in a HASH
#
# IN : -$self (+): ref(List)
#      -$msg_id (+): the message ID 
#      -$robot (+): the robot
#
# OUT : ref(HASH) file contents : 
#         - topic : string - list of topic name(s)
#         - method : editor|sender|auto - method used to tag
#         - msg_id : the msg_id
#         - filename : name of the file containing this information 
#     | undef 
####################################################
sub load_msg_topic_file {
    my ($self,$msg_id,$robot) = @_;
    $msg_id = &tools::clean_msg_id($msg_id);
    &do_log('debug3','List::load_msg_topic_file(%s,%s)',$self->{'name'},$msg_id);
    
    my $queuetopic = &Conf::get_robot_conf($robot, 'queuetopic');
    my $list_id = $self->get_list_id();
    my $file = "$list_id.$msg_id";
    
    unless (open (FILE, "$queuetopic/$file")) {
	&do_log('debug','No topic define ; unable to open %s/%s : %s', $queuetopic,$file, $!);
	return undef;
    }
    
    my %info = ();
    
    while (<FILE>) {
	next if /^\s*(\#.*|\s*)$/;
	
	if (/^(\S+)\s+(.+)$/io) {
	    my($keyword, $value) = ($1, $2);
	    $value =~ s/\s*$//;
	    
	    if ($keyword eq 'TOPIC') {
		$info{'topic'} = $value;
		
	    }elsif ($keyword eq 'METHOD') {
		if ($value =~ /^(editor|sender|auto)$/) {
		    $info{'method'} = $value;
		}else {
		    &do_log('err','List::load_msg_topic_file(%s,%s): syntax error in file %s/%s : %s', $queuetopic,$file, $!);
		    return undef;
		}
	    }
	}
    }
    close FILE;
    
    if ((exists $info{'topic'}) && (exists $info{'method'})) {
	$info{'msg_id'} = $msg_id;
	$info{'filename'} = $file;
	
	return \%info;
    }
    return undef;
}


####################################################
# modifying_msg_topic_for_subscribers()
####################################################
#  Deletes topics subscriber that does not exist anymore
#  and send a notify to concerned subscribers.
# 
# IN : -$self (+): ref(List)
#      -$new_msg_topic (+): ref(ARRAY) - new state 
#        of msg_topic parameters
#
# OUT : -0 if no subscriber topics have been deleted
#       -1 if some subscribers topics have been deleted 
##################################################### 
sub modifying_msg_topic_for_subscribers(){
    my ($self,$new_msg_topic) = @_;
    &do_log('debug3',"List::modifying_msg_topic_for_subscribers($self->{'name'}");
    my $deleted = 0;

    my @old_msg_topic_name;
    foreach my $msg_topic (@{$self->{'admin'}{'msg_topic'}}) {
	push @old_msg_topic_name,$msg_topic->{'name'};
    }

    my @new_msg_topic_name;
    foreach my $msg_topic (@{$new_msg_topic}) {
	push @new_msg_topic_name,$msg_topic->{'name'};
    }

    my $msg_topic_changes = &tools::diff_on_arrays(\@old_msg_topic_name,\@new_msg_topic_name);

    if ($#{$msg_topic_changes->{'deleted'}} >= 0) {
	
	for (my $subscriber=$self->get_first_user(); $subscriber; $subscriber=$self->get_next_user()) {
	    
	    if ($subscriber->{'reception'} eq 'mail') {
		my $topics = &tools::diff_on_arrays($msg_topic_changes->{'deleted'},&tools::get_array_from_splitted_string($subscriber->{'topics'}));
		
		if ($#{$topics->{'intersection'}} >= 0) {
		    my $wwsympa_url = &Conf::get_robot_conf($self->{'domain'}, 'wwsympa_url');
		    unless ($self->send_notify_to_user('deleted_msg_topics',$subscriber->{'email'},
						       {'del_topics' => $topics->{'intersection'},
							'url' => $wwsympa_url.'/suboptions/'.$self->{'name'}})) {
			&do_log('err',"List::modifying_msg_topic_for_subscribers($self->{'name'}) : impossible to send notify to user about 'deleted_msg_topics'");
		    }
		    unless ($self->update_user(lc($subscriber->{'email'}), 
					       {'update_date' => time,
						'topics' => join(',',@{$topics->{'added'}})})) {
			&do_log('err',"List::modifying_msg_topic_for_subscribers($self->{'name'} : impossible to update user '$subscriber->{'email'}'");
		    }
		    $deleted = 1;
		}
	    }
	}
    }
    return 1 if ($deleted);
    return 0;
}

####################################################
# select_subscribers_for_topic
####################################################
# Select users subscribed to a topic that is in
# the topic list incoming when reception mode is 'mail', 'notice', 'not_me', 'txt', 'html' or 'urlize', and the other
# subscribers (recpetion mode different from 'mail'), 'mail' and no topic subscription
# 
# IN : -$self(+) : ref(List)
#      -$string_topic(+) : string splitted by ','
#                          topic list
#      -$subscribers(+) : ref(ARRAY) - list of subscribers(emails)
#
# OUT : @selected_users
#     
#
####################################################
sub select_subscribers_for_topic {
    my ($self,$string_topic,$subscribers) = @_;
    &do_log('debug3', 'List::select_subscribers_for_topic(%s, %s)', $self->{'name'},$string_topic); 
    
    my @selected_users;
    my $msg_topics;

    if ($string_topic) {
	$msg_topics = &tools::get_array_from_splitted_string($string_topic);
    }

    foreach my $user (@$subscribers) {

	# user topic
	my $info_user = $self->get_subscriber($user);

	if ($info_user->{'reception'} !~ /^(mail|notice|not_me|txt|html|urlize)$/i) {
	    push @selected_users,$user;
	    next;
	}
	unless ($info_user->{'topics'}) {
	    push @selected_users,$user;
	    next;
	}
	my $user_topics = &tools::get_array_from_splitted_string($info_user->{'topics'});

	if ($string_topic) {
	    my $result = &tools::diff_on_arrays($msg_topics,$user_topics);
	    if ($#{$result->{'intersection'}} >=0 ) {
		push @selected_users,$user;
	    }
	}else {
	    my $result = &tools::diff_on_arrays(['other'],$user_topics);
	    if ($#{$result->{'intersection'}} >=0 ) {
		push @selected_users,$user;
	    }
	}
    }
    return @selected_users;
}

#                                                                                         #
#                                                                                         # 
#                                                                                         #
########## END - functions for message topics #############################################




sub _urlize_part {
    my $message = shift;
    my $list = shift;
    my $expl = $list->{'dir'}.'/urlized';
    my $robot = $list->{'domain'};
    my $dir = shift;
    my $i = shift;
    my $mime_types = shift;
    my $listname = $list->{'name'};
    my $wwsympa_url = shift;

    my $head = $message->head ;
    my $encoding = $head->mime_encoding ;

    ##  name of the linked file
    my $fileExt = $mime_types->{$head->mime_type};
    if ($fileExt) {
	$fileExt = '.'.$fileExt;
    }
    my $filename;

    if ($head->recommended_filename) {
	$filename = $head->recommended_filename;
    } else {
        $filename ="msg.$i".$fileExt;
    }
  
    ##create the linked file 	
    ## Store body in file 
    if (open OFILE, ">$expl/$dir/$filename") {
	my $ct = $message->effective_type || 'text/plain';
	printf OFILE "Content-type: %s", $ct;
	printf OFILE "; Charset=%s", $head->mime_attr('Content-Type.Charset')
	    if $head->mime_attr('Content-Type.Charset') =~ /\S/;
	print OFILE "\n\n";
    } else {
	&do_log('notice', "Unable to open $expl/$dir/$filename") ;
	return undef ; 
    }
    
    if ($encoding =~ /^(binary|7bit|8bit|base64|quoted-printable|x-uu|x-uuencode|x-gzip64)$/ ) {
	open TMP, ">$expl/$dir/$filename.$encoding";
	$message->print_body (\*TMP);
	close TMP;

	open BODY, "$expl/$dir/$filename.$encoding";
	my $decoder = new MIME::Decoder $encoding;
	$decoder->decode(\*BODY, \*OFILE);
	unlink "$expl/$dir/$filename.$encoding";
    }else {
	$message->print_body (\*OFILE) ;
    }
    close (OFILE);
    my $file = "$expl/$dir/$filename";
    my $size = (-s $file);

    ## Only URLize files with a moderate size
    if ($size < $Conf::Conf{'urlize_min_size'}) {
	unlink "$expl/$dir/$filename";
	return undef;
    }
	    
    ## Delete files created twice or more (with Content-Type.name and Content-Disposition.filename)
    $message->purge ;	

    (my $file_name = $filename) =~ s/\./\_/g;
    my $file_url = "$wwsympa_url/attach/$listname".&tools::escape_chars("$dir/$filename",'/'); # do NOT escape '/' chars

    my $parser = new MIME::Parser;
    $parser->output_to_core(1);
    my $new_part;

    my $lang = &Language::GetLang();
    my $charset = &Language::GetCharset();

    my $tt2_include_path = &tools::make_tt2_include_path($robot,'mail_tt2',$lang,$list);

    &tt2::parse_tt2({'file_name' => $file_name,
		     'file_url'  => $file_url,
		     'file_size' => $size ,
		     'charset' => $charset},
		    'urlized_part.tt2',
		    \$new_part,
		    $tt2_include_path);

    my $entity = $parser->parse_data(\$new_part);

    return $entity;
}

sub store_subscription_request {
    my ($self, $email, $gecos, $custom_attr) = @_;
    &do_log('debug2', '(%s, %s, %s)', $self->{'name'}, $email, $gecos, $custom_attr);

    my $filename = $Conf::Conf{'queuesubscribe'}.'/'.$self->get_list_id().'.'.time.'.'.int(rand(1000));

    unless (opendir SUBSPOOL, "$Conf::Conf{'queuesubscribe'}") {
	&do_log('err', 'Could not open %s', $Conf::Conf{'queuesubscribe'});
	return undef;
    }
    
    my @req_files = sort grep (!/^\.+$/,readdir(SUBSPOOL));
    closedir SUBSPOOL;

    my $listaddr = $self->get_list_id();

    foreach my $file (@req_files) {
	next unless ($file =~ /$listaddr\..*/) ;
	unless (open OLDREQUEST, "$Conf::Conf{'queuesubscribe'}/$file") {
	    &do_log('err', 'Could not open %s for verification', $file);
	    return undef;
	}
	foreach my $line (<OLDREQUEST>) {
	    if ($line =~ /^$email/i) {
		&do_log('notice', 'Subscription already requested by %s', $email);
		return undef;
	    }
	}
	close OLDREQUEST;
    }

    unless (open REQUEST, ">$filename") {
	&do_log('notice', 'Could not open %s', $filename);
	return undef;
    }

    ## First line of the file contains the user email address + his/her name
    print REQUEST "$email\t$gecos\n";

    ## Following lines may contain custom attributes in an XML format
    print REQUEST "$custom_attr\n";

    close REQUEST;

    return 1;
} 

sub get_subscription_requests {
    my ($self) = shift;
    do_log('debug2', 'List::get_subscription_requests(%s)', $self->{'name'});

    my %subscriptions;

    unless (opendir SPOOL, $Conf::Conf{'queuesubscribe'}) {
	&do_log('info', 'Unable to read spool %s', $Conf::Conf{'queuesubscribe'});
	return undef;
    }

    foreach my $filename (sort grep(/^$self->{'name'}(\@$self->{'domain'})?\.\d+\.\d+$/, readdir SPOOL)) {
	unless (open REQUEST, "<:bytes", "$Conf::Conf{'queuesubscribe'}/$filename") {
	    do_log('err', 'Could not open %s', $filename);
	    closedir SPOOL;
	    next;
	}

	## First line of the file contains the user email address + his/her name
	my $line = <REQUEST>;
	my ($email, $gecos);
	if ($line =~ /^((\S+|\".*\")\@\S+)\s*([^\t]*)\t(.*)$/) {
	    ($email, $gecos) = ($1, $3); 
	    
	}else {
	    &do_log('err', "Failed to parse subscription request %s",$filename);
	    next;
	}

	my $user_entry = $self->get_subscriber($email);
	 
	if ( defined($user_entry) && ($user_entry->{'subscribed'} == 1)) {
	    &do_log('err','User %s is subscribed to %s already. Deleting subscription request.', $email, $self->{'name'});
	    unless (unlink "$Conf::Conf{'queuesubscribe'}/$filename") {
		&do_log('err', 'Could not delete file %s', $filename);
	    }
	    next;
	}
	## Following lines may contain custom attributes in an XML format
	my %xml = &parseCustomAttribute(\*REQUEST) ;
	close REQUEST;
	
	$subscriptions{$email} = {'gecos' => $gecos,
				  'custom_attribute' => \%xml};
	unless($subscriptions{$email}{'gecos'}) {
		my $user = get_user_db($email);
		if ($user->{'gecos'}) {
			$subscriptions{$email}{'gecos'} = $user->{'gecos'};
		}
	}

	$filename =~ /^$self->{'name'}(\@$self->{'domain'})?\.(\d+)\.\d+$/;
	$subscriptions{$email}{'date'} = $2;
    }
    closedir SPOOL;

    return \%subscriptions;
} 

sub get_subscription_request_count {
    my ($self) = shift;
    do_log('debug2', 'List::get_subscription_requests_count(%s)', $self->{'name'});

    my %subscriptions;
    my $i = 0 ;

    unless (opendir SPOOL, $Conf::Conf{'queuesubscribe'}) {
	&do_log('info', 'Unable to read spool %s', $Conf::Conf{'queuesubscribe'});
	return undef;
    }

    foreach my $filename (sort grep(/^$self->{'name'}(\@$self->{'domain'})?\.\d+\.\d+$/, readdir SPOOL)) {
	$i++;
    }
    closedir SPOOL;

    return $i;
} 

sub delete_subscription_request {
    my ($self, @list_of_email) = @_;
    &do_log('debug2', 'List::delete_subscription_request(%s, %s)', $self->{'name'}, join(',',@list_of_email));

    my $removed_file = 0;
    my $email_regexp = &tools::get_regexp('email');
    
    unless (opendir SPOOL, $Conf::Conf{'queuesubscribe'}) {
	&do_log('info', 'Unable to read spool %s', $Conf::Conf{'queuesubscribe'});
	return undef;
    }

    foreach my $filename (sort grep(/^$self->{'name'}(\@$self->{'domain'})?\.\d+\.\d+$/, readdir SPOOL)) {
	
	unless (open REQUEST, "$Conf::Conf{'queuesubscribe'}/$filename") {
	    &do_log('notice', 'Could not open %s', $filename);
	    next;
	}
	my $line = <REQUEST>;
	close REQUEST;

	foreach my $email (@list_of_email) {

	    unless ($line =~ /^($email_regexp)\s*/ && ($1 eq $email)) {
		next;
	    }
	    
	    unless (unlink "$Conf::Conf{'queuesubscribe'}/$filename") {
		&do_log('err', 'Could not delete file %s', $filename);
		last;
	    }
	    $removed_file++;
	}
    }

    closedir SPOOL;
    
    unless ($removed_file > 0) {
	&do_log('debug2', 'No pending subscription was found for users %s', join(',',@list_of_email));
	return undef;
    }

    return 1;
} 


sub get_shared_size {
    my $self = shift;

    return tools::get_dir_size("$self->{'dir'}/shared");
}

sub get_arc_size {
    my $self = shift;
    my $dir = shift;

    return tools::get_dir_size($dir.'/'.$self->get_list_id());
}

# return the date epoch for next delivery planified for a list
sub  get_next_delivery_date {
    my $self = shift;

    my $dtime = $self->{'admin'}{'delivery_time'} ;
    unless ($dtime =~ /(\d?\d)\:(\d\d)/ ) {
	# if delivery _time if not defined, the delivery time right now
	return time();
    }
    my $h = $1;
    my $m = $2;
    unless ((($h == 24)&&($m == 0))||(($h <= 23)&&($m <= 60))){
	&do_log('err',"ignoring wrong parameter format delivery_time, delivery_tile must be smaller than 24:00");
	return time();
    }
    my $date = time();

    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =  localtime($date);

    my $plannified_time = (($h*60)+$m)*60;       # plannified time in sec
    my $now_time = ((($hour*60)+$min)*60)+$sec;  # Now #sec since to day 00:00
    
    my $result = $date - $now_time + $plannified_time;
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =  localtime($result);

    if ($now_time <= $plannified_time ) {
	return ( $date - $now_time + $plannified_time) ;
    }else{
	return ( $date - $now_time + $plannified_time + (24*3600)); # plannified time is past so report to tomorrow
    }
}


## Searches the include datasource corresponding to the provided ID
sub search_datasource {
    my ($self, $id) = @_;
    &do_log('debug2','List::search_datasource(%s,%s)', $self->{'name'}, $id);

    ## Go through list parameters
    foreach my $p (keys %{$self->{'admin'}}) {
	next unless ($p =~ /^include/);
	
	## Go through sources
	foreach my $s (@{$self->{'admin'}{$p}}) {
	    if (&Datasource::_get_datasource_id($s) eq $id) {
		if (ref($s)) {
 		    return $s->{'name'} || $s->{'host'};
		}else{
		    return $s;
		}
	    }
	}
    }

    return undef;
}

## Return the names of datasources, given a coma-separated list of source ids
# IN : -$class 
#      -$id : datasource ids (coma-separated)
# OUT : -$name : datasources names (scalar)
sub get_datasource_name {
    my ($self, $id) = @_;
    &do_log('debug2','(%s,%s)', $self->{'name'}, $id);
    my %sources;

    my @ids = split /,/,$id;
    foreach my $id (@ids) {
	## User may come twice from the same datasource
	unless (defined ($sources{$id})) {
	    $sources{$id} = $self->search_datasource($id);
	}
    }
    
    return join(', ', values %sources);
}

## Remove a task in the tasks spool
sub remove_task {
    my $self = shift;
    my $task = shift;

    unless (opendir(DIR, $Conf::Conf{'queuetask'})) {
	&do_log ('err', "error : can't open dir %s: %s", $Conf::Conf{'queuetask'}, $!);
	return undef;
    }
    my @tasks = grep !/^\.\.?$/, readdir DIR;
    closedir DIR;

    foreach my $task_file (@tasks) {
	if ($task_file =~ /^(\d+)\.\w*\.$task\.$self->{'name'}\@$self->{'domain'}$/) {
	    unless (unlink("$Conf::Conf{'queuetask'}/$task_file")) {
		&do_log('err', 'Unable to remove task file %s : %s', $task_file, $!);
		return undef;
	    }
	    &do_log('notice', 'Removing task file %s', $task_file);
	}
    }

    return 1;
}

## Close the list (remove from DB, remove aliases, change status to 'closed' or 'family_closed')
sub close {
    my ($self, $email, $status) = @_;

    return undef 
	unless ($self && ($list_of_lists{$self->{'domain'}}{$self->{'name'}}));
    
    ## Dump subscribers, unless list is already closed
    unless ($self->{'admin'}{'status'} eq 'closed') {
	$self->_save_users_file("$self->{'dir'}/subscribers.closed.dump");
    }

    ## Delete users
    my @users;
    for ( my $user = $self->get_first_user(); $user; $user = $self->get_next_user() ){
	push @users, $user->{'email'};
    }
    $self->delete_user('users' => \@users);

    ## Remove entries from admin_table
    foreach my $role ('owner','editor') {
	my @admin_users;
	for ( my $user = $self->get_first_admin_user($role); $user; $user = $self->get_next_admin_user() ){
	    push @admin_users, $user->{'email'};
	}
	$self->delete_admin_user($role, @admin_users);
    }

    ## Change status & save config
    $self->{'admin'}{'status'} = 'closed';

    if (defined $status) {
 	foreach my $s ('family_closed','closed') {
 	    if ($status eq $s) {
 		$self->{'admin'}{'status'} = $status;
 		last;
 	    }
 	}
    }
    
    $self->{'admin'}{'defaults'}{'status'} = 0;

    $self->save_config($email);
    $self->savestats();
    
    $self->remove_aliases();    
    
    return 1;
}

## Remove the list
sub purge {
    my ($self, $email) = @_;

    return undef 
	unless ($self && ($list_of_lists{$self->{'domain'}}{$self->{'name'}}));
    
    ## Remove tasks for this list
    &Task::list_tasks($Conf::Conf{'queuetask'});
    foreach my $task (&Task::get_tasks_by_list($self->get_list_id())) {
	unlink $task->{'filepath'};
    }
    
    ## Close the list first, just in case...
    $self->close();

    if ($self->{'name'}) {
	my $arc_dir = &Conf::get_robot_conf($self->{'domain'},'arc_path');
	&tools::remove_dir($arc_dir.'/'.$self->get_list_id());
	&tools::remove_dir($self->get_bounce_dir());
    }
    
    ## Clean list table if needed
    if ($Conf::Conf{'db_list_cache'} eq 'on') {
		my $statement = sprintf 'DELETE FROM list_table WHERE name_list = %s AND robot_list = %s', $dbh->quote($self->{'name'}), $dbh->quote($self->{'domain'});
		unless ($dbh->do($statement)) {
			&do_log('err', 'Cannot remove list %s (robot %s) from table', $self->{'name'}, $self->{'domain'});
		}
	}
    
    ## Clean memory cache
    delete $list_of_lists{$self->{'domain'}}{$self->{'name'}};

    &tools::remove_dir($self->{'dir'});
    
    return 1;
}

## Remove list aliases
sub remove_aliases {
    my $self = shift;

    return undef 
	unless $self and
	    $list_of_lists{$self->{'domain'}}{$self->{'name'}} and
	    Conf::get_robot_conf($self->{'domain'}, 'sendmail_aliases') !~ /^none$/i;
    
    my $alias_manager = $Conf::Conf{'alias_manager'};
    
    unless (-x $alias_manager) {
	&do_log('err','Cannot run alias_manager %s', $alias_manager);
	return undef;
    }
    
    system (sprintf '%s del %s %s', $alias_manager, $self->{'name'}, $self->{'admin'}{'host'});
    my $status = $? >> 8;
    unless ($status == 0) {
	do_log('err','Failed to remove aliases ; status %d : %s', $status, $!);
	return undef;
    }
    
    &do_log('info','Aliases for list %s removed successfully', $self->{'name'});
    
    return 1;
}


##
## bounce management actions
##

# Sub for removing user
#
sub remove_bouncers {
    my $self = shift;
    my $reftab = shift;
    &do_log('debug','List::remove_bouncers(%s)',$self->{'name'});
    
    ## Log removal
    foreach my $bouncer (@{$reftab}) {
	&do_log('notice','Removing bouncing subsrciber of list %s : %s', $self->{'name'}, $bouncer);
    }

    unless ($self->delete_user('users' => $reftab, 'exclude' =>' 1')){
      &do_log('info','error while calling sub delete_users');
      return undef;
    }
    return 1;
}

#Sub for notifying users : "Be carefull,You're bouncing"
#
sub notify_bouncers{
    my $self = shift;
    my $reftab = shift;
    &do_log('debug','List::notify_bouncers(%s)', $self->{'name'});

    foreach my $user (@$reftab){
 	&do_log('notice','Notifying bouncing subsrciber of list %s : %s', $self->{'name'}, $user);
	unless ($self->send_notify_to_user('auto_notify_bouncers',$user,{})) {
	    &do_log('notice',"Unable to send notify 'auto_notify_bouncers' to $user");
	}
    }
    return 1;
}

## Create the document repository
sub create_shared {
    my $self = shift;

    my $dir = $self->{'dir'}.'/shared';

    if (-e $dir) {
	&do_log('err',"List::create_shared : %s already exists", $dir);
	return undef;
    }

    unless (mkdir ($dir, 0777)) {
	&do_log('err',"List::create_shared : unable to create %s : %s ", $dir, $!);
	return undef;
    }

    return 1;
}

## check if a list  has include-type data sources
sub has_include_data_sources {
    my $self = shift;

    foreach my $type ('include_file','include_list','include_remote_sympa_list','include_sql_query','include_remote_file',
		      'include_ldap_query','include_ldap_2level_query','include_admin','owner_include','editor_include') {
	if (ref($self->{'admin'}{$type}) eq 'ARRAY' && $#{$self->{'admin'}{$type}} >= 0) {
	    return 1;
	}
    }
    
    return 0
}

# move a message to a queue or distribute spool
sub move_message {
    my ($self, $file, $queue) = @_;
    &do_log('debug2', "List::move_message($file, $self->{'name'}, $queue)");

    my $dir = $queue || $Conf::Conf{'queuedistribute'};    
    my $filename = $self->get_list_id().'.'.time.'.'.int(rand(999));

    unless (open OUT, ">$dir/T.$filename") {
	&do_log('err', 'Cannot create file %s', "$dir/T.$filename");
	return undef;
    }
    
    unless (open IN, $file) {
	&do_log('err', 'Cannot open file %s', $file);
	return undef;
    }
    
    print OUT <IN>; close IN; close OUT;
    unless (rename "$dir/T.$filename", "$dir/$filename") {
	&do_log('err', 'Cannot rename file %s into %s',"$dir/T.$filename","$dir/$filename" );
	return undef;
    }
    return 1;
}

## Return the path to the list bounce directory, where bounces are stored
sub get_bounce_dir {
    my $self = shift;

    my $root_dir = &Conf::get_robot_conf($self->{'domain'}, 'bounce_path');
    
    return $root_dir.'/'.$self->get_list_id();
}

## Return the list email address
sub get_list_address {
    my $self = shift;

    return $self->{'name'}.'@'.$self->{'admin'}{'host'};
}

## Return the list ID, different from the list address (uses the robot name)
sub get_list_id {
    my $self = shift;

    return $self->{'name'}.'@'.$self->{'domain'};
}
 
## Support for list config caching in database

sub get_lists_db {
    my $where = shift || '';
    do_log('debug2', 'List::get_lists_db(%s)', $where);

    unless ($List::use_db) {
       &do_log('info', 'Sympa not setup to use DBI');
       return undef;
    }

    my $statement = 'SELECT name_list FROM list_table';
    $statement .= " WHERE $where" if $where;

    my ($l, @lists);

    ## Check database connection
    unless ($dbh and $dbh->ping) {
       return undef unless &db_connect();
    }
    push @sth_stack, $sth;
    &do_log('debug2','SQL: %s', $statement);
    unless ($sth = $dbh->prepare($statement)) {
       &do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
       return undef;
    } 
    unless ($sth->execute) {
       do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr); 
       return undef;
    } 
    while ($l = $sth->fetchrow_hashref) {
       my $name = $l->{'name_list'};
       push @lists, $name;
    }  
    $sth->finish();
    $sth = pop @sth_stack;

    return \@lists;
}

sub _update_list_db
{
    my ($self) = shift;
    my @admins;
    my $i;
    my $adm_txt;
    my $ed_txt;

    my $name = $self->{'name'};
    my $subject = $self->{'admin'}{'subject'} || '';
    my $status = $self->{'admin'}{'status'};
    my $robot = $self->{'domain'};
    my $web_archive  = &is_web_archived($self) || 0; 
    my $topics = '';
    if ($self->{'admin'}{'topics'}) {
       $topics = join(',',@{$self->{'admin'}{'topics'}});
    }
    
    foreach $i (@{$self->{'admin'}{'owner'}}) {
       if (ref($i->{'email'})) {
           push(@admins, @{$i->{'email'}});
       } elsif ($i->{'email'}) {
           push(@admins, $i->{'email'});
       }
    }
    $adm_txt = join(',',@admins) || '';

    undef @admins;
    foreach $i (@{$self->{'admin'}{'editor'}}) {
       if (ref($i->{'email'})) {
           push(@admins, @{$i->{'email'}});
       } elsif ($i->{'email'}) {
           push(@admins, $i->{'email'});
       }
    }
    $ed_txt = join(',',@admins) || '';

    my $statement;
    $statement = sprintf 'INSERT INTO list_table (status_list, name_list, robot_list, subject_list, web_archive_list, topics_list, owners_list, editors_list) VALUES (%s, %s, %s, %s, %d, %s, %s, %s)',
			 $dbh->quote($status), $dbh->quote($name),
			 $dbh->quote($robot), $dbh->quote($subject),
			 ($web_archive ? 1 : 0), $dbh->quote($topics),
			 $dbh->quote($adm_txt), $dbh->quote($ed_txt);
    unless ($dbh->do($statement)) {
	$statement = sprintf 'UPDATE list_table SET status_list = %s, name_list = %s, robot_list = %s, subject_list = %s, web_archive_list = %d, topics_list = %s, owners_list = %s, editors_list = %s WHERE robot_list = %s AND name_list = %s',
			     $dbh->quote($status), $dbh->quote($name),
			     $dbh->quote($robot), $dbh->quote($subject),
			     ($web_archive ? 1 : 0), $dbh->quote($topics),
			     $dbh->quote($adm_txt),$dbh->quote($ed_txt),
			     $dbh->quote($robot), $dbh->quote($name);
	unless ($dbh->do($statement)) {
	    do_log('err','Unable to execute SQL statement "%s" : %s', $statement, $dbh->errstr);
	    return undef;
	}
    }
    return 1;
}

sub _flush_list_db
{
    my ($listname) = shift;
    my $statement;
    unless ($listname) {
	if ($Conf::Conf{'db_type'} eq 'SQLite') {
	    # SQLite does not have TRUNCATE TABLE.
	    $statement = "DELETE FROM list_table";
	} else {
	    $statement =  "TRUNCATE TABLE list_table";
	}
    } else {
        $statement = sprintf "DELETE FROM list_table WHERE name_list = %s", $dbh->quote($listname);
    } 

    unless ($sth = $dbh->prepare($statement)) {
    do_log('err','Unable to prepare SQL statement : %s', $dbh->errstr);
    return undef;
    }
    unless ($sth->execute) {
    do_log('err',"Unable to execute SQL statement '%s' : %s", $statement, $dbh->errstr);
    return undef;
    }
}

##
## Method for UI
##

sub get_option_title {
    my $self = shift;
    my $option = shift;
    my $type = shift || '';
    my $withval = shift || 0;

    my $map = { 'reception' => \%reception_mode,
                'visibility' => \%visibility_mode,
                'status' => \%list_status,
              }->{$type} || \%list_option;
    my $t = $map->{$option} || {};
    if ($t->{'gettext_id'}) {
	my $ret = gettext($t->{'gettext_id'});
	$ret =~ s/^\s+//;
	$ret =~ s/\s+$//;
	return sprintf '%s (%s)', $ret, $option if $withval;
	return $ret;
    }
    return $option;
}


###### END of the List package ######

1;
