the following script
--------------------------
#!/usr/local/bin/perl
######use lib $0 =~ m#(.+)[/\\]#;
use CGI qw
standard);
######use CGI::Carp qw/fatalsToBrowser/;
print header();
print start_html("File Upload Example");
print strong("Version "),$CGI::VERSION,p;
print h1("File Upload Example"),
'',
strong(""),
p,
'',cite(''),'';
@types = ('count lines','count words','count characters');
# Start a multipart form.
print start_multipart_form(),
"Enter the file to process:",
filefield('filename','',45),
br,
checkbox_group('count',\@types,\@types),
p,
reset,submit('submit','Process File'),
endform;
# Process the form if there is a file name entered
if ($file = param('filename'))
{
$filename = "Cabbage.gif";
$UPLOAD_PATH = "";
$UPLOAD_FILE = $UPLOAD_PATH.$filename;
print "FILE NAME: $UPLOAD_PATH$filename<br>";
open (OUTFILE,">$UPLOAD_FILE") or die "Could not open $UPLOAD_FILE
- $!\n";
binmode(OUTFILE);
while(read($file,$buffer,1024))
{
print OUTFILE $buffer;
}
print "Finished - Filname: $filename, Buffer: $buffer<BR><BR>";
close OUTFILE;
}
print end_html;
---------------------------------
is not working for me; the form is printed ok, but param() does not
return a filename.
what could possibly be wrong?
if somebody could post a script that works for them, it would be
greatly appreciated
### I found this upload script on the web several years ago. I don't
know
### if it's the best solution, but I do know that it's worked for over
### 500 file uploads, without a single error. Good luck.
#!/usr/bin/perl
$thisurl = $ENV{'SERVER_URL'}.$ENV{'SCRIPT_NAME'};
$upload_dir = 'yourdir'; # location for uploaded files
main();
sub main {
read_net_input();
if( $GLOBAL{'UPLOAD'} ) { handle_upload(); }
elsif( !$ENV{'PATH_INFO'} || $ENV{'PATH_INFO'} eq '/' ) {
show_dir_content(); }
else { start_download( $ENV{'PATH_INFO'} ); }
}
sub print_header {
print "Content-Type: text/html\n\n";
}
sub urldecode {
local($in) = @_;
local($i, @input_list);
@input_list = split(/&/,$in);
foreach $i (@input_list) {
$i =~ s/\+/ /g; # Convert plus's to spaces
# Convert %XX from hex numbers to alphanumeric
$i =~ s/%(..)/pack("c",hex($1))/ge;
# Split into key and value.
$loc = index($i,"=");
$key = substr($i,0,$loc);
$val = substr($i,$loc+1);
$GLOBAL{$key} = $val;
}
}
sub read_net_input {
local ($i, $loc, $key, $val, $input);
local($f,$header, $header_body, $len, $buf);
if ($ENV{'REQUEST_METHOD'} eq "GET")
{ $input = $ENV{'QUERY_STRING'}; }
elsif ($ENV{'REQUEST_METHOD'} eq "POST")
{
$len = 0;
$input = '';
while( $len != $ENV{'CONTENT_LENGTH'} ) {
$buf = '';
$len += sysread(STDIN, $buf, $ENV{'CONTENT_LENGTH'});
$input .= $buf;
}
}
if( $ENV{'CONTENT_TYPE'} =~ /multipart\/form-data; boundary=(.+)$/
) {
$boundary = '--'.$1; # please refer to RFC1867
@list = split(/$boundary/, $input);
$header_body = $list[1];
$header_body =~ /\r\n\r\n|\n\n/; # separate header and body
$header = $`; # front part
$body = $'; # rear part
$body =~ s/\r\n$//; # the last \r\n was put in by Netscape
$GLOBAL{'FILE_CONTENT'} = $body;
$header =~ /filename=\"(.+)\"/;
$GLOBAL{'FILE_NAME'} = $1;
$GLOBAL{'FILE_NAME'} =~ s/\"//g; # remove "s
$GLOBAL{'FILE_NAME'} =~ s/\s//g; # make sure no space(include
\n, \r..) in the file name
for( $i=2; $list[$i]; $i++) {
$list[$i] =~ s/^.+name=$//;
$list[$i] =~ /\"(\w+)\"/;
$GLOBAL{$1} = $';
}
return 1;
}
urldecode($input);
1;
}
sub read_file {
local($fname) = @_;
local($content);
open(FILE, "<$fname") || return '';
while(<FILE>)
{
$content .= $_;
}
close(FILE);
$content;
}
sub read_dir {
local($target_dir) = @_ ;
local($filename, $dir_content);
return 0 if( !$target_dir );
opendir(DIR, $target_dir) || return 0;
$target_dir =~ s/^\.\///; # remove ./
$target_dir =~ /(.+)\/(.+)\/$/; # find out upper level
$GLOBAL{'UP_LEVEL'} = $1; # save upper level as a global
if( $target_dir ) {
$dir_content = "..back\n\n\n";
}
while($filename = readdir(DIR)) {
if( $filename =~ /^\.|^\#|~$/ ) { next; } # skip hidden files
$dir_content .= "$target_dir$filename\n";
}
closedir(DIR);
$dir_content;
}
sub format_html_output {
local($content) = @_;
local(@filelist, $formated_content, $up_level);
return 0 if (!$content);
@filelist = split(/\n/, $content);
$foo = 0;
$formated_content = "<CENTER><TABLE cellspacing=5 cellpadding=5
border=1>\n";
foreach $f (@filelist) {
if( $f eq '..back' ) {
$up_level = $GLOBAL{'UP_LEVEL'};
$formated_content = "<a
href=".$thisurl.'/'.$up_level.">$f</a><br>\n<P><CENTER><TABLE
cellspacing=5 cellpadding=5 border=1>\n";
next;
}
if( !$f ) {
next;
}
if( -d $f ) {
$f = "$f/";
}
$foo++;
if ($foo eq 5) {
$formated_content .= '<TD><a
href='.$thisurl.'/'.$f.">$f</a><TR>\n";
$foo = 0;
}
else {
$formated_content .= '<TD><a
href='.$thisurl.'/'.$f.">$f</a>\n";
}
}
$formated_content .= "</TABLE></CENTER>\n";
$formated_content;
}
sub show_dir_content {
local($dir) = @_;
local($files, $f_files);
$dir = './' if (!$dir); # default to cgi dir
$files = read_dir($dir);
$f_files = format_html_output($files);
print_header();
print "
<HTML>
<HEAD>
<TITLE>File UpLoad/DownLoad</TITLE>
</HEAD>
<BODY BGCOLOR=\#FFFFFF >
<CENTER>
<H2>File Upload Screen</H2>
<FORM METHOD=\"POST\" ENCTYPE=multipart/form-data >
<TABLE>
<TR>
<TD WIDTH=80%>File Name: <INPUT TYPE=\"file\"
NAME=\"file\" SIZE=50 >
</TD>
</TR>
</TABLE>
<TABLE>
<TR>
<TD WIDTH=20%><INPUT TYPE=submit NAME=UPLOAD
VALUE=Upload >
</TD>
<TR>
</TABLE>
<INPUT TYPE=HIDDEN NAME=CURRENT_DIR VALUE=\"$dir\">
</FORM>
<font size=-1>Default Directory: $upload_dir</font></center>
<HR>
<I>
<P>\ \;</P>
</I>
</FONT>
</BODY>
</HTML>
";
exit;
}
sub show_file_not_found {
print_header();
print "<TITLE>Not Found</TITLE><H1>Not Found</H1> The requested
object does not exist on this server. The link you followed is either
outdated, inaccurate, or the server has been instructed not to let you
have it. Connection closed by foreign host.\n"
;
exit;
}
sub show_upload_failed {
local($reason) = @_;
print_header();
print "<TITLE>Upload Failed</TITLE><H1>Upload Failed</H1> The
requested object was not uploaded to the server. <br> Reason :
$reason. The server may have decided not let you write to the
directory specified. Please contact the web master for this prob
lem. Connection closed by foreign host.\n";
exit;
}
sub show_upload_success {
local($uploaded_file) = @_;
local(@status_list) ;
$file_stats = `ls -la $uploaded_file`;
@status_list = split(/\s+/, $file_stats); # bug fix in v00.01
print_header();
print "
<HTML>
<HEAD>
<TITLE>File UpLoaded</TITLE>
</HEAD>
<BODY BGCOLOR=\#FFFFFF >
<H2><center>File Transfer Successful</center></H2>
<table align = center width = 35% cell padding = 10 border = 6>
<tr>
<td>
<blockquote>
<br />
Remote File Name : <FONT COLOR=\#FF0000>
$GLOBAL{'FILE_NAME'} </FONT>
File Name : $filename
Location : $upload_dir
File Size : $status_list[4]
<br />
Local Time: $status_list[5] $status_list[6]
$status_list[7]
<br />
<a href=\"$ENV{'SCRIPT_NAME'}\"> Back </a>
</blockquote>
</td>
</tr>
</table>
<br />
<center>
<form action = 'myform.pl' method = 'get'>
<input type = 'hidden' name = '$filename'>
<input type = 'Submit' value = 'Preprocess this
file...'>
</form>
</center>
</BODY>
</HTML>
";
exit;
}
sub handle_upload {
if( !$GLOBAL{'FILE_NAME'} ) { show_file_not_found(); }
$filename = $GLOBAL{'FILE_NAME'};
$filename =~ s/.+\\([^\\]+)$|.+\/([^\/]+)$/\1/;
if( $GLOBAL{'UPLOAD_DIR'} =~ /CURRENT/ ) { # change upload dir
to current
$GLOBAL{'CURRENT_DIR'} =~ s/\s//g;
$upload_dir = $GLOBAL{'CURRENT_DIR'};
}
$write_file = $upload_dir.$filename;
open(ULFD,">$write_file") || show_upload_failed("$write_file
$!");
print ULFD $GLOBAL{'FILE_CONTENT'};
close(ULFD);
show_upload_success($write_file);
1;
}
