Chad Wallace wrote: > Hello, > > I've been trying to get a file upload to work. I was first using CGI.pm, but it was >giving me problems, and I couldn't figure it out. > > I decided to switch to CGI::Lite, and the uploads seemed to work. However, they >never were working. The $form->{'upload'} variable was simply returning the name of >the file on the client machine, which just happened to be the server machine... so >when I opened the file, it was opening the original file, and bypassing the upload >entirely. Of course, when I then tried to upload something from another machine, it >wouldn't work. > > Now, I changed my script to use a filehandle instead of a filename, and put in >"$cgi->set_file_type('handle')" before the parse_form_data... But it still returns >the CLIENT-SIDE FILENAME in $form->{'upload'}, which gives an error when I try to use >it as a filehandle!! > > 'upload' is the name of my <input type=file>. Is there another, undocumented, >method to access the filehandles of uploaded files? > > Any ideas here?
Looks to me like CGI-Lite has Win32 bugs in it. I made the following changes and it seemed to work: 466a467,468 > use vars qw(&print_form_data &print_cookie_data); # $Bill 5/13/02 > 980a983 > binmode STDIN; # $Bill 05/13/02 1064,1065c1067,1071 < < $self->{web_data}->{$field} = $new_name; --- > if ($seen->{$field} > 1) { # $Bill 05/13/02 > push @{$self->{web_data}->{$field}}, $new_name; # $Bill 05/13/02 > } else { # $Bill 05/13/02 > $self->{web_data}->{$field} = $new_name; > } # $Bill 05/13/02 1071a1078 > binmode $handle; # $Bill 05/13/02 1159a1167 > binmode $handle; # $Bill 05/13/02 (may not be needed) RCS format: a466 2 use vars qw(&print_form_data &print_cookie_data); a980 1 binmode STDIN; d1064 2 a1065 5 if ($seen->{$field} > 1) { # $Bill 05/13/02 push @{$self->{web_data}->{$field}}, $new_name; } else { $self->{web_data}->{$field} = $new_name; } a1071 1 binmode $handle; a1159 1 binmode $handle; My test script (Win98/Apache) - handles mult file uploads: #!perl -w -- use strict; use File::Copy; use CGI::Lite; use Data::Dumper; $Data::Dumper::Indent=1; my $tmpdir = "C:/temp"; # place to store files - change me if you like my $use_rename = 1; # set to use rename instead of file copy my $use_tmpfilename = 0; # use tmpFileName method (not working in 2.752) my $d = 0; # set to 1 for debug prints $| = 1 if $d; sub print_error; # Sample calling form: # <FORM METHOD="POST" ENCTYPE="multipart/form-data" ACTION="/cgi-bin/upload.pl"> # File to upload<INPUT TYPE="FILE" NAME="filename" SIZE=32> # File to upload<INPUT TYPE="FILE" NAME="filename" SIZE=32> # ... more of above if needed # <INPUT TYPE="SUBMIT" VALUE="Upload"> # </FORM> # output content header BEGIN { print "Content-type: text/html\n\n"; use CGI::Carp qw(carpout fatalsToBrowser); &carpout (\*STDOUT); } # get filename args my $cgi = new CGI::Lite or die "new CGI: $!\n"; $cgi->set_platform ('UNIX'); # PC|UNIX|Mac line endings (I use UNIX on PC) $cgi->set_file_type ('handle'); # 'handle' or 'file' $cgi->add_timestamp (1); # 0=noTS, 1=TS all files, 2=TS only if exists $cgi->set_directory ($tmpdir) or die "set_directory($tmpdir) error: $!"; my %F = $cgi->parse_form_data; $d = 1 if $F{debug}; print Data::Dumper->Dump([\%F], [qw(%F)]) if $d; my @filename = $cgi->get_multiple_values($F{filename}); # must match form name print "<P><B>\@filename=@filename</B></P>\n" if $d; &print_error ("Missing filename arg\n") if @filename < 1; # start HTML print <<EOD; <HTML> <BODY> <CENTER> <H1>Results of file upload</H1> EOD # do for each file to upload foreach (@filename) { # skip empty slots next if length $_ < 1; # extract just the filename print "<P><B>filename=$_</B></P>\n"; (my $file = $_) =~ s/^.*?([^\\\/]+)$/$1/; my $tmppath = "$tmpdir/$file"; print "<P><B>file=$file, tmppath=$tmppath</B></P>\n" if $d; # check file size on disk my $size = -s $tmppath; print "<P><B>File '$_' uploaded to '$tmppath', size=$size</B></P>\n"; } print <<EOD; </CENTER> </BODY> </HTML> EOD $cgi->close_all_files; exit 0; #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - sub print_error { print <<EOD; <HTML> <BODY> <CENTER><H1>$_[0]</H1></CENTER> </BODY> </HTML> EOD exit 0; } #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - __END__ -- ,-/- __ _ _ $Bill Luebkert ICQ=14439852 (_/ / ) // // DBE Collectibles Mailto:[EMAIL PROTECTED] / ) /--< o // // http://dbecoll.tripod.com/ (Free site for Perl) -/-' /___/_<_</_</_ Castle of Medieval Myth & Magic http://www.todbe.com/ _______________________________________________ Perl-Win32-Web mailing list [EMAIL PROTECTED] To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs