Function to upload using cgi / perl script
Function to upload using cgi / perl script
(OP)
Hi,
I am trying to upload a file from local client to webserver.
If anyone could gimme a function that can upload in binary mode, it would be great..!!
Thanks in Advance.
Vishnu
I am trying to upload a file from local client to webserver.
If anyone could gimme a function that can upload in binary mode, it would be great..!!
Thanks in Advance.
Vishnu
Talk To Other Members
RE: Function to upload using cgi / perl script
This is not like FTP where is difference between ascii and binary.
What you done already and what is the exact problem ? ( Like displayed/logged error message, script/web server/operating system crash, no/wrong result, anything else... )
Feherke.
http://rootshell.be/~feherke/
RE: Function to upload using cgi / perl script
RE: Function to upload using cgi / perl script
RE: Function to upload using cgi / perl script
Vishnu
RE: Function to upload using cgi / perl script
-- Chris Hunt
Webmaster & Tragedian
Extra Connections Ltd
RE: Function to upload using cgi / perl script
I hv dont with the google and couldnt find any solutions either.
:(
Vishnu
RE: Function to upload using cgi / perl script
I hv done with the google and couldnt find any solutions either.
:(
Vishnu
RE: Function to upload using cgi / perl script
-- Chris Hunt
Webmaster & Tragedian
Extra Connections Ltd
RE: Function to upload using cgi / perl script
Here is an uploader script I wrote a while back, it could probably be improved (up.pl):
CODE
use strict;
use CGI;
#use CGI::Carp qw/fatalsToBrowser/;
use File::Basename;
$CGI::POST_MAX = 1024 * 5000; # 5MB file upload max
$CGI::DISABLE_UPLOADS = 0; # allow uploads
my $upload_dir = 'home/var/public_html/upload';
my $domain_name = 'http://www.yoursite.com';
my @ext_list = qw(jpeg jpg gif png art);
my @mime_types = qw(image);
my $max_uploads = 5;
my $query = CGI->new;
# check if CGI.pm version supports upload()
unless ( $CGI::VERSION >= 2.47 ){
&error("<P>Sorry, the version of CGI.pm is too old.</P>
<P>You must have verison 2.47 or higher to use this script.</P>","CGI.pm Version $CGI::VERSION Too Old");
}
# print error message and abort script if uploading is off
if ($CGI::DISABLE_UPLOADS > 0){
&error('<P>Sorry, file uploading is temporarily disabled</P>','File Uploading Not Allowed');
}
# check to see if upload was too large
if ($query->cgi_error()){
my $error = $query->cgi_error();
&error("<P>The file you are uploading is too large!</P>
<P>Files are limited to $CGI::POST_MAX KB.</P>
<P>Use your back button to return to the upload form.", $error);
}
my @filehandles = $query->upload('photo');
if (scalar @filehandles > $max_uploads) {
@filehandles = @filehandles[1..$max_uploads];
}
my @success = ();
my @fail = ();
chdir($upload_dir) or &error("<P>Unable to find/open: $upload_dir</P>",'Can\'t find/open directory');
UPLOADFILES:
foreach(@filehandles) {
my $file = $_;
my $filename = $_;
my ($name,$path,$ext) = fileparse($filename,@ext_list);
my $type = eval {$query->uploadInfo($filename)->{'Content-Type'}};
# check for allowable MIME types
if ($type && @mime_types){
my $good = 0;
foreach(@mime_types){
$good = 1 if $type =~ m|^$_/|i;
last if $good == 1;
}
push (@fail,"$name$ext - MIME type not allowed $type") if ($good == 0);
next UPLOADFILES if ($good == 0);
}
# check for allowable file extenstions
if (@ext_list){
push (@fail,"$name$ext - file extension not allowed") unless ($ext);
next UPLOADFILES unless ($ext);
}
# all good: upload file
open(UPLOAD, ">$upload_dir/$name$ext") or &error("Unable to open dir: $upload_dir","Can't open directory");
binmode(UPLOAD);
while (<$file>) {
print UPLOAD;
}
close(UPLOAD);
#check for non-zero size files
if (-s "$name$ext" <= 0) {
unlink("$name$ext");
}
else {
push @success,"$name$ext";
}
}
print $query->header('text/html'),
$query->start_html(-title=>'Thanks!',bgcolor=>'#FFFFFF');
if (@success) {
print qq~<h3>@{[scalar @success]} files successfully uploaded:</h3>~;
print qq~<a href="http://$domain_name/upload/$_">http://$domain_name/upload/$_</a><br>~ for @success;
if (@fail) {
print qq~<h3>@{[scalar @fail]} files were not uploaded.</h3>~;
print qq~$_</a><br>~ for @fail;
}
}
else {
local $" = ' - ';
print qq~<h3>No files were uploaded.</h3>Files can not be empty and they must be images: @ext_list<br>\n~;
print qq~$_</a><br>~ for @fail;
}
print $query->end_html;
sub error{
my $error = shift;
my $status = shift;
$query->delete_all();
print $query->header(-type=>'text/html'),
$query->start_html(-title=>'Error!',bgcolor=>'#FFFFFF');
print "<h3>Error: $status</h3>";
print $error;
print $query->end_html;
exit(0);
}
a sample form to use the script:
CODE
<HTML>
<HEAD></HEAD>
<BODY>
<FORM ACTION="cgi-bin/up.pl" METHOD="post" ENCTYPE="multipart/form-data">
Image to Upload: <INPUT TYPE="file" size="40" NAME="photo"><br>
Image to Upload: <INPUT TYPE="file" size="40" NAME="photo"><br>
Image to Upload: <INPUT TYPE="file" size="40" NAME="photo"><br>
Image to Upload: <INPUT TYPE="file" size="40" NAME="photo"><br>
Image to Upload: <INPUT TYPE="file" size="40" NAME="photo">
<br><br>
<INPUT TYPE="submit" NAME="Submit" VALUE="Submit Form"> <input type="reset">
</FORM>
</BODY>
</HTML>