#!	/usr/bin/perl
#	$Id: mailclean,v 2.8 2005/12/10 13:17:33 ber Exp ber $
my	$version='$Revision: 2.8 $';
my	$src='$RCSfile: mailclean,v $';
my	$cpright="(c) Copyright 2005 Bernard MONDAN";
#
# Check mail at the server side and clean
# mail considered as not wanted mail
# Use a collection of rules to check mail
#
=pod MailClean

=head1 NAME

B<Mailclean> perform some cleaning on the mail message directly at the server side,
using rules defined in a config file and/or passed as arguments.
Mailclean check each mail account as define in config file (or passed as argument).
Each time a rule or a group of rules is accomplished, mailclean ask to delete the
message (it is possible to force deleting).
Mailclean has the ability to speak if the system support the B<festival> features.

Mailclean can manage statistics about the number of action for each account and for each rule,
mailclean also manage a log file to look at the stack of deleted messages.

Placing this software in a crontab can contribute to reduce amount of spam message.

=head1 SYNOPSYS

mailclean [--options]

=head1 OPTIONS

=over

=item B<--alias> param

Add alias on user

=over

=item format :

--alias "login sep aliastext" Use B<"> to avoid shell interpretation.

=item eg :

--alias "bernard@mondan.org---bm@mondan.org"

=back

=item B<--check>

Check config file. Config file is default config file or if --config fopt option is before --check,
fopt file will be check.

=item B<--clear>

Clear log file and stat file.

=item B<--config> f

f config file. Default config file is : $HOME/.mailclean/config

=item B<--count> param

Add a count to scan

=over

=item format :

--count "popserv sep login sep password sep message"

=item eg :

--count "pop.free.fr---toto.truc---totopass---Toto mail box"

=back

=item B<--debug>

Enable debug mode. In this mode there are many information displayed for
each message.

=item B<--del>

Add a new rule

=over

=item format :

--del "rule=regexp sep rule=... sep ask=n"

=item

rule must be one of  B<sub>, B<from>, B<to>, B<text> or B<attach>. The special key B<ask> is
used to force no asking before delete.

=item

regexp is a regular expression.

=item eg :

--del "sub=(viagra|cialis)---from=.+@hell.com"

=item

mailclean use : B</>(viagra|cialis)B</i> as expression to check the subject field B<and> B</>.+@hell.comB</i>
to check the sender. Note B<i> for F<ignoring case>.
In this case when the B<ask> directive is not present, mailclean will ask before delete.

=back

=item B<--dlog>

Display log file with 'less'

=item B<--doc>

Display the documentation.

=item B<--dstat>

Display stat file with 'less'

=item B<--edit>

Edit the configuration file with the default editor vi.

=item B<--except>

add a new exception rule.

=over

=item format :

--except "rule=regexp sep rule=..."

=item

rule must be one of  B<sub>, B<from>, B<to>, B<text> or B<attach>. 

=item

regexp is a regular expression.

=item eg :

--except "sub=software---from=.+@serious.com"

=item

mailclean use : B</>softwareB</i> as expression to check the subject field B<and> B</>.+@serious.comB</i>
to check the sender. Note B<i> for F<ignoring case>.
If the message yield these two rules, it will not be delete.

=back

=item B<--flog> f

f log file

=item B<--fstat> f

f stat file

=item B<-h, --help>

Display help message

=item B<--log>

Enable log file when delete

=item B<--maxline n>

n max number of line read from head for each message.

=item B<--maxlog sz>

sz size max of log file before warning

=item B<--sep xx>

Modify the default separator. The new separator is xx. xx should be a regular expression.

=item B<--speech>

Add the speech functionality (need festival)

=item B<--stat>

Enable the statistics

=item B<--verbose>

Verbose mode

=item B<--version>

Display version

=item Separator format

=over

=item 		;;; or ,,, or +++ or --- or === or ___

=back

=back

=head1 FILES

=item mailclean use F<$HOME/.mailclean/config> as default config file.
It is possible to change this default file with the --config option.

=item Mailclean use F<$HOME/.mailclean/log> as default log file. It is possible to change this
default file with the --flog option.

=item Mailclean use F<$HOME/.mailclean/stat> as default stat file. It is possible to change this
default file with the --fstat option.


=head1 FORMAT OF THE CONFIG FILE :

=over

=item The 'B<#>' character is for start comments up to end of line.

=back

=over

=head2 Keywords in config file :

=item B<count>

is use to define a mailing account to check.

=over

=item format :

B<count> <TAB> B<pop server> <TAB> B<user login> <TAB> B<password> <TAB> B<text spelled>

=back

=item B<def>

to define a variable for use in a rule. Variable use in a rule must be define before using it.

=over

=item format :

B<def> <TAB> myvar=regexp

myvar is define as a variriale that is egal to regexp (regular expression).

=item eg :

B<def> <TAB> badsub=(cialis|viagra)

To use the variable badsub in a rule definition you have to put the B<$> character before the name
of the variable as in B<$badsub>. 

=back

=item B<del>

to define rule for deleting a mail

=item

There are 4 rules : B<sub, from, to, attach or text>. For each rule mailclean use a different field in the header
of the mail. It is possible to make B<AND> between two or up to four rules.
It is also possible to force deletion with the special key B<ask>.

=item

B<del> <TAB> B<sub=string> <TAB> B<ask=n>

to delete with no confirmation all messages matching B<string> in B<subject> part.

=item

B<del> <TAB> B<sub=str1> <TAB> B<from=str2>

to delete message matching B<str1> in the B<subject> field F<and> matching B<str2> in B<From> field.

=item

B<del> <TAB> B<attach> <TAB> B<ask=y> <TAB> B<string>

to delete with confirmation messages that match B<string> in the part B<name of attachment>
or in the part B<Attached> of the message

=over

=item

F<It is strongly recommended to use regular expression for string>.

=back

=item B<alias>

is use to select the valid message for B<Delivered-to> field.

=over

=item format :

B<alias> <TAB> B<user login> <TAB> B<autorised alias>

=back

=item

Sometime provider redirect to one single account when the domaine name is ok but
the user name is not.
This commande permit to select autorised alias as user login for an account.
All mail with F<other user account will be delete without confirmation>.

=item B<except>

is used to add exception to rule. Each exception field matching these rule will not be delete.

=item

