I haven't gone through your code too carefully, but one glaring thing stood out. In your print_results() sub, you have $CGI::DISABLE_UPLOADS = 0;. If CGI.pm has uploads disabled by default, you need to reenable it before you instantiate your CGI object (or before your first use of a :cgi function if using the function-oriented interface). It's when you instantiate the object that CGI.pm grabs all of its data.

    # Good
    $CGI::DISABLE_UPLOADS = 0;
    my $q = CGI->new;

    # Bad
    my $q = CGI->new;
    $CGI::DISABLE_UPLOADS = 0;
[download]

Oh yeah, and use strict. :)

michellem wrote:

I virtually always use strict as a matter of course. This was an exception to my usual rule, because I knew beforehand that strict would complain about using a string as a filehandle.

So you'll disable strict for the entire program because of one line of code? Just turn off strict for that scope:

{
    no strict 'refs';
    while (<$file>) {
        $length += length($_);
    }
}
[download]

Cheers,
Ovid

Update: Okay, found the problem and fixed it. The upload method takes a filename, not a filehandle. Your code passed the filehandle/filename thingy that Stein created, so I don't know if this caused the problem or not, but I changed it to a constant to avoid any confusion. Also, you used sysopen for a file without specifying O_WRONLY. How do you write to a file that you didn't specify that you were going to write to? :)This could use some work, but here is some working code.

#!D:/perl/bin/perl.exe -wT
use CGI qw/ :standard /;
use Fcntl;
use strict;
$|++;

$CGI::DISABLE_UPLOADS = 0;
use constant BUFFER_SIZE   => 16384;
use constant UPLOAD_FILE   => 'file_upload';
use constant FILESHARE_DIR => 'xi_fileshare.dir';

print header,
    start_html('file upload'),
    h1('file upload');
    
my $dir;

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

sub print_form {
    open FILE, ">".FILESHARE_DIR or graceful_exit("Can't write to dire
+ctory file: $!");
    my $directory = param( 'directory' );
    print FILE $directory;
    close FILE;

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

sub print_results {
    my $file = param( UPLOAD_FILE );
    if ( ! $file ) {
        graceful_exit("No File!");
    }
    my $content_type = uploadInfo($file)->{'Content-Type'};
    my $file_handle = upload( UPLOAD_FILE );
    my $testfilename="whatever.xls";

    open FILE, "<".FILESHARE_DIR or graceful_exit("Can't file director
+y file: $!");
    chomp( my $directory = <FILE> );
    sysopen (OUTFILE, "$directory/$testfilename", O_WRONLY | O_CREAT) 
+or graceful_exit("Can't create file: $!!");

    my $length = 0;
    while ( read( $file_handle, my $buffer, BUFFER_SIZE ) ) {
        print pre( $buffer );
        print OUTFILE $buffer or graceful_exit( "Can't print to $direc
+tory/$testfilename: $!" ); 
        $length += length $buffer;
    }

    print p( "$directory/$testfilename" ),
          br,
          p( "Dir: $directory" ),
          h2('File name'),
          p( $file ),
          h2('File Mime Type'),
          p( $content_type ),
          h2('File Length'),
          p( $length );
    close (OUTFILE); 
}

sub graceful_exit {
    my $err = shift;
    print h3("Sorry, but an error in your input has occured! If you ca
+n figure it out, this is it: $err"),
          p( "Use your browser's <b>BACK</b> button and try again with
+ changed input" ),
          br,
          end_html;
    exit;
}
[download]

The code is strict compliant, I've taken out some duplicate code and changed repeated variables to constants. I've also cleaned up your error messages so they're a bit more useful. This could use a bit more work, but it should do for now.

Vote for paco!

Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.