#!/usr/bin/perl -w -T

use CGI ':all';
use Fcntl;

# use strict;

my $q = new CGI;
print header,
	start_html('file upload'),
	h1('file upload');

my $dir;

if ($q->param('file_upload')) {
    $dir = print_results();
    print $q->a({href=>"xi_fileshare.cgi?directory=$dir"},"Back to file listing");
    exit;
} else {print_form();}
   
print end_html;

exit;

sub print_form {

#    print $q->param('directory');

    open (FILE,">xi_fileshare.dir") or graceful_exit("Can't write to directory file");
    my $directory = $q->param('directory');
    print FILE $directory;
    close FILE;

    print $q->br;
    print $q->start_multipart_form();
    print $q->filefield(-name=>'file_upload',-size=>60);
    print $q->br;
    print $q->submit(-label=>'Upload File');
    print $q->end_form;
}

sub print_results {
   
    use constant BUFFER_SIZE => 16384;

    $CGI::DISABLE_UPLOADS = 0;

    open (FILE, "xi_fileshare.dir") or graceful_exit("Can't file directory file!");
    my $directory = <FILE>;

    print "Dir:$directory";
    
    my $length;
    
    my $file = $q->param('file_upload');
    
    if (!$file) {graceful_exit("No File!");}

    print h2('File name'),$file;
    print h2('File Mime Type'),$q->uploadInfo($file)->{'Content-Type'};
    while (<$file>) {
	$length += length($_);
    }
    
    print h2('File Length'),$length;

# OK, Upload that file

    my $buffer;
    my $file_handle = $q->upload($file);
    my $format = $q->uploadInfo($file)->{'Content-Type'};
    my $testfilename="whatever.xls";
    print "$directory/$testfilename";
    print $q-> br;

    sysopen (OUTFILE, "$directory/$testfilename", O_CREAT) or graceful_exit("Can't create file!");

    while ( read( $file_handle, $buffer, BUFFER_SIZE ) ) { 
	print OUTFILE $buffer; 
    }
    
    close (OUTFILE); 

}

sub graceful_exit {

    my $err = shift;

    print $q->h3("Sorry, but an error in your input has occured! If you can figure it out, this is it:$err");
    print "Use your browser's <b>BACK</b> button and try again with changed input";
    print $q->br;
    print $q->end_html;

    exit;
    
}