There are 4 exception : B<sub, from, to, attach or text>. For each exception mailclean use a different field in the header
of the mail. It is possible to make B<AND> between two or up to four exception.

=item

B<except> <TAB> B<sub=string>

to avoid delete message matching B<string> in B<subject> part.

=item

B<except> <TAB> B<sub=str1> <TAB> B<from=str2>

to avoid delete message matching B<str1> in the B<subject> field
F<and> matching B<str2> in B<from> field.

=item

B<except> <TAB> B<attach> <TAB> B<string>

to avoid delete message that match B<string> in the
part B<name of attachment> or in the part B<Attached> of the message

=item B<maxlog>

is used to adjust the max size of the log file before a warn message. When you got
the warn message, you have to remove the log file to start a new session of recording.

=over

=item format :

B<maxlog> <TAB> B<sz> : sz size max before warning

=back

=item B<maxline>

is used to adjust the max number of line read for each message. When B<mailclean>
encouter the B<Content-Type> string in the header of the message, it start a counter that is equal
to maxline/4, and then it stop reading the message after this number of line.

=over

=item format :

B<maxline> <TAB> B<n> : n number max of line to be read by message

=back

=item B<log> 0 or 1

This enable (1) or disable (0) the log capability.

=item B<flog> file

file is used as log file. In this case the B<log> flag is set to 1

=item B<stat> 0 or 1

This enable (1) or disable (0) the stat capability.

=item B<fstat> file

file is used as statistics file. In this case the B<stat> flag is set to 1

=back

=head1 AUTHOR

Bernard MONDAN : bernard@mondan.org

This file is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

Copyright 2005 Bernard MONDAN

=cut
#  ~~~   ~~~   ~~~   ~~~   ~~~   ~~~   ~~~   ~~~   ~~~   ~~~   ~~~   ~~~   ~~~
#_/.\_/.\_/.\_/.\_/.\_/.\_/.\_/.\_/.\_/.\_/.\_/.\_/.\_
# (_o_) (_o_) (_o_) (_o_) (_o_) (_o_) (_o_) (_o_) (_o_) (_o_) (_o_) (_o_) (_o_) 
#
# Le code
use Net::POP3;
# to check accent with european language
#use Encode;

my	$prog=$0;				# The name of prog
	$prog =~ s/^.*\/(.*)$/$1/;
my	$BASEDIR="$ENV{'HOME'}/.mailclean";	# default base directory
my	$fopt="$BASEDIR/config";		# default config file
my	$flog="$BASEDIR/log";			# default log file
my	$fstat="$BASEDIR/stat";			# default statistics file
my	$defeditor="gvim";			# Default editor
my	$argc=scalar(@ARGV);
my	$speech_ok=0;
my	$user="";
my	$passwd="";
my	$date_start="";
my	$srvpop;				# pop server name
my	$maxlog=1024*1024;			# default max size for log
my	$maxline=100;				# default max line read for each mail
my	$debug=0;
my	$display_rule=1;			# Use to check
my	$display_excep=1;			# Use to check
my	$speech=0;
my	$verbose=0;
my	$check_config=0;
my	$xxx=0;
my	$log=0;
my	$stat=0;
my	$nbdel=0;
my	$globalplace="";
my	%alias = ();
my	%stat_count = ();
my	%def = ();
my	@stack_log_info=();
my	@new_count = ();
my	@except_rules = ();
my	@list_count = ();
my	@del_rules = ();
my	$nb_excep=0;
my	$nb_del=0;
my	$nb_ask=0;
my	$nb_def=0;
my	$sep="[;,+\-=_]{3}";

