Voila j'ai fait mon serveur Web et j'ai trouver sur un site un script en Perl permettant d'uploader des fichiers sur le serveur.
Je l'ai installé, ca fonctionne bien.
Le seul truc c'est que sur ma première page html, j'ai mis ce code la :
Il me crée donc un formulaire avec parcourir et envoyer, et quand je clique sur envoyer il me renvoie sur une autre page avec la même chose.
Comment supprimer cette seconde page?
Je mets aussi mon fichier save_fichier.cgi car je pense que ca vient de la mais comme je connais rien au perl....
Merci de votre aide
Fichier save_fichier.cgi
#!/usr/bin/perl -Tw
# Chemin a adapter sous Unix
=head1 NAME
Script permettant d'uploader un fichier sur le serveur
à l'aide la librairie CGI.pm. On passe par un formulaire
HTML de type <FORM METHOD=POST ENCTYPE=multipart/form-data>
et a l'aide de la balise <INPUT TYPE=file NAME=file>
Le fichier est enregistre dans le repertoire $upload_dir,
Modifier les variables necessaires dans la configuration
ci-dessous. Pour générer la doc de ce fichier, faire
"pod2html save_fichier.txt".
=head1 VERSION
$Revision: 0.3 $
=head1 DESCRIPTION
=cut
# v0.3 Utilisation de CGI.pm
# v0.2 Correction controle parametres
# --> uniquement chaines de caracteres acceptes
# --> execution avec use Strict, elimination de la plupart des erreurs
# Reste a corriger certains (pb de cgi-lib.pl)
# v0.1 Initialisation
use CGI qw(:standard);
use CGI::Carp qw/fatalsToBrowser/;
use strict;
use diagnostics;
use File::Copy;
## Repertoire ou sont deposes les fichiers
my $upload_dir = "/tmp/";
# Cettte variable est utilise dans le cas ou qqn
# essaie de telecharger un fichier deja existant
# dans le repertoire concerne
# Si $boolEcrase=0 un message d'erreur apparait
# Si $boolEcrase=1 le fichier est Ecrase
my $boolEcrase=0;
&main($boolEcrase);
=head2 main($boolEcrase)
Bon vieux main
--> Appel ecran de formulaire
--> Si fichier soumis, traitement du fichier et enregistrement
sur le serveur
=cut
sub main()
{
my($boolEcrase)=@_;
# Ecran formulaire
&ecran();
# Traitement du formulaire si nom de
# fichier passe en parametre
if (my $file = param('filename'))
{
my $tmpfile=tmpFileName($file);
&traiter_fichier($file,$tmpfile,$boolEcrase);
}
}
#--------------------------------------------------------
# Formulaire HTML de depot
#--------------------------------------------------------
sub ecran
{
print header();
print start_html("Exemple de telechargement de fichiers");
print h1("Exemple de telechargement de fichiers"),
'Cet exemple montre comment deposer un fichier via un formulaire et
un CGI Perl. Cet exemple fonctionne avec Netscape 2.0 minimum ou
IE 4.0 minimum.',
start_multipart_form(),
"Choisissez votre fichier a déposer:",
filefield(-name=>'filename',-size=>45),
submit('download','Telechargez'),
endform,
end_html;
if (!(-w $upload_dir))
{
print "Attention le repertoire $upload_dir est protege en ecriture<br>";
print "Aucune depot ne pourra se faire ...";
}
}
#--------------------------------------------------------
# Enregistrement du fichier
# temporaire dans le repertoire final
#--------------------------------------------------------
sub traiter_fichier
{
my($file,$tmpfile,$boolFile)=@_;
my($nom);
if ($file=~/.*\\(.*)$/) {$nom=$1;}
else {$nom=$file;}
my %stats;
my($fileFinal) = $upload_dir.$nom;
if ((-e $fileFinal) && ($boolFile==0)) {&Aff_e_fichier_existant();}
print hr();
if (-e $tmpfile)
{
use File::Copy;
copy($tmpfile,$fileFinal) || die "Impossible de creer $fileFinal avec $tmpfile:$!\n<br>";
&Aff_succes_ecriture ($fileFinal,$file);
}
}
#--------------------------------------------------------
# Message d'erreur pour l'ecriture sur fichier existant
#--------------------------------------------------------
sub Aff_e_fichier_existant
{
my($url)=$ENV{'SRIPT_NAME'};
my($buf) = "
Vous tentez d'écraser un fichier sur le serveur .<BR>
Le nom que vous avez donnez a votre fichier est deja occupé .<BR>
Veuillez rentrer un autre nom .<BR>";
print h1("Fichier existant"),$buf;
exit;
}
#--------------------------------------------------------
# Message apres un depot reussi
#--------------------------------------------------------
sub Aff_succes_ecriture
{
my($uploaded_file,$filename) = @_;
my(@status) = stat($uploaded_file);
my($buf)="
<H2>Document transferré avec succès</H2>
<PRE>
Nom du document local : <FONT COLOR=\#FF0000> $filename </FONT>
Taille du fichier : $status[7]
</PRE>";
print $buf;
exit;
}
Quel est ton OS, quel est ton serveur http
Si serveur Apache,
le répertoire cgi-bin est-il correctement renseigné dans ton httpd.conf ?
(il semble que oui)
<troll>
Perl, pouah quelle horreur quelle manque de lisibilité
</troll>
Gates gave you the windows.
GNU gave us the whole house.(Alexandrin)