Tutoriales de Perl - Upload de archivos

Introducción

En este tutorial les voy a mostrar una manera rápida de hacer "uploads" de archivos como pueden ser imagenes, zips, archivos de texto, etc, por medio de perl a tu servidor.

Esto nos va a servir si queremos que usuarios puedan estacionar archivos en nuestro servidor, para crear galerias, disco virtual, etc.

Para poder entender este tutorial es necesario que tengas conocimientos básicos de formularios HTML.

El formulario

Lo primero que debemos de hacer es configurar el formulario HTML para que pueda aceptar un archivo y envíe el mismo de manera correcta.

El campo HTML que le permite a los usurios escojer un archivo para poder enviarlos se llama "FILE". Así que pondríamos algo así:

Muy bien, ya tenemos el campo para que nuestro usuarios puedan escojer el archivo que desean enviar, pero ahora necesitamos hacer una pequeña modificación en el tag de "FORM" para que envíe el archivo correctamente:

Vemos como el parametro especial es el que dice ENCTYPE="multipart/form-data" lo cual nos indica que vamos a enviar un archivo junto con los datos de nuestra forma.

Entonces creamos un archivo al que le vamos a poner forma_upload.htm con el siguiente código:

<!doctype html public "-//w3c//dtd html 3.2//en">

<html>

<head>
<title>Upload de Archivo - Tutorial de "Perl en Español"</title>
</head>

</body>

</html>

El CGI

Ya que tenemos nuestro formulario HTML hecho, ahora vamos a crear nuestro CGI.

Lo primero que tenemos que hacer es recibir todos los datos enviados en nuestra forma. Esto lo vamos a hacer con el módulo CGI, guardando cada uno de los campos enviados en un hash:

my %Input;

my $query = new CGI;
my @pairs = $query-<param;

foreach my $pair(@pairs){
$Input{$pair} = $query-<param($pair);
}

Lo siguiente será incializar unas variables, una con la ruta de el directorio donde queremos que se estacionen los archivos enviados, y un array con las extensiones de archivos que queremos recibir:

#Directorio donde queremos estacionar los archivos
my $dir = "/ruta/al/directorio";

#Array con extensiones de archivos que podemos recibir
my @extensiones = ('gif','jpg','jpeg','bmp','png');

Ahora lo que vamos a hacer es crear un funcion que se llame recepcion_de_archivo la cual se encargara de recibir el archivo y estacionarlo correctamente.

Cuando nos llega el nombre de el archivo, llega con todo y el directorio local, por lo que vamos a crear unas expresiones regulares para sacar solamente el nombre de el archivo, y vamos a poner el resultado final en una nueva variable:

my $nombre_en_servidor = $Input{'archivo'};
$nombre_en_servidor =~ s/ /_/gi;
$nombre_en_servidor =~ s!^.*(\\|\/)!!;

Antes de empezar a recibir el archivo vamos a checar si estamos recibiendo un archivo con cualquiera de las extensiones que queriamos:

my $extension_correcta = 0;

foreach (@extensiones){
if($nombre_en_servidor =~ /\.$_$/i){
$extension_correcta = 1;
last;
}
}

Lo que hicimos fue crear una nueva variable llamada extension_correcta la cual será puesta como 1 en caso de que se encuentre cualquiera de las extensiones en el archivo, de lo contrario quedara con el 0.

Muy bien, ya que hicimos todo esto ahora tenemos que hacer la parte más importante, la recepcion y creación del nuevo archivo:

if($extension_correcta){

#Abrimos el nuevo archivo
open (OUTFILE, ">$dir/$nombre_en_servidor") || die "No se puedo crear el archivo";
binmode(OUTFILE); #Para no tener problemas en Windows

#Transferimos byte por byte el archivo
while (my $bytesread = read($Input{'archivo'}, my $buffer, 1024)) {
print OUTFILE $buffer;
}

#Cerramos el archivo creado
close (OUTFILE);

}else{
print "Content-type: text/html\n\n";
print "<h1>Extension incorrecta</h1>";
print "Sólo se reciben archivo con extension:";
print join(",", @extensiones);
exit(0);
}

Muy bien, ya tenemos nuestro código listo.

Código Final

El código final de nuestro CGI debe de ser el siguiente:

#!/usr/bin/perl -w

########################################################
#
# Código de ejemplo del tutorial: "Upload de archivos"
#
# Creado por: Uriel Lizama
# Todos los derechos reservado.
#
# http://perlenespanol.baboonsoftware.com/
#
#########################################################

use strict;
use CGI::Carp qw(fatalsToBrowser);
use CGI;

my %Input;

my $query = new CGI;
my @pairs = $query->param;

foreach my $pair(@pairs){
$Input{$pair} = $query->param($pair);
}

#Directorio donde queremos estacionar los archivos
my $dir = "/ruta/al/directorio";

#Array con extensiones de archivos que podemos recibir
my @extensiones = ('gif','jpg','jpeg','bmp','png');

recepcion_de_archivo(); #Iniciar la recepcion del archivo

#TODO SALIO BIEN
print "Content-type: text/html\n\n";
print "<h1>El archivo fue recibido correctamente</h1>\n";

exit(1);

sub recepcion_de_archivo{

my $nombre_en_servidor = $Input{'archivo'};
$nombre_en_servidor =~ s/ /_/gi;
$nombre_en_servidor =~ s!^.*(\\|\/)!!;

my $extension_correcta = 0;

foreach (@extensiones){
if($nombre_en_servidor =~ /\.$_$/i){
$extension_correcta = 1;
last;
}
}

if($extension_correcta){

#Abrimos el nuevo archivo
open (OUTFILE, ">$dir/$nombre_en_servidor") || die "No se puedo crear el archivo";
binmode(OUTFILE); #Para no tener problemas en Windows

#Transferimos byte por byte el archivo
while (my $bytesread = read($Input{'archivo'}, my $buffer, 1024)) {
print OUTFILE $buffer;
}

#Cerramos el archivo creado
close (OUTFILE);

}else{
print "Content-type: text/html\n\n";
print "<h1>Extension incorrecta</h1>";
print "Sólo se reciben archivo con extension:";
print join(",", @extensiones);
exit(0);
}

} #sub recepcion_de_archivo