my	@options = (
       "--alias		: Add alias on user",
       "  format : --alias \"login sep aliastext\"",
       "--check		: Check config file",
       "--clear		: Clear log file and stat file",
       "--config xx	: xx config file",
       "--count		: Add a count to scan",
       "  format : --count \"popserv sep login sep password sep message\"",
       "--debug		: Debug mode",
       "--del		: Add a new rule",
       "  format : --del \"rule=regexp sep rule=regexp\"",
       "--dlog		: Display log file with 'less'",
       "--doc		: Display documentation",
       "--dstat		: Display stat file with 'less'",
       "--edit		: Edit configuration file with default editor (vi)",
       "--except rules	: Mail conform to rules will not be delete",
       "  format : --except \"rule=regexp sep rule=regexp\"",
       "--flog	xx	: xx log file",
       "--fstat xx	: xx stat file",
       "-h, --help	: This help message",
       "--log		: Enable log file when delete",
       "--maxline n	: n number max of line read for each message",
       "--maxlog sz	: sz size max of log file before warning",
       "--speech	: Add the speech functionality (need festival)",
       "--sep xx	: xx regular expression as new separator",
       "--stat		: Enable stat",
       "--verbose	: Verbose mode",
       "--version	: Display Version",
       "\n\tsep : Separator format",
       "\tdefault : ;;; ou ,,, ou +++ or --- or === or ___"
);
sub	usage()
{
my	$i;
	chomp($prog);
	print STDERR "usage : $prog [-options]\n";
	for($i=0;$i< scalar(@options);$i++) {
		print STDERR "\t$options[$i]\n";
	}
	exit ( 1 );
}
#
# Check args command line
if( $argc > 0 ) {
	my	@x;
	my	$nbpar;
	for $i ( 0 .. $argc-1 ) {
		if( $ARGV[$i] =~ /-*-count*/ ) {
			if( $i >= $argc-1 ) {
				printf STDERR "Error : $ARGV[$i] need parameter\n";
				usage();
			}
			#
			# Separateur : ;;; ou ,,, ou === ou +++ ou --- ou ___
			#@x = split(/[;,+\-=_]{3}/,$ARGV[$i+1]);
			@x = split(/$sep/,$ARGV[$i+1]);
			$nbpar = scalar(@x);
			if( $nbpar != 4 ) {
				printf STDERR "Error : $ARGV[$i] need parameter as : \"popserver sep login sep password sep message\"\n";
				exit 1;
			}
			
			print "New Count : '$ARGV[$i+1]'\n";
			push @new_count, "$x[0]\t$x[1]\t$x[2]\t$x[3]";
			shift;
			next;
		}
		if( $ARGV[$i] =~ /-*-debug*/ ) {
			$debug = 1;
			$verbose = 1;	# Force mode verbose
			next;
		}
		if( $ARGV[$i] =~ /--check/ ) {
			$debug=1;
			read_opt($fopt);
			printf STDERR "Number of Del rule   : $nb_del\n";
			printf STDERR "Number of Ask        : $nb_ask\n";
			printf STDERR "Number of Excep      : $nb_excep\n";
			printf STDERR "Number of Definition : $nb_def\n";
			exit 1;
		}
		if( $ARGV[$i] =~ /--clear/ ) {
			print STDERR "\n**\n";
			print STDERR "** Delete log file '$flog'\n";
			print STDERR "**   and stat file '$fstat'\n";
			print STDERR "**   [Y/n] ? ";
			$xxx=<STDIN>;
			chomp($xxx);
			if( $xxx =~ /^[yo]/i ) {
				system "/bin/rm $flog $fstat";
			}
			else {
				printf STDERR "\n**\n** '$flog'\n** '$fstat'\n** files not deleted\n";
			}
			exit 1;
		}
		if( $ARGV[$i] =~ /-*-dstat/ ) {
			system "less $fstat";
			exit 1;
		}
		if( $ARGV[$i] =~ /-*-stat/ ) {
			$stat = 1;
			next;
		}
		if( $ARGV[$i] =~ /-*-edit/ ) {
			system "$defeditor $fopt";
			exit 1;
		}
		if( $ARGV[$i] =~ /--doc/ ) {
			system "perldoc $prog";
			exit 1;
		}
		if( $ARGV[$i] =~ /-*-h(elp)*/ ) {
			usage();
		}
		if( $ARGV[$i] =~ /-*-speech/ ) {
			$speech_ok = 1;
			next;
		}
		if( $ARGV[$i] =~ /-*-verbose/ ) {
			$verbose = 1;
			next;
		}
		if( $ARGV[$i] =~ /-*-version/ ) {
			print STDERR "\n\t$prog ==> Check and delete Spam messages\n\n";
			print STDERR "\t$cpright\n";
			print STDERR "\t$src, $version\n\n";
			print STDERR "\tThis file is free software; you can redistribute it and/or\n";
			print STDERR "\tmodify it under the same terms as Perl itself.\n\n";
			exit 1;
		}
		if( $ARGV[$i] =~ /-*-log/ ) {
			$log = 1;
			next;
		}
		if( $ARGV[$i] =~ /-*-dlog/ ) {
			system "less $flog";
			exit 1;
		}
		if( $ARGV[$i] =~ /-*-sep/ ) {
			if( $i > $argc ) {
				printf STDERR "Error : $ARGV[$i] need parameter\n";
				usage();
			}
			$sep = $ARGV[$i+1];
			print STDERR "New sep : '$sep'\n";
			shift;
			next;
		}
		if( $ARGV[$i] =~ /-*-del/ ) {
			if( $i > $argc ) {
				printf STDERR "Error : $ARGV[$i] need parameter\n";
				usage();
			}
			#
			# Separateur : ;;; ou ,,, ou === ou +++ ou --- ou ___
			#@x = split(/[;,+\-=_]{3}/,$ARGV[$i+1]);
			@x = split(/$sep/,$ARGV[$i+1]);
			$nbpar = scalar(@x);
			if( !$nbpar ) {
				printf STDERR "Error : $ARGV[$i] need parameter as : \"rule=regexp\"\n";
				exit 1;
			}
			$p=$i+2;
			exit 1 if( !push_del(\@x,"Arg $p") );
			shift;
			next;
		}
		if( $ARGV[$i] =~ /-*-except/ ) {
			if( $i > $argc ) {
				printf STDERR "Error : $ARGV[$i] need parameter\n";
				usage();
			}
			#
			# Separateur : ;;; ou ,,, ou === ou +++ ou --- ou ___
			#@x = split(/[;,+\-=_]{3}/,$ARGV[$i+1]);
			@x = split(/$sep/,$ARGV[$i+1]);
			$nbpar = scalar(@x);
			if( !$nbpar ) {
				printf STDERR "Error : $ARGV[$i] need parameter as : \"rule=regexp\"\n";
				exit 1;
			}
			$p=$i+2;
			exit 1 if( !push_except(\@x,"Arg $p") );
			shift;
			next;
		}
		if( $ARGV[$i] =~ /-*-maxline/ ) {
			if( $i > $argc ) {
				printf STDERR "Error : $ARGV[$i] need parameter\n";
				usage();
			}
			$maxline = $ARGV[$i+1];
			shift;
			next;
		}
		if( $ARGV[$i] =~ /-*-maxlog/ ) {
			if( $i > $argc ) {
				printf STDERR "Error : $ARGV[$i] need parameter\n";
				usage();
			}
			$maxlog = $ARGV[$i+1];
			shift;
			next;
		}
		if( $ARGV[$i] =~ /-*-fstat/ ) {
			if( $i >= $argc-1 ) {
				printf STDERR "Error : $ARGV[$i] need parameter\n";
				usage();
			}
			$fstat = $ARGV[$i+1];
			shift;
			next;
		}
		if( $ARGV[$i] =~ /-*-flog/ ) {
			if( $i > $argc ) {
				printf STDERR "Error : $ARGV[$i] need parameter\n";
				usage();
			}
			$flog = $ARGV[$i+1];
			shift;
			next;
		}
		if( $ARGV[$i] =~ /-*-config*/ ) {
			if( $i > $argc ) {
				printf STDERR "Error : $ARGV[$i] need parameter\n";
				usage();
			}
			$fopt = $ARGV[$i+1];
			shift;
			next;
		}
		if( $ARGV[$i] =~ /-*-alias/ ) {
			if( $i > $argc ) {
				printf STDERR "Error : $ARGV[$i] need parameter\n";
				usage();
			}
			#
			# Separateur : ;;; ou ,,, ou === ou +++ ou --- ou ___
			#@x = split(/[;,+\-=_]{3}/,$ARGV[$i+1]);
			@x = split(/$sep/,$ARGV[$i+1]);
			$nbpar = scalar(@x);
			if( $nbpar != 2 ) {
				printf STDERR "Error : $ARGV[$i] need parameter as : \"login sep alias\"\n";
				exit 1;
			}
			push @{$alias{$x[0]}}, $x[1];
			shift;
			next;
		}
		if( $ARGV[$i] ) {
			printf STDERR "**\n";
			printf STDERR "** Unknow option : $ARGV[$i] / (ARGV[$i])\n";
			printf STDERR "**\n\n";
			usage();
		}
	}
}
#
# If need to speech
# Check if festival exist on the system
if( $speech_ok && ! -x "/usr/bin/festival" ) {
	$speech_ok = 0;
	printf STDERR "Can't use festival to speech\n";
}
#
# Check to open config file
if( -r $fopt ) {
	printf STDERR "Conf file $fopt\n" if( $verbose );
	read_opt($fopt);
}
else {
	printf STDERR "No conf file $fopt\n";
	#
	# Check to create the ~/.mailclean directory
	if( !(-d $BASEDIR) ) {
		printf STDERR "**\n** Directory $BASEDIR do not exist\n** Create $BASEDIR directory\n** [y/n] ? ";
		$xxx=<STDIN>;
		chomp($xxx);
		if( $xxx =~ /^[yo]/i ) {
			system "mkdir $BASEDIR";
		}
		else {
			print STDERR "\n**\n** $BASEDIR\n** not created\n";
			exit 1;
		}
	}
}
#
# Check if account to check
my	$nb_count = scalar(@list_count);
if( !$nb_count ) {
	printf STDERR "###################################################################\n";
	printf STDERR "#  No email account to check\n";
	printf STDERR "#  Add account with the --count \"param.....\" option\n";
	printf STDERR "#  or with the config file (default : $fopt)\n";
	printf STDERR "#  Use : $prog --doc or perldoc $prog for information\n";
	printf STDERR "###################################################################\n\n";
	usage();
}
#
# Get actual date
my	$now=`date`;
	chomp($now);
