usaravanan wrote:
> I have created the form which holds three file browse with upload button.
Try mine (should work fine, but rename option may not work - currently turned
off).
Here's the form:
<FORM METHOD="POST" ENCTYPE="multipart/form-data" ACTION="/cgi-bin/ul.pl">
<B>File to upload: </B><INPUT TYPE="FILE" NAME="filename" SIZE=32>
<BR><B>File to upload: </B><INPUT TYPE="FILE" NAME="filename" SIZE=32>
<BR><B>File to upload: </B><INPUT TYPE="FILE" NAME="filename" SIZE=32>
<BR><B>File to upload: </B><INPUT TYPE="FILE" NAME="filename" SIZE=32>
<BR><INPUT TYPE="SUBMIT" VALUE="Upload">
</FORM>
And the script:
#!perl -w --
use strict;
use File::Copy;
use CGI qw/:standard/;
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 = 1; # set to 1 for debug prints
my $MAX_SIZE = 102400;
# $CGI::POST_MAX = $MAX_SIZE; # restrict file size if needed
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);
}
# get filename args
my $cgi = new CGI or die "new CGI: $!\n";
my @filename = $cgi->param('filename'); # must match form name
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
my $fn = fileno $_;
print "<P><B>filename=$_, fn=$fn</B></P>\n";
(my $file = $_) =~ s/^.*?([^\\\/]+)$/$1/;
my $tmppath = "$tmpdir/$file";
print "<P><B>file=$file, tmppath=$tmppath</B></P>\n" if $d;
# if try renaming temp file
if ($use_rename) {
# close CGI.pm temp file
close $_ or print "Error closing tempfile '$_': $!\n";
# check file has some size or print error
my $tmp;
if ($use_tmpfilename) {
$tmp = $cgi->tmpFileName($_);
print "<P><B>use tmpFileName='$tmp'</B></P>\n" if $d;
} else {
$tmp = $cgi->{'.tmpfiles'}->{$fn}->{name} ?
$cgi->{'.tmpfiles'}->{$fn}->{name}->as_string() : '';
print "<P><B>tmp='$tmp'</B></P>\n" if $d;
}
print "</CENTER><PRE><BLOCKQUOTE>\n" if $d;
print Data::Dumper->Dump([$cgi], [qw($cgi)]) if $d;
print "</BLOCKQUOTE></PRE><CENTER\n" if $d;
my $size = -s $tmp;
if ($size < 1) {
print "<P><B>Zero length file temp file '$tmp'.\n";
print "<BR>'$_' not uploaded: $!\n";
print "<BR>Check file spec in upload form</B></P>\n";
next;
}
# rename CGI.pm temp file to upload dir
if (move ($tmp, $tmppath)) {
# check file size on disk
my $loc_size = -s $tmppath;
print "<P><B>File '$_' uploaded to '$tmppath', " .
"local size=$loc_size</B></P>\n";
} else {
print "Error renaming '$tmp' to '$tmppath': $!\n";
print "Trying copy instead\n";
goto TRY_COPY;
}
next;
}
# else we'll copy the temp file
TRY_COPY:
# open output file
open OUT, ">$tmppath" or print_error ("Error opening $tmppath: $!\n");
binmode OUT;
# copy file
my $size = 0;
while (my $bytes = read $_, my $buffer, 4096) {
print OUT $buffer;
$size += $bytes;
}
close OUT;
# check file size on disk
my $loc_size = -s $tmppath;
print "<P><B>File '$_' uploaded to '$tmppath', size=$size, " .
"local size=$loc_size</B></P>\n";
# close CGI.pm temp file
close $_ or print "Error closing tempfile '$_': $!\n";
# delete CGI.pm temp file
my $tmp = '';
if ($use_tmpfilename) {
$tmp = $cgi->tmpFileName($_);
} else {
$tmp = $cgi->{'.tmpfiles'}->{$fn}->{name}->as_string;
}
unlink $tmp or print "Error deleting tempfile '$tmp': $!\n";
}
print <<EOD;
</CENTER>
</BODY>
</HTML>
EOD
exit 0;
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub print_error {
print <<EOD;
<HTML>
<BODY>
<CENTER><H1>$_[0]</H1></CENTER>
</BODY>
</HTML>
EOD
exit 0;
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
__END__
_______________________________________________
ActivePerl mailing list
[email protected]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
