No se la van a creer dije: "Si no está entrando al procedimiento pues lo forzamos". Entonces tomé el código que ya existía y nada más quité el procedimiento y puse todo el código y salió. Lo muestro a continuación para que vean los cambios con esto parece que está resuelto, quitar la subrutina y pegar el código. Raro pero funcionó.
Código
Using perl Syntax Highlighting
#!/usr/bin/perl -w
########################################################
#
# "Upload de archivos"
#
# Creado por: Uriel Lizama
# Todos los derechos reservado.
#
# http://perlenespanol.com/
#
#########################################################
use strict
;
use CGI
::Carp qw(fatalsToBrowser
);
use CGI
;
#iniciamos el script de perl
my %Input;
my $query = new CGI
;
my @pairs = $query->param;
foreach my $pair(@pairs){
$Input{$pair} = $query->param($pair);
}
#Obtenemos el valor del Radio Button Actual
my $radioButton = $Input{'docTipo'}; #Segun el valor de un radio para escoger una carpeta
my $nombrePersonalizado = $Input{'cadenatexto'}; #Si cambian el nombre
my $nombre_en_servidor;
my $nuevoEstado = $Input{'newEstado'}; #Para saber que boton apreto
my $carpetaEstado = $Input{'MEstados'}; #Una <select> de html
my $Location="";
my $whobutton = $Input{'btn_Accion'}; #un boton para saber que boton se apreto
#Directorio donde guardaremos archivos
my $dir = "/usr/local/psa/home/vhosts/informanalitica.com/httpdocs/Documentos/tmp";
$Location = "http://informanalitica.com/util/subearchivo.php";
#Array con extensiones de archivos que podemos recibir
#my @extensiones = ('pdf','gif','jpg','jpeg','bmp','png');
#Verificamos que los botones no se aprieten
if ( $whobutton eq "Enviar" ){
#Iniciar la recepcion del archivo
$nombre_en_servidor = $Input{'userfile'};
$nombre_en_servidor =~ s/ /_/gi;
$nombre_en_servidor =~ s!^.*(\\
|\
/)!!;
my ($file, $ext ) = split( /\./ , $nombre_en_servidor );
#Si el input de nombre personalizado no esta vacio.
if ( $nombrePersonalizado ne "" ){
$nombrePersonalizado = "$nombrePersonalizado.$ext";
$nombrePersonalizado =~ s/ /_/gi;
$nombrePersonalizado =~ s!^.*(\\
|\
/)!!;
$nombre_en_servidor = "";
$nombre_en_servidor = $nombrePersonalizado;
}
#Abrimos el nuevo archivo
open (OUTFILE
, ">$dir/$nombre_en_servidor") || die "No se puedo crear el archivo $dir/$nombre_en_servidor<-";
binmode(OUTFILE
); #Para no tener problemas en Windows
#Transferimos byte por byte el archivo
while (my $bytesread = read($Input{'userfile'}, my $buffer, 1024
)) {
print OUTFILE
$buffer;
}
#Cerramos el archivo creado
close (OUTFILE
);
$Location = $Location . "?nombreArchivo=$nombre_en_servidor&docTipo=$radioButton&estado=$carpetaEstado";
}elsif ( $whobutton eq "Agregar" ) {#Verificamos el boton apretado y mandamos variables.
$Location = "http://informanalitica.com/util/eliminarEstados.php";
$Location = $Location . "?agrEstado=true&delEstado=false&objetivo=$nuevoEstado";
}elsif ($whobutton eq "Eliminar" ) {
$Location = "http://informanalitica.com/util/eliminarEstados.php";
$Location = $Location . "?agrEstado=false&delEstado=true&objetivo=$carpetaEstado";
}
$nuevoEstado = "";
$carpetaEstado = "";
#Si el archivo se subio redireccionamos a la pagina de subir archivos con true.
#$debug3 = $Input{'userfile'};
#print "Content-type: text/html\n\n";
print "Location: $Location\n";
exit(1
);
#Finaliza script perl
#----------------------------------------------------------------------------------
Coloreado en 0.003 segundos, usando
GeSHi 1.0.8.4
Realmente una jalada pero aquí dejo la solución por si alguien tiene el mismo problema gracias a los que me ayudaron un foro excelente y de rápida respuesta. Nos seguimos viendo xD por aquí
