#!/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 = "/usr/local/httpd/Rep_ecriture/";

# 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; 
	}