Hi Folks,

I've been struggling with this for a while, and I'm not sure what I've been doing wrong. I've read a number of nodes, including Ovid's nice treatise on file uploads. I've looked at the camel book, as well as read perldoc on CGI. I've modified this script lots over the last few days, but I'm still stumped.

Primarily, my problem is that the files that are uploaded are empty. I also have an unrelated problem, with passing any information except a file name using a multi-part form (thus I've had to do the obnoxious work-around of writing to a file with the directory I want the file uploaded in.) There are several problems with this script, I know. For one, it does not pass strict (I can fix that later, I just want to get the upload working now). Any advice on what I am doing wrong would be greatly appreciated!

Here's the code:

#!/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 fil
+e 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 d
+irectory 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 direc
+tory 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 yo
+u can figure it out, this is it:$err");
    print "Use your browser's <b>BACK</b> button and try again with ch
+anged input";
    print $q->br;
    print $q->end_html;

    exit;
    
}
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.