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