#
# Check to open log file
if( $log ) {
	my	$sz;
	printf STDERR "Open Log file : $flog\n" if( $verbose );
	open(LOG,">> $flog") or die "Can't open file '$flog':\n$!";
	log_info("========= $now =========\n");
	$sz = -s $flog;
	if( $sz > $maxlog ) {
		my	$warn="Log file $sz bytes, over $maxlog";
		my	$l=length($warn)+2*8;
		info(("#" x $l)."\n");
		info("##      $warn\n");
		info(("#" x $l)."\n");
	}
	flush_log_info();
}
#
# Check to open stat file
if( $stat ) {
	if( -r $fstat ) {
		read_stat($fstat);
	}
	else {
		printf STDERR "No Stat file : $fstat\n" if( $verbose );
		$date_start="START\t$now";
	}
}
if( $debug ) {
	print STDERR "Maxline : $maxline\n";
	print STDERR " Maxlog : $maxlog\n";
	print STDERR "    Log : $log\n";
	print STDERR "   Flog : $flog\n";
	print STDERR " Speech : $speech_ok\n";
	print STDERR "   Stat : $stat\n";
	print STDERR "  Fstat : $fstat\n";
	#
	# To display rules and exception
	check_excep("","","","","");
	check_rules("","","","","");
	$display_rule = 0;
	$display_excep = 0;
}
#
# Scan account
scan_list(@list_count);
if( scalar ( @new_count ) ){
	scan_list(@new_count);
}
printf "..........................................................................\n";
system "date";
print "Mail deleted : $nbdel\n";
if( $stat ) {
	open(STAT,"> $fstat") or die "Can't open file '$fstat':\n$!";
	aff_stat(STAT);
	close(STAT);
}
if( $log ) {
	close(LOG);
}
exit 1;
#
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
# Scan a list of mail account
sub	scan_list($)
{
local	@list=@_;
local	$line;
local	$pop;
local	$nbr;
local	$s;
local	$n=0;


#printf "Nb count in this list %d\n", scalar(@list);
	printf "%10s : %s\n","      Users  ", " Mail(s) nb";
	foreach $line ( @list ) {
		local	$i;
		($srvpop, $user, $passwd, $speech ) = split( /[\t:;,\/]+/,$line);
		print STDERR "===== Site $srvpop, User $user\n" if ( $debug );
		#printf STDERR "srvpop $srvpop, user $user, passwd $passwd, speech $speech\n";
		#$pop = Net::POP3->new($srvpop) or die("pop->new: $!");
		next if ( !($pop = Net::POP3->new($srvpop, "Timeout" => 60))) ;
		$nbr = $pop->login($user, $passwd) or die("bad pop->login: $! user $user");
		$nbr =~ s/0E0/0/;
		printf "--------------------------------------------------------------------------\n";
		printf "%-30s : %5d\n",$user, $nbr;
		# Synthese vocal
		if( $nbr && $speech_ok ) {
			$cde="tell $nbr mail for $speech";
			system $cde;
		}
		my $messages = $pop->list(); # hashref of mesgId => size
		$n=1;
		foreach my $mesgId (sort {$a<=>$b} keys %$messages) {
			my	$x;
			my	$in_content_type=0;
			my	$end=0;
			my	$delete=0;
			my	$scan_text=0;
			my	$nb_d=0;	# Compte les occurence de Delivered_to
			my	$mess="";
			my	$type="";
			my	$from="";
			my	$date="";
			my	$attach="";	# L'attachement
			my	$text="";	# Le texte
			my	$sub="";	# Le sujet
			my	$lineRef = $pop->get($mesgId); # tabref of lines
			#print @$lineRef;
			#
			# Reset message info
			@stack_log_info=();
			#
			# Au max on lit les $maxline premieres lignes
			BOU:
			for $i ( 0 .. $maxline ) {
				if( $end ) {
					last BOU if( --$end <= 0 );
				}
				$mess = ${@$lineRef}[$i];
				chomp($mess);
				printf "MESS(%02d) : /%s/\n",$i, $mess if( $debug );
				if( $scan_text ) {
					$text .=$mess."\n";
				}
				#
				# ds le cas ou il y a des ':' ds le sujet
				# Recup des morceaux qui suivent ds @suite_d
				($c, $d, @suite_d) = split(/:/,$mess);
				if( scalar(@suite_d) ) {
					for $x ( @suite_d ) {
						$d .= ":".$x;
					}
				}
				#
				# Del les blancs
				$d = del_blancs($d);
				#
				# Recup de la date
				if ( $c =~ /^Date/i ) {
					info("      Date : $d\n");
					$date=$d;
				}
				#
				# Recup du Sujet
				if ( $c =~ /^Subject/i ) {
					info("   Subject : $d\n");
					$sub=$d;
					#if( $sub =~ /=\?(ISO-\d{4}\-\d)\?.\?/i ) {
					#	$xxx = lc($1);
					#	$sub =~ s/=\?$1\?.\?//;
					#	$sub=`echo $sub | iconv -f iso-8859-1 -t utf-8`;
					#	$sub = Encode::decode($xxx,$sub,Encode::FB_QUIET);
					#	print STDERR "decode ($xxx) => $sub\n" if( $debug );
					#}
					next;
				}
				#
				# Recup le vrai destinataire lorsque $nb_d = 0;
				# et si on a pas encore pass /Content-Type/
				if ( !$in_content_type && $c =~ /^Delivered-To/i ) {
					print STDERR ">>> ($nb_d) '$d'\n" if( $debug);
					if( !$nb_d ) {
						($site, $dest)=split(/\-/,$d);
						info("      Dest : $dest\n");
					}
					else {
						($site, $dest2)=split(/\-/,$d);
						print STDERR "     Dest? : $dest2\n" if( $debug);
						#
						# Ici on cherche ds la liste des alias si alias
						printf "alias : ${@{$alias{$dest}}}[0]\n" if( $debug);
						my	$ok=0;
						my	$u=0;
						BOUALIAS:
						foreach $u ( @{$alias{$dest}} ) {
							if( lc($u) eq lc($dest2) ) {
								$ok=1;
								last BOUALIAS;
							}
						}
						if( !$ok ) {
							printf "  Bad dest : $dest2\n" if( $debug);
							if( !$delete ) {
								$delete = ask_delete("y",$mess="bad dest",$dest2);
								$type="DEST";
							}
						}
					}
					$nb_d++;
				}
				#
				# Demarrage des data
				if ( $c =~ /^Content-Type/i ) {
					$in_content_type=1;
					$scan_text=1 if ( $d =~ /text\/plain/i ) ;
					#
					# Si l'on croise du binaire on arrete le scan
					# du message
					if ( $d =~ /application\/octet-stream/i ) {
						$scan_text=0;
						$end = 0;
						next;
					}
					$end = int($maxline/4);	# Encore qqes lignes pour voir
					print STDERR "Continue $end lines\n" if( $debug );
					next;
				}
				#
				# Recup du From
				if ( $c =~ /^Return-Path/i ) {
					$d =~ s/^\s*\<//;
					$d =~ s/\s*>$//;
					printf "%2d RetPath : $d\n",$n;
					log_info("   RetPath : $d\n");
					$from = $d;
					next;
				}
				if ( $c =~ /^From/i ) {
					$d =~ s/(\s*)\</$1/;
					$d =~ s/\s*>$//;
					printf "%2d    From : $d\n",$n;
					log_info("      From : $d\n");
					if( !$from ) {
						$from = $d
					}
					next;
				}
				#
				# Ici on cherche les trucs des fichiers attachs en pif, exe ...
				if ( $c =~ /^Attached/i ) {
					info("  Attached : $d\n");
					$attach=$d;
					next;
				}
				#
				# et ds la partie name=...
				($c, $d, @suite_d) = split(/=/,$mess);
				if ( $c =~ /name/i ) {
					$d =~ s/\"//g;
					info("  Name att : $d\n");
					$attach=$d;
				}
				#
				# Ds le cas ou on match pas
				#print STDERR "c : '$c' d : '$d'\n" if( $debug );
			}
			#
			# Ds le cas des alias a detruire il ne faut pas faire le check
			if( !$delete ) {
				( $delete, $type ) = check_rules($sub, $from, $dest, $attach, $text);
			}
			#
			# Delete message or not
			if( $delete =~ /[yn]/ ) {
				if( $delete =~ /y/ ) {
					#
					# Check if the sender is in the exception
					if( check_excep($sub, $from, $dest, $attach, $text) ) {
						info("EXCEPTION : Message from $from NOT DELETED\n");
						$type = "EXCEP";
					}
					else {
						info("Message Deleted\n");
						$pop->delete($mesgId);
						system "tell delete mail $mess" if ( $speech_ok );
						$ret=1;
						$nbdel++;
					}
					inc_stat("$user AT $srvpop",$type);
				}
				if( $delete =~ /n/ ) {
					info ("Not deleted\n");
					system "tell Not deleted" if ( $speech_ok );
				}
				log_info("***\n");
				flush_log_info() if( $log);
			}
			$n++;
		}
		$pop->quit();
	}
}
#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
# Get options from config file
#
sub	read_opt($)
{
my	$file=shift;
my	$pt;
my	@arg;
my	$nb_arg;
my	$li;
my	$no_line=0;

	open(OPT,"< $file") or die "Can't open file '$file':\n$!";

	$no_li = 0;
	foreach $li ( <OPT> ) {
		$no_line++;
		$li =~s/[ \t]*#.*$//o;	# Supprime les commentaires
		$li =~ s/[\r\n]+$//o;	# Del NEWLINE
		$li =~ s/^[ \t]+//o;	# Del Blanc du debut
		if( !$li ) {
			next;
		}
		#print "OPT : $li\n" if( $verbose );
		@arg = split(/\t+/,$li);
		$nb_arg = scalar(@arg);
		# Format : count	pop.free.fr<TAB>bernard.mondan<TAB>mypassword<TAB>bernard at free
		if( $arg[0] =~ /^count/i ) {
			print "Count : $arg[2]\n" if( $debug );
			push @list_count,"$arg[1]\t$arg[2]\t$arg[3]\t$arg[4]";
			next;
		}
		# Format : del	type	text
		if( $arg[0] =~ /^del/i ) {
			shift @arg;
			#print "Del ($nb_arg) : $arg[0] /// $arg[1]\n" if( $debug );
			push_del(\@arg,"Line $no_line");
			next;
		}
		# Format : alias	login	text_alias
		if( $arg[0] =~ /^alias/i ) {
			print "Alias ($nb_arg) : $arg[1] => $arg[2]\n" if( $debug );
			push @{$alias{$arg[1]}}, $arg[2];
			next;
		}
		# Format : speech <TAB> 0 ou 1
		if( $arg[0] =~ /^speech/i ) {
			print "speech ($nb_arg) : $arg[1]\n" if( $debug );
			$speech_ok = $arg[1];
			next;
		}
		# Format : log <TAB> 0 ou 1
		if( $arg[0] =~ /^log/i ) {
			print "Log : $arg[1]\n" if( $debug );
			$log = $arg[1];
			next;
		}
		# Format : maxlog <TAB> n
		if( $arg[0] =~ /^maxlog/i ) {
			print "Maxlog : $arg[1]\n" if( $debug );
			$maxline = $arg[1];
			next;
		}
		# Format : maxline <TAB> n
		if( $arg[0] =~ /^maxline/i ) {
			print "Maxline : $arg[1]\n" if( $debug );
			$maxline = $arg[1];
			next;
		}
		# Format : stat <TAB> 0 ou 1
		if( $arg[0] =~ /^stat/i ) {
			print "Stat : $arg[1]\n" if( $debug );
			$stat = $arg[1];
			next;
		}
		# Format : fstat	statfile
		# Ici on force $stat a 1
		if( $arg[0] =~ /^fstat/i ) {
			print "Stat File : $arg[1]\n" if( $debug );
			$fstat = $arg[1];
			$stat = 1;
			next;
		}
		# Format : flog	logfile
		# Ici on force $log a 1
		if( $arg[0] =~ /^flog/i ) {
			print "Log File : $arg[1]\n" if( $debug );
			$flog = $arg[1];
			$log = 1;
			next;
		}
		# Format : except	sender
		if( $arg[0] =~ /^except/i ) {
			shift @arg;
			push_except(\@arg,"Line $no_line");
			next;
		}
		# Format : def	var=
		if( $arg[0] =~ /^def/i ) {
			shift @arg;
			push_def(\@arg,"Line $no_line");
			next;
		}
		print STDERR "**\n";
		print STDERR "** Line $no_line : Bad option '$arg[0]'\n";
	}
	close(OPT);
}
#
#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
# Perform asking before deleting (if necessary)
#
sub	ask_delete($$$)
{
my	$ask=shift;
my	$mess=shift;
my	$rule=shift;
my	$rep="y";
my	$ret=0;
my	$m;
	info(">>>  Rule : $mess ===> $rule\n");
	if( $ask eq "Y" ) {
		printf STDERR "Delete this message [Y/n] ? ";
		system "tell delete this message ?" if( $speech_ok );
		$rep=<STDIN>;
		chomp($rep);
		$rep = "y" if( !$rep );
	}
	if( $rep =~ /^[yYoO]/ ) {
		return "y";
	}
	else {
		return "n";
	}
}
#
#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
# Push a new rule into the Del stack
sub	push_del($$)
{
my	$par=shift;
	$globalplace=shift;
my	$t;
my	$S="";
my	$F="";
my	$To="";
my	$A="";
my	$T="";
my	$ASK="Y";
my	$n=0;

	foreach $t ( @{$par} ) {
		$t =~ s/^\s+//;		# Del starting blancs
		if( $t =~ /^sub=/i ) {
			$t =~ s/^sub=//i;
			$S=get_def($t);
			$n++;
			next;
		}
		if( $t =~ /^from=/i ) {
			$t =~ s/^from=//i;
			$F=get_def($t);
			$n++;
			next;
		}
		if( $t =~ /^to=/i ) {
			$t =~ s/^to=//i;
			$To=get_def($t);
			$n++;
			next;
		}
		if( $t =~ /^attach=/i ) {
			$t =~ s/^attach=//i;
			$A=get_def($t);
			$n++;
			next;
		}
		if( $t =~ /^text=/i ) {
			$t =~ s/^text=//i;
			$T=get_def($t);
			$n++;
			next;
		}
		if( $t =~ /^ask=/i ) {
			$t =~ s/^ask=//i;
			if( $ASK eq "Y" && $t =~ /^[n0]/i ) {
				$ASK="N";
				$nb_ask--;
			}
			#
			# ne compte pas comme une regle
			# $n++;
			next;
		}
		printf STDERR "**\n** $globalplace >> Bad rule : $t\n**\n";
	}
	if( $n ) {
		$nb_del++;
		$nb_ask++;
		push @del_rules, "$n\t$S\t$F\t$To\t$A\t$T\t$ASK";
		if( $debug ) {
			printf STDERR "Push_del ($n/$globalplace) :\n";
			printf STDERR " - Subject $S\n" if( $S );
			printf STDERR " - From $F\n" if( $F );
			printf STDERR " - To $To\n" if( $To );
			printf STDERR " - Attach $A\n" if( $A );
			printf STDERR " - Text $T\n" if( $T );
			printf STDERR " - ASK $ASK\n";
		}
		return 1;
	}
	return 0;
}
#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
# Push a new rule into the Exception stack
sub	push_except($$)
{
my	$par=shift;
	$globalplace=shift;
my	$t;
my	$S="";
my	$F="";
my	$To="";
my	$A="";
my	$T="";
my	$n=0;

	foreach $t ( @{$par} ) {
		$t =~ s/^\s+//;		# Del starting blancs
		if( $t =~ /^sub=/i ) {
			$t =~ s/^sub=//i;
			$S=get_def($t);
			$n++;
			next;
		}
		if( $t =~ /^from=/i ) {
			$t =~ s/^from=//i;
			$F=get_def($t);
			$n++;
			next;
		}
		if( $t =~ /^to=/i ) {
			$t =~ s/^to=//i;
			$To=get_def($t);
			$n++;
			next;
		}
		if( $t =~ /^attach=/i ) {
			$t =~ s/^attach=//i;
			$A=get_def($t);
			$n++;
			next;
		}
		if( $t =~ /^text=/i ) {
			$t =~ s/^text=//i;
			$T=get_def($t);
			$n++;
			next;
		}
		printf STDERR "$globalplace >> Bad rule : $t\n";
	}
	if( $n ) {
		$nb_excep++;
		push @except_rules, "$n\t$S\t$F\t$To\t$A\t$T";
		if( $debug ) {
			printf STDERR "Push_excep ($n/$globalplace) :\n";
			printf STDERR " - Subject $S\n" if( $S );
			printf STDERR " - From $F\n" if( $F );
			printf STDERR " - To $F\n" if( $To );
			printf STDERR " - Attach $A\n" if( $A );
			printf STDERR " - Text $T\n" if( $T );
		}
		return 1;
	}
	return 0;
}
#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
# Push a new definition of an expression
sub	push_def($$)
{
my	$par=shift;
	$globalplace=shift;
my	$def;
my	$var;
my	$t;
my	$n=0;
my	@w;

	foreach $t ( @{$par} ) {
		$t =~ s/^\s+//;		# Del starting blancs
		$t =~ s/\s+=//;		# Del blancs before '='
		if( $t =~ /^\w+=/i ) {
			@w = split(/=/,$t);
			$n++;
			next;
		}
		printf STDERR "$globalplace >> Bad def : $t\n";
	}
	if( $n ) {
		$nb_def++;
		$def{$w[0]} = $w[1];
		if( $debug ) {
			printf STDERR "Push_def ($n/$globalplace) :\n";
			printf STDERR " - $w[0] = $w[1]\n";
		}
	}
	return 0;
}
#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
# Return a definition if defined
# else return var itself
sub	get_def($)
{
my	$var=shift;

	$var = del_blancs($var);
	$var =~ s/\$\s+/\$/;
	if( $var =~ /^\$/ ) {
		$var =~ s/^\$//;
		if( $def{$var} ) {
			print STDERR "Getdef $var = $def{$var}\n" if( $debug );
			return $def{$var};
		}
		else {
			print STDERR "**\n** $globalplace : Getdef $var Not Found\n**\n";
		}
	}
	return $var;
}
#
#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
# Affichage juste ds le log
sub	log_info($)
{
	#print STDERR "Log_info : $_[0]";
	push @stack_log_info, $_[0];
}
#
#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
# Affichage a l'ecran plus ds le log
sub	info($)
{
	push @stack_log_info, $_[0];
	print STDERR $_[0];
}
#
#=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
# Flush log info when finished
sub	flush_log_info()
{
	if( $log ) {
		foreach $m ( @stack_log_info ) {
			print LOG $m;
		}
	}
}
#-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z
# Read stat file to get old values for each keys.
#
sub	read_stat($)
{
my	$li;
my	$a;
my	$b;
my	$c=0;
my	$part=1;

	printf STDERR "Open Stat file : $_[0]\n" if( $verbose );
	open(STAT,"< $_[0]") or die "Can't open file '$_[0]':\n$!";
	#
	# Read stat values
	foreach $li ( <STAT> ) {
		chomp($li);
		next if( !$li );

		print STDERR "<stat> $li\n" if( $debug );

		next if ( $li =~ /#.*$/ ) ;	# Comments
		next if ( $li =~ /LAST/ ) ;	# Last date

		if ( $li =~ /START/ ) {		# First date
			$date_start = $li;
			next;
		}
		if( $li =~ /By Account/ ) {
			$part = 2;
			next;
		}
		if( $li =~ /By Field/ ) {
			$part = 3;
			next;
		}

		($a, $b)=split(/\t/,$li);
		$a =~ s/^ +//;
		$a =~ s/ +$//;
		$b =~ s/^ +//;
		$b =~ s/ +$//;
		if( $part == 2 ) {
			if( $a eq "ACCOUNT" ) {
				$c = \%{$stat_count{$b}};
				next;
			}
			if( $a eq "TOTAL" ) {
				$$c{"TOTAL"} = $b;
				next;
			}
			if( $a eq "TEXT" ) {
				$$c{"TEXT"} = $b;
				next;
			}
			if( $a eq "FROM" ) {
				$$c{"FROM"} = $b;
				next;
			}
			if( $a eq "TO" ) {
				$$c{"TO"} = $b;
				next;
			}
			if( $a eq "SUBJECT" ) {
				$$c{"SUBJECT"} = $b;
				next;
			}
			if( $a eq "ATTACH" ) {
				$$c{"ATTACH"} = $b;
				next;
			}
			if( $a eq "DEST" ) {
				$$c{"DEST"} = $b;
				next;
			}
			if( $a eq "EXCEP" ) {
				$$c{"EXCEP"} = $b;
				next;
			}
		}
	}
	close( STAT );
}
#-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z-z
# Display statistic using File pointer
#
sub	aff_stat($)
{
local	*FP=shift;
my	($a, $b, $c, $d);
my	%stat_field = ();

	print FP "#  --------------------------------------------\n";
	print FP "#  Statistics for $prog\n";
	print FP "#  User $ENV{'USER'}\n";
	print FP "#  --------------------------------------------\n";
	print FP "$date_start\n";
	print FP "LAST\t$now\n";
	print FP "#  --------------------------------------------\n";
	print FP "By Account\n";
	while ( ($a, $b ) = each ( %stat_count ) ) {
		print FP "#  --------------------------------------------\n";
		printf FP "%10s\t%s\n","ACCOUNT",$a;
		while ( ($c, $d ) = each ( %{$b} ) ) {
			if( $c eq "TOTAL" ) {
				$stat_field{"TOTAL"} += $d;
				#printf FP "          \t------\n%10s\t%6d\n",$c,$d;
				next;
			}
			if( $c eq "EXCEP" ) {
				$stat_field{"EXCEP"} += $d;
				#printf FP "\n%10s\t%6d\n",$c,$d;
				next;
			}
			printf FP "%10s\t%6d\n",$c,$d;
			$stat_field{"TEXT"} += $d if( $c eq "TEXT" );
			$stat_field{"FROM"} += $d if( $c eq "FROM" );
			$stat_field{"TO"} += $d if( $c eq "TO" );
			$stat_field{"SUBJECT"} += $d if( $c eq "SUBJECT" );
			$stat_field{"DEST"} += $d if( $c eq "DEST" );
			$stat_field{"ATTACH"} += $d if( $c eq "ATTACH" );
			$stat_field{"EXCEP"} += $d if( $c eq "EXCEP" );
		}
		printf FP "          \t------\n%10s\t%6d\n","TOTAL",$$b{"TOTAL"};
		printf FP "\n%10s\t%6d\n","EXCEP",$$b{"EXCEP"};
	}
	print FP "#  --------------------------------------------\n";
	print FP "By Field\n";
	print FP "#  --------------------------------------------\n";
	foreach $a ( ("TEXT", "FROM", "TO", "SUBJECT", "ATTACH", "DEST") ) {
		printf FP "%10s\t%6d\n", $a, $stat_field{$a};
	}
	$a = "TOTAL";
	printf FP "          \t------\n%10s\t%6d\n", $a, $stat_field{$a};
	$a = "EXCEP";
	printf FP "\n%10s\t%6d\n", $a, $stat_field{$a};
}
#
# Inc the statistic field
sub	inc_stat($$)
{
my	$account=shift;
my	$field=shift;

	printf "Inc Stat type $type, Account $account\n" if ( $debug );
	return if ( !$stat );
	if( !$stat_count{$account} ) {
		# Initialise les clefs a 0
		# pour les creer si besoins
		${$stat_count{$account}}{"TOTAL"} = 0;
		${$stat_count{$account}}{"TEXT"} = 0;
		${$stat_count{$account}}{"FROM"} = 0;
		${$stat_count{$account}}{"TO"} = 0;
		${$stat_count{$account}}{"SUBJECT"} = 0;
		${$stat_count{$account}}{"ATTACH"} = 0;
		${$stat_count{$account}}{"DEST"} = 0;
		${$stat_count{$account}}{"EXCEP"} = 0;
	}
	${$stat_count{$account}}{"TOTAL"}++;
	${$stat_count{$account}}{"TEXT"}++ if( $field =~ /TEXT/ );
	${$stat_count{$account}}{"FROM"}++ if( $field =~ /FROM/ );
	${$stat_count{$account}}{"TO"}++ if( $field =~ /TO/ );
	${$stat_count{$account}}{"SUBJECT"}++ if( $field =~ /SUBJECT/ );
	${$stat_count{$account}}{"ATTACH"}++ if( $field =~ /ATTACH/ );
	${$stat_count{$account}}{"DEST"}++ if( $field =~ /DEST/ );
	${$stat_count{$account}}{"EXCEP"}++ if( $field =~ /EXCEP/ );
}
#
# Check all rules are ok or not
sub	check_rules($$$$$)
{
my	($S, $F, $To, $A, $T) = @_;
my	$rok;
my	$nr;
my	$bloc;
my	@r;
my	@x;
my	$rep;
my	$type="";

	if( $debug ) {
		printf STDERR "Check rules :\n";
		printf STDERR ".. Su: $S\n";
		printf STDERR ".. Fr: $F\n";
		printf STDERR ".. To: $To\n";
		printf STDERR ".. At: $A\n";
		printf STDERR ".. Te: $T\n";
	}
	foreach $bloc ( @del_rules ) {
		@r = split( /\t/, $bloc );
		#
		# Nb de regles en 1er champ
		$nr = $r[0];
		#printf STDERR "($n) " if ($debug);
		$rok=0;
		$type="";
		if( $debug && $display_rule ) {
			printf STDERR "BLOC RU($nr): Su: $r[1], Fr: $r[2], To: $r[3], At: $r[4], Te: $r[5], ASK: $r[6]\n";
		}
		if( $r[1] && $S =~ /$r[1]/i ) {
			$type .= "SUBJECT";
			$rok++;
			print STDERR "Su ok : $r[1]\n" if ( $debug );
		}
		if( $r[2] && $F =~ /$r[2]/i ) {
			$type .= " FROM";
			$rok++;
			print STDERR "Fr ok : $r[2]\n" if ( $debug );
		}
		if( $r[3] && $To =~ /$r[3]/i ) {
			$type .= " TO";
			$rok++;
			print STDERR "To ok : $r[3]\n" if ( $debug );
		}
		if( $r[4] && $A =~ /$r[4]/i ) {
			$type .= " ATTACH";
			$rok++;
			print STDERR "A ok : $r[4]\n " if ( $debug );
		}
		if( $r[5] && $T =~ /$r[5]/i ) {
			$type .= " TEXT";
			$rok++;
			if( $debug ) {
				print STDERR "T ok : $r[5]\n";
				print STDERR ">>>> : $T\n";
			}
			#
			# Recherche dans T de la ligne ou on match le texte
			@x = split( /\n/, $T);
			foreach my $m ( @x ) {
				info("      Text : $m\n") if( $m =~ $r[5] );
			}
		}
		printf STDERR "Nb Rule : $nr, Rule ok : $rok\n" if ( $debug && $type );
		if( $type && $rok == $nr )  {
			$rep = ask_delete($r[6],"$nr, Bad $type","Su: $r[1], Fr: $r[2], To: $r[3], At: $r[4], Te: $r[5]");
			return ($rep, $type);
		}
	}
	return (0, 0);
}
#
# Check all exceptions are ok or not
sub	check_excep($$$$$)
{
my	($S, $F, $To, $A, $T) = @_;
my	$rok;
my	$nr;
my	$bloc;
my	@r;
my	@x;
my	$type="";

	if( $debug ) {
		printf STDERR "Check exceptions :\n";
		printf STDERR ".. Su: $S\n";
		printf STDERR ".. Fr: $F\n";
		printf STDERR ".. To: $To\n";
		printf STDERR ".. At: $A\n";
		printf STDERR ".. Te: $T\n";
	}
	foreach $bloc ( @except_rules ) {
		@r = split( /\t/, $bloc );
		#
		# Nb de regles en 1er champ
		$nr = $r[0];
		#printf STDERR "($n) " if ($debug);
		$rok=0;
		$type="";
		if( $debug && $display_excep ) {
			printf STDERR "BLOC EX($nr): Su: $r[1], Fr: $r[2], To: $r[3], At: $r[4], Te: $r[5]\n";
		}
		if( $r[1] && $S =~ /$r[1]/i ) {
			$rok++;
			printf STDERR "Su ok : $r[1]\n" if ( $debug );
		}
		if( $r[2] && $F =~ /$r[2]/i ) {
			$rok++;
			printf STDERR "Fr ok : $r[2]\n" if ( $debug );
		}
		if( $r[3] && $To =~ /$r[3]/i ) {
			$rok++;
			printf STDERR "To ok : $r[3]\n " if ( $debug );
		}
		if( $r[4] && $A =~ /$r[4]/i ) {
			$rok++;
			printf STDERR "At ok : $r[4]\n " if ( $debug );
		}
		if( $r[5] && $T =~ /$r[5]/i ) {
			$rok++;
			printf STDERR "Te ok : $r[5]\n" if ( $debug );
			#
			# Recherche dans T de la ligne ou on match le texte
			@x = split( /\n/, $T);
			foreach my $m ( @x ) {
				info("     Text : $m\n") if( $m =~ $r[5] );
			}
		}
		if( $rok == $nr )  {
			return 1;
		}
	}
	return  0;
}
#
# Del starting and ending blancs
sub	del_blancs($)
{
	$_[0] =~ s/^\s+//;
	$_[0] =~ s/\s+$//;
	return $_[0];
}
__END__
