use IO::Socket;
use Time::localtime;

sub lc_hachage {
	my %hachage = @_;
	my ($cle,%new_hachage) ;
	for (sort keys %hachage) {
		$new_hachage{lc($_)}=$hachage{$_};
	}
	return %new_hachage;
}

sub verification_structure {
	# be carreful STATUT_VERIFICATION,COMMENTAIRE_VERIFICATION is reserved by system
	# The MOTHER structure is in UPPER_CASE 
	# The Structure to be Verif mus be in Lower CASE
	#
	# erreur : 0 => No error
	#	   1 => Be Carreful (Substitution)
	#	   2 => Error (STOP)
 	#
	my $erreur = 0 ;
	my $comment = "LOOK Structure \n";
	my (%structure) = @_ ;
	my $cle ;
	for $cle (sort keys %structure) {
		#We works in UPPER_CASE KEY
		if (!($cle =~ /[a-z]/)) { 
			if (!exists ($structure{lc($cle)}) or $structure{lc($cle)} eq '') {
				if (uc($structure{$cle}[0]) eq 'FACULTATIF') {
					# erreur will take 1 -> Information of substitution
					if ($erreur == 0) { $erreur = 1 };
					$structure{lc($cle)}=$structure{$cle}[1];
					$commentaire .= $structure{$cle}[2]."\n";
				} 
				else {
					#Erreu will take 2 -> A Mistake
					$erreur =2 ;
					$commentaire .= $structure{$cle}[2]."\n";
				}
			} else {
				#Structure correcte 
				$commentaire .= "variable $cle correcte\n";	
			}
			
		}
	}
	#delete the keys in UPPER CASE
	for $cle (sort keys %structure) {
		#on travail sur les clé en MAJUSCULE
		if (!($cle =~ /[a-z]/)) { 
			delete ($structure{$cle});
		}
	}
		
	#WRITING THE RESULT IN THE VARIABLE
	$structure{'STATUT_VERIFICATION'}=$erreur;
	$structure{'COMMENTAIRE_VERIFICATION'}=$commentaire;
	return %structure;
}


sub send_smtp {
##################################################
# Sub to send an email by using the Socket Connexion
# The real goal is to send an email by using a specific
# return_path
##################################################
my  %caracteristique= lc_hachage(@_) ;
my %structure = (
'SMTP'   	=> ['FACULTATIF' ,'localhost','Smtp is not precise , Localhost will be use'                           ],
'RETURN_PATH' 	=> ['OBLIGATOIRE','',         'No email for RETURN_PATH. Structure is not CORRECT'                    ],
'TO'  		=> ['OBLIGATOIRE','',         'No email ro precise the RECEPT-BOX. Structure is not CORRECT'          ],
'MESSAGE'	=> ['OBLIGATOIRE','',         'No message to send . Strcuture is not CORRECT '			      ],
'TIME_OUT'	=> ['FACULTATIF' ,'5',        'No Time Out precise. Default is 5 secondes.'	                      ],
);
my %res= (
'ERROR' => '',
'STATUT' => '2',
'COMMENT' => '',
'TIME'=>''
);

## CLEAN UP STRUCTURE
%caracteristique = verification_structure(%caracteristique,%structure);
if ($caracteristique{STATUT_VERIFICATION}==2) {
	$res{COMMENT} = $caracteristique{COMMENT_VERIFICATION};
	print_debug("ERREUR","SENDER",$res{'COMMENT'});
}
    
$|=1;

my $debut = time();
my $result= 0;
my $reponse ;
my $serveur = IO::Socket::INET->new(	PeerAddr 	=> $caracteristique{smtp} ,
					PeerPort 	=> '25' ,
					Proto		=> 'tcp' ,
					Type 		=> SOCK_STREAM ,
					Timeout 	=> $caracteristique{time_out}
					) or $result='1';

if ($result eq '1') {										
    # Traitement du problème de liaison sur le serveur
    # Aucune connection n'est possible
    $res{'COMMENT '} = "Erreur à la connection avec $caracteristique{smtp} -($!)-";
    print_debug("ERREUR","SENDER",$res{'COMMENT '});
    $res{'ERROR'}= "sender:connecting";
    return %res;
   }
else {
	$res{'COMMENT'}= "Connexion on SMTP $caracteristique{smtp} -> OK \n";
}


$reponse = <$serveur>;
if ($reponse =~ /^220/sgi) { $res{'COMMENT'}.= "RECEPTION SMTP Ok \n"; }
    else
    {
    $res{'COMMENT'}.= "ERROR WHEN CONNECTING SMTP -> ($reponse) \n";
    $res{'ERROR'} = 'sender:authent';
    return %res;
}

print $serveur "HELO robot\r\n";
$reponse = <$serveur>;
if ($reponse =~ /^250/sgi) { $res{'COMMENT'}.= "Welcome on SMTP Ok \n"; }
    else
    {
    $res{'COMMENT'}.= "Problem when we try to be friendly -> ($reponse) \n";
    $res{'ERROR'} = 'sender:authent';
    return %res;
    }

print $serveur "MAIL FROM: <$caracteristique{return_path}>\r\n";
$reponse =<$serveur>;
if ($reponse =~ /^250/sgi) { $res{'COMMENT'}.= "Printing RETURN PATH Ok \n"; }
    else
    {
    $res{'COMMENT'}.= "Problem when we introduice RETURN PATH -> ($reponse) \n";
    $res{'ERROR'} = 'sender:sending';
    return %res;
    }

print $serveur "RCPT TO: <$caracteristique{to}>\r\n";
$reponse = <$serveur>;
if ($reponse =~ /^250/sgi) { $res{'COMMENT'}.= "WRITING recept email Ok \n"; }
    else
    {
    $res{'COMMENT'}.= "Proble when we writing recept email -> ($reponse) \n";
    $res{'ERROR'} = 'sender:sending';
    return %res;
    }

print $serveur "DATA\r\n";
$reponse = <$serveur>;
if ($reponse =~ /^354/sgi) { $res{'COMMENT'}.= "Asking DATA Ok \n"; }
    else
    {
    $res{'COMMENT'}.= "Probleme when it ask DATA -> ($reponse) \n";
    $res{'ERROR'} = 'sender:sending';
    return %res;
    }

print $serveur $caracteristique{message};
$reponse = <$serveur>;
if ($reponse =~ /^250/sgi) { $res{'COMMENT'}.= "SENDIND Message Ok \n"; }
    else
    {
    $res{'COMMENT'}.= "Problem when wh SENDING DATA -> ($reponse) \n";
    $res{'ERROR'} = 'sender:sending';
    return %res;
    }

print $serveur "QUIT\r\n";
$reponse = <$serveur>;
if ($reponse =~ /^221/sgi) { $res{'COMMENT'}.= "We prepare us to exit \n"; }
    else
    {
    $res{'COMMENT'}.= "Problem when we exit sender ($reponse) \n";
    $res{'ERROR'} = 'sender:sending';
    return %res;
    }
$res{'TIME'}=time()-$debut;
$res{'STATUT'}=$caracteristique{VERIFICATION_STATUT};
return %res;
}

## TEST : We will send a message, but the return path will be change to
##        be route to another account


$message=<<MESSAGE;
to: FRIEND <everyone@world.com>
from: ONE FRIEND <people@mydomain.com>
Subject: This is a TEST

This email is a text.

.

MESSAGE


send_smtp (
     (
     'to' 	   => 'everyone@world.com' ,
     'return_path' => 'robo@mydomain.com'  ,
     'time_out'    => 10 ,
     'message'     => $message 
     )
);

#We can send every kind of MAIL (ALTERNAT, MIXED ... )