in reply to Upload more than one file at a time

I have a difficult time believing that this code works, as it's clearly incomplete. What do you expect these lines to do, for example?

my @full_filename = ("", "", "");
my @upload_file = ($file1, $file2, $file3);
my $upload_file = param(@upload_file);
my $y=0;
foreach $upload_file(@upload_file)

[download]

I have no idea what's in $file1 et al, nor why you assign them to @upload_file, nor why you call param() once, then immediately overwrite its value by using it as a loop control variable.

It would be much easier to help you if you posted an example which actually demonstrated the behavior you describe (something that we could run on our own systems, for example), or at least gave us better clues as to what you expect to happen in various places.

Replies are listed 'Best First'.
Re^2: Upload more than one file at a time
by gmacfadden (Sexton) on Nov 22, 2006 at 21:20 UTC
    Sorry if i redacted too little of the code in the original problem definition...per your request here is the full script.

    Responding to your point regarding the regex, i swagged a blank into the expression in question after the @ sign...from appearances, it worked. 

    #! /usr/bin/perl -wT
use strict;    
use CGI qw(:standard escapeHTML);    
use CGI::Carp qw(warningsToBrowser fatalsToBrowser); 
my @field_list =
({ name => "object_to_be_uploaded1", label => "Name optional attachmen
+t #1" },
 { name => "object_to_be_uploaded2", label => "Name optional attachmen
+t #2" },
 { name => "object_to_be_uploaded3", label => "Name optional attachmen
+t #3" });

print header (),
start_html (-title => "Work Request Origination", -bgcolor => "orange"
+);
my $choice = lc (param ("choice"));    # get choice, lowercased
if ($choice eq "")            # initial script invocation
{ display_entry_form (); }
elsif ($choice eq "submit")
{ process_form (\@field_list); }
else
{ print p (escapeHTML ("Logic error, unknown choice: $choice")); }
print end_html ();
exit (0);

sub display_entry_form
{
my @row;       # define array
    print start_multipart_form (-action => url ()), 
            p ("<center><h2>Upload multiple files\n");
        push (@row, qq(<table border=3 bordercolor="blue" align="cente
+r" bgcolor="xffff00">) );
        push (@row, Tr (
   ( qq(<TD ALIGN="CENTER" VALIGN="TOP" BGCOLOR="yellow" COLSPAN="2">)
+, qq(Please provide the information requested in the table below to i
+nitiate a work request.))));
        push (@row, Tr (
   ( qq(<TD ALIGN="LEFT" VALIGN="TOP" COLSPAN="3">), 
     qq(Attachment #1 (Optional)),
     filefield (-name => "object_to_be_uploaded1",
                            -size => 60))));
        push (@row, Tr (
   ( qq(<TD ALIGN="LEFT" VALIGN="TOP" COLSPAN="3">), 
     qq(Attachment #2 (Optional)),
     filefield (-name => "object_to_be_uploaded2",
                            -size => 60))));
        push (@row, Tr (
   ( qq(<TD ALIGN="LEFT" VALIGN="TOP" COLSPAN="3">), 
     qq(Attachment #3 (Optional)),
     filefield (-name => "object_to_be_uploaded3",
                            -size => 60))));
    print table (@row),
            submit (-name => "choice", -value => "Submit"),
            end_form ();
}

sub process_form
{
my $field_ref1 = shift;     # reference to field-List
my $file1 = param("object_to_be_uploaded1");
my $file2 = param("object_to_be_uploaded2");
my $file3 = param("object_to_be_uploaded3");
my $upload_dir = "/home/yadayada/public_html/cgi-bin/upload_docs";
my ($base_filename, $untainted_filename);
my @full_filename = ("", "", "");
my @upload_file = ($file1, $file2, $file3);
my $upload_file = param(@upload_file);
my $y=0;
foreach $upload_file(@upload_file)
    {
     print "Uploading $upload_file.....<br>\n";
     if ($upload_file eq "")
          {}
     else
          {
           $base_filename = $upload_file;
           $base_filename =~ s/.*[\/\\](.*)/$1/;
           $untainted_filename = $base_filename;
           if ($base_filename =~ /^([-\@ :\/\\\w.]+)$/  )
               { $untainted_filename = $1; }
           else
               { die <<"EOT";
Unsuported characters in the filename "$base_filename".
Your filename may only contain alphabetic characters, numbers,
and the characters '_', '-', '\@', '/', '\\', and '.'
EOT
                }
           if ($untainted_filename =~ m/\.\./ )
                { die <<"EOT";
Your upload filename may not contain the sequence '..'
Rename your file so that it does not contain the sequence '..', and tr
+y again. 
EOT
                 }
           else {}

           @full_filename[$y] = $upload_dir . "/" . $untainted_filenam
+e;
           open (UPLOADFILE, ">@full_filename[$y]") || die ("Can't ope
+n (@full_filename[$y]): $!"); 
#                                  open $file_name using FILEHANDLE IN
+FILE
           binmode UPLOADFILE;       # allow FILEHANDLE read in binary
+ mode
           while ( <$upload_file> )
                 {
                  print UPLOADFILE;
                 }
           close (UPLOADFILE);          # close input file
          }
    $y++;
    }
      
print p ("Thank you. Your file(s) have been uploaded.\n");
}

    [download]
[reply]
[d/l]
      In redacting the script in "Re^2: Once is never enough" from its previous larger contextual script, I debugged the logic error.

      The only item now in need of further feedback is really the regex statement which i modifed to allow a blank as an allowed character in the file base_name:

      if ($base_filename =~ /^(-\@ :\/\\\w.+)$/ )

      Is this correct? I'm daunted by regex as they seem such complex expressions; if you can offer an online regex tutorial for dummies i would welcome. Thx.
[reply]

In Section Seekers of Perl Wisdom