Código perl @ linux - GALPon

11 Jan 2011

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;