Lector de direcciones de EMAIL en Perl.
A modo de agrupar conocimientos, he realizado un script que permite obtener direcciones de email desde archivos en código ASCII.
El script hace lo siguiente:
- Realiza una copia del archivo .eml en un archivo temporal.
- Elimina los símbolos del primer archivo copiando los datos a un segundo archivo temporal
- Busca líneas que contienen el carácter arroba.
- Procesa las lineas separandolas en palabras para luego seleccionar lo patrones que corresponden a direcciones de correo.
-------------------------------------------- CORTAR AQUI -------------------------------------------------------
#!/usr/bin/perl
############################################################################################
#Autor: http://otroblogdetecnologias.blogspot.com
#Funcion: Extraer mails desde archivos ingresados en la línea de comandos;
#=================================
#Descripcion del Algoritmo
#=================================
#Realiza una copia del archivo .eml en un archivo temporal.
#Elimina los simbolos del primer archivo copiando los datos a un segundo archivo temporal
#Busca las lineas que contienen una arroba
#Procesa las lineas separandolas en palabras para luego seleccionar los patrones de correo
############################################################################################
my $content;
my $arTemporal1="temporal.eml";
my $arTemporal2="temporal2.eml";
my $arFinal="final.txt";
if ($#ARGV==-1) {
#sin parametros
ayuda();
} else {
############################################
#limpia el archivo de reporte final
open(FINAL,">",$arFinal) or die;
close(FINAL);
############################################
# abrir archivo segun parametro
copiarArchivo($ARGV[0],$arTemporal1);
eliminarSimbolos($arTemporal1,$arTemporal2);
open(FH, $arTemporal2)or die;
############################################
while (){
chomp;
#del archivo temporal obtiene las lineas con arroba
if (/\@/) {
$content=$_;
procesarLinea($content);
}
}
close(FH);
}
##################################################
#Realiza una copia a un archivo temporal
##################################################
sub copiarArchivo{
my ($archivo1,$archivo2)=@_;
print $archivo1;
open(ARCHIVO1,"<",$archivo1) or die;
open(ARCHIVO2,">",$archivo2) or die;
while(){
print ARCHIVO2 $_;
}
close(ARCHIVO1);
close(ARCHIVO2);
}
##################################################
#elimina los simbolos que no son utilizados y suplanta por espacios
##################################################
sub eliminarSimbolos{
my ($archivo1,$archivo2)=@_;
print $archivo1;
open(ARCHIVO1,"<",$archivo1) or die;
open(ARCHIVO2,">",$archivo2) or die;
while(){
#expresion que suplanta los simbolos cualquiera sea la ocurrencia
#dentro de la linea leida
if(s/<|>|'|"|=|\;|\,|\>|\:/ /g){
print ARCHIVO2 $_;
}
}
close(ARCHIVO1);
close(ARCHIVO2);
}
##################################################
#lee linea por linea obteniendo los patrones correspondientes a cuentas
#de correo
##################################################
sub procesarLinea {
my ($linea)=@_;
my @arreglo;
@arreglo= split /[\s|\t]+/, $linea;
open(FINAL,">>",$arFinal) or die;
foreach $ar (@arreglo) {
#obtiene las direcciones de correo por expresion regular.
if($ar=~ /@(.)+\.[com]?/){
print "$ar \n";
#imprime en el reporte
print FINAL $ar,"\n";
}
}
close(ARCHIVO2);
}
##################################################
## ayuda
##################################################
sub ayuda {
print("##############################################################\n");
print("Obtiene direcciones de email desde archivos con formato texto \n");
print("##############################################################\n");
print("No se ingreso el nombre del archivo \n");
}
-------------------------------------------- CORTAR AQUI -------------------------------------------------------


Comentarios
Publicar un comentario