Function to upload using cgi / perl script

[desktopfellow]

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

 

[feherke]

Hi

This is not like FTP where is difference between [tt]ascii[/tt] and [tt]binary[/tt].

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/

 

[KevinADC]

all you need to do is use the binmode() on the filehandle.

 

[KevinADC]

I assumed you are wanting to use a perl based CGI script for the uplaoding.

 

[desktopfellow]

yes I would like to use perl based cgi scripting,Kevin.

Vishnu

 

[ChrisHunt]

http://www.google.co.uk/search?q=perl+cgi+file+upload

-- Chris Hunt
Webmaster & Tragedian
Extra Connections Ltd

 

[desktopfellow]

Chris,

I hv dont with the google and couldnt find any solutions either.



Vishnu

 

[desktopfellow]

Chris,

I hv done with the google and couldnt find any solutions either.



Vishnu

 

[ChrisHunt]

The first result from that search has exactly what you asked for. No doubt many of the other 3 million hits do too.

-- Chris Hunt
Webmaster & Tragedian
Extra Connections Ltd

 

[KevinADC]

That article on sitepoint is not a real good example, but it does show how to do it using perl and the CGI module.

Here is an uploader script I wrote a while back, it could probably be improved (up.pl):

#!/usr/bin/perl -w

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 = '[URL unfurl="true"]http://www.yoursite.com';[/URL]
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="[URL unfurl="true"]http://$domain_name/upload/$_">http://$domain_name/upload/$_</a><br>~[/URL] 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:

!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<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>