#!/usr/bin/perl -w

use CGI qw/:standard :html3 :netscape/;
use CGI::Carp qw/fatalsToBrowser/;
use strict;
BEGIN {
eval('use MIME::Lite');
eval('use MIME::Lite::HTML');
}
use Text::Wrap qw(wrap $columns);
use vars qw($clef $gabarit $message $date $mail_form $type_form $message2);

#-------------- Configuration -------------------
# Liste des abonnes. Droit en ecriture necessaires pour tout le monde
my $bd = "/home/alian/newsletter/perso.txt";
#$bd="/home/Administrateur/public_html/newsletter/perso.txt";
# Identite de la personne envoyant la newsletter
my $expediteur = "alian\@alianwebserver.com"; 
#$expediteur="administrateur";

# Titre des mails
my $titre = "2ème newsletter de Alian Web Server";

# A CHANGER: le nom de ce champ declenche la newsletter
my $password = 'go'; 

# Adresse suivant la soumission de chacun des formulaires
my $url = 'http://www.alianwebserver.com';

# Adresse de la newsletter à envoyer
my $urlNewsletterHTML = 'http://jupiter/~Administrateur/newsletter/newsletter.htm';
#"file:///c|/tmp/newsletter.html";
my $urlNewsletterTxt = 'http://jupiter/~Administrateur/newsletter/newsletter.txt';
#"file:///c|/tmp/newsletter.txt";
#-------------- Fin de configuration -------------------

#--------------------------------------------------------------
# Script effectuant un mailing a une liste d'abonne, envoi en
# HTML ou texte suivant inscription.
# Gere egalement les inscriptions (ajout,modif,suppression)
# Ce script s'appuie sur les possiblités de MIME::Lite et 
# MIME::Lite::HTML
#
# Auteur: alian@alianwebserver.com
#
# $Date: 2000/11/12 19:11:12 $
# $Revision: 1.3 $
#
# $Log: newsletter.cgi,v $
# Revision 1.3  2000/11/12 19:11:12  Administrateur
# - Use of MIME::Lite::HTML
#
# Revision 1.2  2000/03/25 14:25:37  Administrateur
# Ajout gestion CGI des inscriptions
#
# Revision 1.1  2000/03/25 01:30:12  Administrateur
# Premiere version en ligne de commande fonctionnelle
#
#--------------------------------------------------------------
$date = localtime();
# Directive de securite pour -T
$ENV{'PATH'}='';
if (!$ENV{'SCRIPT_NAME'}) {$ENV{'SCRIPT_NAME'}="/newsletter/newsletter.cgi";}
if (!$ENV{'SERVER_NAME'}) {$ENV{'SERVER_NAME'}="www.alianwebserver.com";}
#if (!$ENV{'SCRIPT_NAME'}) {$ENV{'SCRIPT_NAME'}="/~Administrateur/newsletter/newsletter.cgi";}
#if (!$ENV{'SERVER_NAME'}) {$ENV{'SERVER_NAME'}="jupiter";}

#
# Procedure principale
#
if (param($password)) {&send_mail();}
elsif (param('modification')) {&modif_abonne();}
elsif (param('suppression')) {&delete_abonne();}
elsif (param('inscription')) {&ajout_abonne();}
else {&print_forms();}

#
# FORMULAIRES HTML
#

# Affiche les differents formulaires d'inscription, modification 
# et suppression
sub print_forms
	{	
	print header;
	# Formulaire de modification du type d'envoi de la newsletter
	if ((param('modification_form'))&&(param('mail')))
		{			
		print start_html('Modification de votre inscription'),"\n",
    			h1('Modification de votre inscription'),"\n",
    			start_form,"\n",
    			hidden(-'name'=>'mail',-'default'=>param('mail')),
    			"Votre adresse ? ",
    			textfield(	-'name'=>'new_mail',
    					-'value'=>param('mail')),
    			"<br>\n",
    			'Format de la newletter ?',
    			radio_group(	-'name'=>'type',
    					-'values'=>['txt','html'],
    					-'default'=>param('type')),
			hidden(-name=>'mail',-default=>param('mail')),    					
    			"<br>\n",
    			submit(-name=>'modification'),"\n",
    			end_form,"\n",
    			end_html,"\n";
    		}
	# Formulaire de suppression
	elsif ((param('suppression_form'))&&(param('mail')))
		{
		print start_html('Confirmation de la suppression de votre inscription'),"<br>\n",
    			h1('Confirmation de la suppression de votre inscription'),"\n",
    			start_form,"\n",
    			'Etes-vous sur de vouloir vous desabonné ?',
    			radio_group(	-'name'=>'confirm',
    					-'values'=>['Non','Oui']),"<br>",
			hidden(-name=>'mail',-default=>param('mail')),
    			submit(-'name'=>'suppression'),"\n",
    			end_form,"\n",
    			end_html,"\n";
    		}
	# Formulaire par defaut d'inscription
	else	{
		print start_html('Un exemple de formulaire d\'inscription'),"\n",
    			h1('Un exemple de formulaire d\'inscription'),"\n",
    			start_form,"\n",
    			"Votre adresse ? ",textfield('mail'),"<br>\n",
    			'Format de la newletter ?',"\n",
    			popup_menu(-'name'=>'type',-'values'=>['txt','html']),"<br>\n",
    			submit(-name=>'inscription'),"\n",
    			end_form,"\n",
    			end_html,"\n";
    		}

	}


