#!/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);
}
