Velocity Reviews - Computer Hardware Reviews

Velocity Reviews > Newsgroups > Programming > Perl > Perl Misc > file upload script

Reply
Thread Tools

file upload script

 
 
boris bass
Guest
Posts: n/a
 
      09-04-2003
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
 
Reply With Quote
 
 
 
 
Bigus
Guest
Posts: n/a
 
      09-04-2003

"boris bass" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed) om...
> the following script
>
> --------------------------
>
> #!/usr/local/bin/perl
>
> ######use lib $0 =~ m#(.+)[/\\]#;
> use CGI qw(:standard);


[..]

> # Process the form if there is a file name entered
> if ($file = param('filename'))


I always thought that you had to use CGI standard to get submitted form
values like this:

use CGI qw(:standard);
$query = new CGI;
if($file = $query->param("filename"));

Bigus


 
Reply With Quote
 
 
 
 
JR
Guest
Posts: n/a
 
      09-04-2003
http://www.velocityreviews.com/forums/(E-Mail Removed) (boris bass) wrote in message news:<(E-Mail Removed). com>...
> 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>\&nbsp\;</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;
}
 
Reply With Quote
 
 
 
Reply

Thread Tools

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
File upload from client application (non-form based upload) stuart@microsoft.com Python 1 11-25-2006 12:14 AM
Upload a file without file Upload control - ASP.Net =?Utf-8?B?U2FyYXY=?= ASP .Net 3 08-03-2005 01:09 AM
How to detect sizeof upload in order to show status of browser file upload? Heather Fraser Java 0 07-05-2004 12:35 AM
Howto upload file w/ applet and php/cgi script Jorch Java 2 05-18-2004 06:04 PM
Upload Excel with Macros using HTML File Upload Prakash ASP General 3 11-12-2003 04:26 AM



Advertisments