#
# FONCTIONS DE MODIFICATION DU FICHIER BD
#

# Ajout d'un abonne a la liste des inscrits
sub ajout_abonne
	{
	my $buf;
	if (param('mail'))
		{
		# Envoi texte si non selectionne
		my $type = param('type') || 'txt';
		open(BD,">>$bd") || die "Can't wrote in $bd:$!\n";
		print BD param('mail')."\t$type\n";
		close(BD);
		print "Location: $url\n\n";
		}
	else 	{print header,"Adresse mail manquant, appuyez sur back pour corriger";exit;}
	}
	
# Modifie le type d'evoi effectue (HTML <=> Texte)
sub modif_abonne
	{
	my $buf;
	if (param('new_mail'))
		{
		open(BD,$bd) || die "Can't read $bd:$!\n";
		while (defined(my $l=<BD>))
			{
			chomp($l);
			my ($mail,$type)=split(/\t/,$l);
			if ((!$mail) ||($mail ne param('mail'))) {$buf.=$l."\n";}
			else {$buf.=param('new_mail')."\t".param('type')."\n";}
			}
		close(BD);
		open(BD,">$bd") || die "Can't wrote in $bd:$!\n";
		print BD $buf;
		close(BD);
		print "Location: $url\n\n";
		}
	else 	{print header,"Vous devez donner votre adresse mail pour modifier votre abonnement";exit;}		
	}

# Supprime un abonne des inscrits
sub delete_abonne
	{
	my $buf;
	if (param('confirm') eq 'Oui')
		{
		if (param('mail'))
			{
			open(BD,$bd) || die "Can't read $bd:$!\n";
			while (defined(my $l=<BD>))
				{
				chomp($l);
				my ($mail,$type)=split(/\t/,$l);
				if ((!$mail) ||($mail ne param('mail'))) {$buf.=$l."\n";}
				}
			close(BD);
			open(BD,">$bd") || die "Can't wrote in $bd:$!\n";
			print BD $buf;
			close(BD);			
			}
		else {print header,"Vous devez donner votre adresse mail pour supprimer votre abonnement";exit;}
		}
	print "Location: $url\n\n";
	}

#
# PARTIE MISE EN FORME DU MAILING
#

# Lance le mailing pour chacun des abonnes
sub send_mail
	{
	print header,start_html;
	print "\nLecture des abonnes ...\n";
	open(L,$bd) || die "Can't read $bd:$!\n";
	# Pour chaque utilisateur
	while (defined(my $l = <L>))
		{
		chomp($l);
		my @l = split(/\t/,$l);
		if (($l[1]) && ($l[0]=~/^[^#]/)){
		my $email = $l[0];	# Adresse destinataire
		my $type_envoi= $l[1];	# Envoi HTML ou texte
		my $mail;		# Message a envoyer	
		my $script = 'http://'.$ENV{'SERVER_NAME'}.$ENV{'SCRIPT_NAME'};
		my $desabo= $script."?suppression_form=1&mail=$email&type=$type_envoi";
		my $modifabo= $script."?modification_form=1&mail=$email&type=$type_envoi";
		# Envoi au format HTML
		if ($type_envoi eq 'html')
			{
			$desabo   = '<a href="'.$desabo.'">Supprimer votre abonnement</a>';
			$modifabo = '<a href="'.$modifabo.'">Modifier votre abonnement</a>';		
			my %hash = (
				'desabonnement' => $desabo,
				'modif_abonnement' => $modifabo
				);  
  			my $mailHTML = new MIME::Lite::HTML
  				From		=> $expediteur,
				To  		=> $email,
				Subject 	=> $titre,
				Debug		=> 1,
				HashTemplate 	=> \%hash;
  			$mail = $mailHTML->parse($urlNewsletterHTML);  			
			}
		# Envoi au format texte
		else 
			{
			my $req = new HTTP::Request('GET' => $urlNewsletterTxt);
			my $ua = new LWP::UserAgent 'MIME-Lite', 'alian@alianwebserver.com';
			my $res2 = $ua->request($req);
			$desabo   = 'Supprimer votre abonnement: '.$desabo;
			$modifabo = 'Modifier votre abonnement: '.$modifabo;			
		        $columns = 78;
			my $text = wrap('', '', $res2->content);

			$mail = new MIME::Lite 
				From	=> $expediteur,
				To  	=> $email,
				Subject => $titre,
				Type	=> 'TEXT',
				Data	=> $text."\n".$desabo;	
			}
		# Envoi du mail
		$mail->send;#_by_smtp('jupiter');
		print "Mail envoye a $email.<br>\n";
		}}
	close(L);
	print end_html;
	}