Multiple File upload script

bionicle32 has asked for the wisdom of the Perl Monks concerning the following question:

Hello Perl Monks it is I the bionicle one. I have not posted a question in a while, but I have good one that all of you could hopefully help me with?

I have attempted to write my own multiple file upload script with some success. This script creates the file in the specified directory with the new name, but creates the file with a zero byte size.

I am requiring an outside file (settings.pl and &load contains path info) which contains full paths to $addendumDir and $tempDir directories, which are variables used elsewhere in my application. I have used a similar structure for another part of this very same application which uploads one file and works great. Here is the code below:

#!/usr/local/bin/perl
# Home Improvement Application

use strict;
use warnings;
use File::Basename;
use File::Copy;
use CGI qw(:standard);
use CGI::Carp qw ( fatalsToBrowser );
require "settings.pl";
use vars qw( $problem $writeType $bytes $addendumDir $tempdir );
umask(000);
&load;

my $cgi = new CGI;
my $max_size = 250;

$CGI::POST_MAX = 1024 * 1500;   # Limit to 1500kb posts...

if (defined(param('files'))) {
    my $associate = param('associate');
    my @files = param('files');
    my @captions = param('caption');
    my $fullpath = join("|",@files);
    my $desc = join("|",@captions);
    uploadMultiple($associate,$fullpath,$desc);
} elsif (!defined(param('files'))) {
    my $image = param('uniquecode');
    uploadMulti($image);
} else {
    print $cgi->header;
    print "Accessing this script illegally!";    
}

sub uploadMulti {

my ($tempError,$error,$name);

if (scalar(@_) == '1') {
    $name = shift;
    $error = "&nbsp;";
} else {
    ($tempError,$name) = @_;
    if ($tempError eq "Bad File Extension") {
        $error = &badExt;
    } else {
        $error = &fileToBig;
    }
}

my @images = ("one","two","three","four");
my $uploaded = '1';
my $multi;

for (my $rows = $uploaded; $rows < scalar((@images) + $uploaded); $row
+s++) {

$multi .= qq(<tr>
<td valign="center" align="center">

<table cellpadding="1" cellspacing="1" border="1" width="90%">
<tr>
<td valign="center" align="center" width="35%"><span class="text8pt"><
+input type="file" name="files" size="15" class="text8pt"></span></td>
<td valign="center" align="center" width="55%"><span class="text8pt"><
+font color="#ff0000">Caption for graphic:</font>&nbsp;&nbsp;<input ty
+pe="text" name="captions" size="20" maxlength="50" class="text8pt"></
+span></td>
</tr>
</table>

</td>
</tr>
<tr>
<td valign="center" align="center" width="75%"><hr noshade size="1"></
+td>
</tr>
);

}

print $cgi->header();
print <<FORM
<html>
<head><title></title>
<link href="/_vti_templates/templates/visual/visual.css" rel="styleshe
+et" type="text/css"></head>
<body topmargin="0" leftmargin="0" marginheight="0" marginwidth="0" bg
+color="ffffff">

<p align="center"><center><table cellspacing="0" cellpadding="0" borde
+r="0" width="90%">
<tr>
<td valign="bottom" align="center" height="50">$error</td>
</tr>
</table></center>

<form name="upload" action="/cgi-bin/hi/multi.cgi" method="post" encty
+pe="multipart/form-data">
<input type="hidden" name="associate" value="$name">
<p align="center"><center><table cellpadding="3" cellspacing="1" borde
+r="0" width="600">
$multi
<tr>
<td valign="center" align="center"><input type="button" value="Exit Mu
+ltiple Uploads" class="text8pt" onClick="javascript:history.go(-1);">
+&nbsp;&nbsp;&nbsp;&nbsp;<input type="submit" value="Upload Graphics" 
+class="text8pt"></td>
</tr></form>
</table></center>
</body>
</html>
FORM
;
exit(0);
}

