11 Jan
2011
11 Jan
'11
1:25 p.m.
Puedo usar el programa "original" hecho con perl2exe gracias a Wine , pero
me da rabia no hacerlo funcionar de forma nativa dado que tengo el
source..., tengo SLES 11, perl 5.10 (64b)
un saludo.
PD: este código NO lleva la modificación de Couto, es tal cual el original
con las rutas en linux (el original las rutas son del tipo C:\...)
------------------------------------------------------------
#!/usr/bin/perl
use Net::FTP;
#use Term::ReadKey;
use Getopt::Long;
$t0=@ARGV[0];
$t1=@ARGV[1];
# Posición de las opciones de la línea de comando.
GetOptions("force" => \$force);
# Anulamos el CTRL+C
$SIG{INT} = 'IGNORE';
# Localizaciín de los ficheros de LOG.
$FichierErreur = "/home/pilote/psaftp/log/err.txt";
$FichierLog = "/home/pilote/psaftp/log/log.txt";
$FichierLock = "/home/pilote/psaftp/log/lock.dat";
# Localización de ficheros de envío.
$fic1=$t1;
$Fichier="/home/pilote/psaftp/envoi/$t1";
$Idf=$t0."!";
$Libelle="Enviando archivo : $fic1 $Idf ";
($f1,$f2) = split(/\.zip\Z/, $fic1);
# Usuario y contraseña para la conexión FTP.
$userID="*************";
$userPass="************";
# Dirección del FTP
$Host="*****************";
# $Port='4102'; dejamos el puerto estandar (21).
# ******************************************************
# * Procedimiento de gestión de errores *
# ******************************************************
sub success {
open(SUCCESS,"$FichierErreur") || die "imposible abrir $success";
while (<SUCCESS>) {
s/\n//;
if ( $_ =~ /.*(REQUEST:).*/) {
&request("$_");
}
}
close(SUCCESS);
}
sub request{
($a,$b) = $_[0] =~ /.*\s\d{3}\s(.*)\sCommand.*(REQUEST:\s.*\.).*/;
print LOGFILE scalar(localtime) . " : $a\t$b\n";
}
sub erreur {
$nberreur=0;
open(ERREUR,"$FichierErreur") || die "imposible abrir $erreur";
while (<ERREUR>) {
s/\n//;
if ( $_ =~ /.*(\(TRC=).*/) {
$nberreur = $nberreur + 1;
&trc("$_");
}
}
if($nberreur>0) {
print "¡error! mira el fichero de LOG para mas detalles.\n";
close(ERREUR);
return -1;
} else {
close(ERREUR);
return 0;
}
}
sub trc {
($c) = $_[0] =~ /.*(\s\d{3}.*)/;
print LOGFILE scalar(localtime) . " : " . ($c) ."\n";
}
sub GestionErreur {
&success;
$rep = &erreur;
return $rep;
}
# ***********************************
# * PROCEDIMIENTO DE FIN DE PROGRAMA*
# ***********************************
sub End_Prog {
print "\n\nPulsa enter para salir del programa";
$fin = <STDIN>;
chop($fin);
}
# ***************************************************************
# * PROCEDIMIENTO DE CONEXION Y AUTENTICACION DEL SERVIDOR *
# ***************************************************************
# * Los parámetros son : *
# * $_[0] : nombre del servidor remoto *
# * $_[1] : userID de la conexión *
# * $_[2] : contraseña asociada al *
# ***************************************************************
sub Authentification {
open(STDERR, "> $FichierErreur");
$ftp = Net::FTP->new($_[0], Debug => 1);
if ($ftp == undef) {
print "Incapaz de conectarse al host remoto\n";
print "El mensaje de error es : $@\n";
print LOGFILE scalar(localtime) . " : Incapaz de establecer conexion
con la máquina remota\n";
print LOGFILE "El mensaje de error es :" . $@ . "\n";
return -1;
}
print "Estas conectado a la maquina remota\n";
print LOGFILE scalar(localtime) . " : Conexion estsablecida con la
maquina remota\n";
$rep = $ftp->login($_[1], $_[2]);
close(STDERR);
if ($rep == undef) {
GestionErreur;
print "Conexion rechazada : ¡ comprueba tu usuario y contrasen~a
!\n";
print LOGFILE scalar(localtime) . " : Conexion rechazada : ¡
comprueba tu usuario y contrasen~a !\n";
return -1;
}
print "UserID y contrasen~a aceptados por la maquina remota\n";
print LOGFILE scalar(localtime) . " : UserID y contrasen~a aceptados por
la maquina remota\n";
return 0;
}
# ************************************************************
# * PROCEDIMIENTO DE ENVIO DE FICHEROS *
# ************************************************************
# * Los parámetros son *
# * $_[0] : nombre del fichero a transferir. *
# * $_[1] : <IDF>! : IDF a utilizar para el envio *
# * $_[2] : redacción del log de transferencia *
# ************************************************************
sub Envoi {
open(STDERR, "> $FichierErreur");
open(FILE, $_[0]);
if($! eq "") {
# le fichier a envoyer existe
######if(open(FILE, $_[0])) {
close FILE;
} else {
print "El archivo $_[0] no existe !\ncrea uno antes de lanzar esta
aplicacion...\n";
close FILE;
return -1;
}
print "\nLanzando archivo : ".scalar(localtime)."\nEspera...\n";
print LOGFILE scalar(localtime) . " : Lanzando archivo : $_[2].\n";
if ($f1 ne $fic1) { $ftp->binary(); }
$ftp->put($_[0], $_[1]);
close(STDERR);
$nberr = &GestionErreur;
if ($! eq "" && $nberr == 0) {
print "Archivo enviado a la maquina remota\n";
print "Archivo transferido correctamente a
".scalar(localtime)."\n";
print LOGFILE scalar(localtime) . " : " . $_[2] . ". Transferencia
correcta\n";
return 0;
} else {
# La gestión de errores se produce al llamar al método
'GestionErreur'
print LOGFILE scalar(localtime) . " : $_[2] : Archivo no enviado a
la maquina remota\n";
return -1;
}
}
# **************************************************
# * Principal *
# **************************************************
# Comprobar si ya está funcionando
if ($force) {
unlink($FichierLock);
open(LOCK, "> $FichierLock");
close(LOCK);
} else {
# ver si ya está en marcha
open(LOCK, "$FichierLock");
if($! eq "") {
close(LOCK);
print "La aplicacion ya se esta ejecutando!\nadios!\n";
End_Prog;
exit 0;
} else {
close(LOCK);
open(LOCK, "> $FichierLock");
close(LOCK);
}
}
# ouvre le fichier de log
open(LOGFILE, "+>> $FichierLog");
print LOGFILE
"************************************************************************************************\n";
# phase d'authentification
$rep = Authentification($Host, $userID, $userPass);
# transfert
if ($rep == 0) {
&Envoi($Fichier,$Idf,$Libelle);
}
close(LOGFILE);
unlink($FichierErreur);
unlink($FichierLock);
$ftp->quit();
print "Adios...\n";
#End_Prog;