sub uploadMultiple {

my ($associate,$filenames,$descriptions) = @_;
# Associate default name with multiple graphics
my $counter = '0';
my ($fullname,$filename,@addendums,@matches,@fileArray,$add,$ext);
my @tempNames = split(/\|/,$filenames);
my @tempDesc = split(/\|/,$descriptions);
# Check addendum.txt for existing graphics related to this unique code
+.
open (ADDENDUM,"$addendumDir") || die ("Error opening $addendumDir for
+ reading:$!");
@addendums = <ADDENDUM>;
close (ADDENDUM);

if (scalar(@addendums) == '0') {
    $add = '000';
} else {
# Search through records for matches for this unique code.    
    for (@addendums) {
        my ($primary,$linked) = split(/\t/, $_);
        if ($primary == $associate) {
            push @matches, $linked;    
        }
    }
$add = (scalar(@matches) + 1);    
if (($add >= '1') && ($add < '10')) {
        $add = '00' . $add;
    } elsif (($add >= '10') && ($add < '99')) {
        $add = '0' . $add;
    }
}
my (@fullnames,@names,@capts);
    OUTER: foreach $fullname (@tempNames) {
        my $rec = {};
    INNER: if ($fullname eq "") {
        last OUTER;
        $counter++;
    } else {
        ($ext,$associate) = getFileName($fullname,$associate);
         $filename = $associate . "-" . $add . $ext;
        $rec->{filename} = $filename;
        $rec->{fullname} = $fullname;
        $rec->{description} = $tempDesc[$counter];
        push @fileArray, $rec;
        push @fullnames, $fullname;
        push @names, $filename;
        push @capts, $tempDesc[$counter];
    }
    $counter++;
    $add++;
     }
my $full = join("|",@fullnames);
my $name = join("|",@names);
my $capt = join("|",@capts);
uploadMultiFiles($full,$name,$capt,$associate);
}

sub uploadMultiFiles {

my ($paths,$newnames,$capts,$associate) = @_;
my @filehandles = split(/\|/,$paths);
my @filenames = split(/\|/,$newnames);
my @descriptions = split(/\|/,$capts);

for (my $i = 0; $i < scalar(@filehandles); $i++) {
my $data;
my $uploadInfo = $tempdir . "/" . $filenames[$i];

open(STORAGE, ">$uploadInfo") || die ("Error: $uploadInfo: $!\n");
binmode $filenames[$i];    # Not need for Unix machines because Unix h
+andles linefeeds properly, necessary on Windows machines
binmode(STORAGE);

my $size = '0';

while( read($filehandles[$i],$data,1024) ) {
print STORAGE $data;
$size += 1024;

#     if ($size > ($max_size * 1024)) {
#     close STORAGE;
#     unlink($uploadInfo);
#     $problem = "Image too Large";
#     $writeType = "Error Log";
#     writeLog($writeType,$problem);
#     uploadMultiple($problem,$associate);
#     exit(0);
#          }
    }
    close STORAGE;
    my $bytes_read = ($size/1024) . "Kb";
}
# multiLog($filename,$bytes);
# outputRecord($filehandle,$filename,$uploadInfo);
}

sub multiLog {

my ($file,$bytes) = @_;
open(LOGS, ">>$addendumDir") || die ("Error opening $addendumDir for w
+riting: $!");
print LOGS ("$file\t$bytes\n");
close(LOGS);

}

sub getFileName {

if($ENV{HTTP_USER_AGENT} =~ /win/i) {
    fileparse_set_fstype("MSDOS");
} elsif ($ENV{HTTP_USER_AGENT} =~ /mac/i) {
    fileparse_set_fstype("MacOS");
}
my ($fullname,$name) = @_;
my $fullname = basename($fullname);    
my $ext = substr($fullname,-4);

my @good_extensions = (".jpg",".jpeg",".jpe",".gif",".png");     # acc
+eptable file extensions for uploading
my $e;
my $extension;
my $test;

    OUTER: for (@good_extensions) {
        INNER: if ($ext eq $_) {
            $test = "passed";
            $extension = $_;
            last OUTER;
        }
    }

if ($test eq "failed") {
        $writeType = "Error Log";
        $problem = "Bad File Extension";
#        writeLog($writeType,$problem);
        uploadMulti($problem,$name);
        exit(0);
    } else {
        return ($extension,$name);    
    }
}

sub outputRecord {

print $cgi->header();
for (@_) {
    print $_;
    print "<br>";
    }
}
[download]

I have not completed this program, but the current code should upload each individual file. I am developing for a Unix environment incase anyone was wondering. I have been stuck with this part of the application for a day now and can't figure out why I can use $mime = uploadInfo($filehandles[$i]->{'Content-Type'} without getting an error saying I can't reference this hash?

I believe that the content type changes after the first attempt to upload a file occurs. I am not passing a content type back to the browser until all files are uploaded.

This script includes the parsed HTML form for uploading if (!defined(param('files'))). I am not sure if I missed anything else, but feel free to ask as many questions possible so I could have your best effort in helping me solve my programming problems.

Thanks,
Bionicle32

Edited by Chady -- minor formatting changes, removed font tags.

Comment on Multiple File upload script Download Code

Replies are listed 'Best First'.
Re: Multiple File upload script by andyf (Pilgrim) on May 26, 2004 at 14:16 UTC
That was quite an upsetting piece of code to read. I have some new white hairs today :) I can't pinpoint your exact problem, you need to get down and dirty with debug, and may I suggest our old friend print could be put to good effect. Just from a once over, here's a handful of pointers. Firstly I think your files are zero length because they are never in the POST in the first place. I don't see an <input type=file ... anywhere in the form, or I'm not seeing how you get the data in there. Upload Multiple and UploadMultiFiles are confusing use of two subs to do the job of one. You are passing parameters in a nasty way, flattening lists and then splitting them again to pass multiple parameters. Instead use a list, in the correct context a reference is automatically passed. There are some confusing constructs in there. Study the use of for and you will see that you can just say for(@array) without all those redundant indexes everywhere. I think the whole thing would benefit from using a hash to hold all the datums, the path, the file, the associate and the description as keys. Copy these from the cgi query hash. You should be able to reduce the whole tangled pit of misery to 20 lines or less. Your problem with uploadInfo is that the $filehandles list doesn't contain a valid hashref, or $i is out of range. Heres a few comments 10 require "settings.pl"; # where is this? 12 umask(000); # this is asking for trouble 28 my $image = param('uniquecode'); # poor security, good as + useless 37-48 my ($tempError,$error,$name); # you're using a sub + just to set a global 162 my ($paths,$newnames,$capts,$associate) = @_; # passing in a + flattened list and expanding it is silly 163 my @filehandles = split(/\\|/,$paths); # use list ref ins +tead and save loads of code 171 binmode $filenames[$i]; # operates on filehandle + not scalar [download] Best of luck Andy	[reply] [d/l]
Re: Re: Multiple File upload script by bionicle32 (Novice) on May 26, 2004 at 17:55 UTC
Andyf I have used the print statment within the uploadMutiFiles sub routine. I have all of the posted fullpaths from @filehandles as well as all of the posted captions from @descriptions. I removed the umask(000) from the script and can make a few adjustments to the code to accomodate the two variables being used from settings.pl. All they are is directory paths to a temporary directory and the housing directory if the file passes the uploaded byte test. I am sorry that the code is not the best you have seen, but we all get better over time. I could make the variables that I split global and that way they could be accessed by all subroutines. Is that what you were telling to do by using hashes? Any other comments would be useful. I will try to make some of those changes and let me know if you have further suggestions. Thanks, Shawn	[reply]
Re: Re: Re: Multiple File upload script by andyf (Pilgrim) on May 27, 2004 at 13:15 UTC
Shawn, If there is one thing you might take to heart I say it should be passing lists and hashes, a generaly more sophisticated way of going about things. No, I did not mean to suggest you use globals. The best analogy for functional programming is to imagine a production line with people all working a product that gets passed along. If you imagine each person is a suboutine/function then they get 'passed' some stuff, and they 'pass back/along' what they have done. What you are saying is... Bob, here's the spanner, Bob, heres the screwdriver, Bob, heres the hammer... Instead of just passing Bob the whole toolkit. If you pack all the items you want into a list, and pass the function a reference to that list, you effectively pass the whole bunch of stuff in one go. Of course the codes not bad, I jest. I've seen some _real_ horror in my time, if anything I see indications that you're a good coder limited by a few hangups. It's no worse than my perl code from not too long ago. Initially I thought you had not written the code yourself, and it was a cut n paste from a scripts site, but once I read it I realised you were struggling. I also see your background is in C, the move to Perl asks that you 'unlearn' some stuff. It's very forgiving too, and what looks syntactically nice to a C hacker is sometimes ugly in Perl. If you don't already have it I strongly recommend the Ram Book (cookbook), meshes perfectly with your level and need for practical snippets. have fun Andy	[reply]
Re: Multiple File upload script by iburrell (Chaplain) on May 26, 2004 at 18:51 UTC
First, when uploading multiple files with a single POST, you must have a separate file param for each file: `<input type="file" name="file1">` [download] Second, you get the remote filename with param. Then change this into the local filename. `my $filename = $cgi->param('file1');` [download] Third, you get the filehande with upload: `my $fh = $cgi->upload('file1');` [download] Fourth, get the uploaded Content-Type (has absolutely ntohing to do with the page's Content-Type) with uploadInfo `my $content_type = $cgi->uploadInfo($filename)->{'Content-Type'};` [download] I would suggest writing a function that handles a single file upload. And then call it multiple times for each file param in the form. `upload_file('file1'); upload_fiel('file2'); sub upload_file { my ($param_name) = @_;` [download]	[reply] [d/l] [select]