Re^7: Poorly written script

the script use to have the "use strict;" at the top of all the files, about 2 years ago when I moved the site to the dedicated server the hosting company (godaddy) told me I had to change it to "use Carp;" to work on thier systems.

use strict and use Carp are not mutually exclusive, they do not conflict with each other, you can have them both in the same script at the same time, and it would be a good idea to do so.

I admire any hosting operation that recommends using Carp. (Whether you also use the "fatals to browser" option is something you should be allowed to decide on your own, but normally you only use that during development, not in a "production" version). I cannot understand (and would hardly believe) that they would also insist on removing "use strict".

By the way, if they want you to use Carp, you should actually invoke its functions at suitable points in your script (i.e. where errors occur) -- just putting use Carp; at the top accomplishes nothing unless you actually call some of its functions.

I do believe it does keep those upto 4 image files in RAM for the next page to be completed.

You should probably study the manual for CGI more closely, and focus on the section that describes "CREATING A FILE UPLOAD FIELD". You should also check to see what version of CGI is being used by the host server -- your code may have been written for an older version of CGI (pre-2.47), because you include your own "upload()" function, but as of v2.47, there is an "upload()" function defined within CGI.pm (I'm looking at v3.33 that came with perl 5.8.8). Make sure you study the manual that goes with the version you are using.

I'm not personally familiar with file-upload operations in CGI, and I don't quite follow what your "upload" subroutine is doing (or whether the CGI built-in "upload()" is supposed to do the same thing), but it should not be the case that the image files being uploaded by your clients would all be memory resident while the script is running. The server should be storing the uploaded files to a temp directory, and your method of copying their contents to permanent files appears to be keeping the memory load to a minimum.

Still, you need to check the CGI manual very carefully about file uploads. (The inclusion of "use strict" has an important impact, too. Read about it.)

Problem is there isnt always four picture files, sometimes its 3, maybe 1,2 or even none. Doesnt your loop assume there is always going to be all four image files?

As suggested by the previous reply, this is not a problem. In fact, here's what I was thinking of when I made the suggestion about the loop -- this is a version of (most of) your code, with "use strict" put back in, a nod to "File::Basename" (which is handy for your case), and a pass through perltidy (though I have made some of my own adjustments to some of the indents, and fiddled with the arrangements of some of the print statements):

#!/usr/bin/perl

use strict;
use File::Basename;
use CGI qw/:standard/;

my %config;
$config{'header2'} = <<"EOF";

<HEAD>
<TITLE>$config{'sitename'} Item Listing Pages</TITLE>
</HEAD>
<FONT FACE=ARIAL><BODY TEXT=#000000 BGCOLOR=#FFFFFF LINK=#0000FF VLINK
+=#800080 ALINK=#FF0000>
<a href=/index.shtml><img border=0 src=/images/logo.gif></a><br><br><b
+r><br>

EOF

$|           = 1;
my @ext      = qw(jpeg jpg gif bmp);
my $match    = 0;
my $encoding = 'multipart/form-data';
my $q        = new CGI;

my ( $method, $action );  ### ??? these are used without anything bein
+g assigned

print "Content-type: text/html\n\n", $config{'header2'},
  "<div align=center><center>",
  "<table border=0 cellpadding=0 cellspacing=0 width=100% bordercolor=
+$config{'bordercolor'}>",
  "<tr><td width=100% bgcolor=$config{'colortablehead'} height=30>",
  "<b>&nbsp;Select your picture(s) to upload (@ext - $config{'imagesiz
+e'} kb maximum)</b></td></tr>",
  "</table></center></div><br>", $q->startform( $method, $action, $enc
+oding ), "<center>";

for ( 1..4 ) {
    print "<font face=arial size=2><b>Upload Charge $config{'currency'
+}$config{'textuploadcharge'} - Image $_: </b></font><br>",
      $q->filefield(
        -name      => "upload_file$_",
        -default   => 'starting value',
        -size      => 50,
        -maxlength => 180
      );
}
print $q->submit( -name => 'button_name', -value => 'Upload Image(s)' 
+),
  "</center>", $q->endform,
  "<hr width=80% size=1 color=$config{'bordercolor'}>",
  "<center><p><font face=arial size=2>Please click the \"Image Upload\
+" button only once,",
  "<br>Image Upload can take up to 5 seconds per image you upload.",
  "<br>Your images will appear below when finished.</font></center></p
+>",
  "<hr width=80% size=1 color=$config{'bordercolor'}>";

umask(000);    # UNIX file permission junk
mkdir( "$config{'imageuploaddir'}", 0777 )
  unless ( -d "$config{'imageuploaddir'}" );

my @uploadfiles;
for ( 1..4 ) {
    my $paramname = "upload_file$_";
    push @uploadfiles, $q->param( $paramname );
}
if ( $ENV{'CONTENT_LENGTH'} >= $config{'imagesize'} * 1024 ) {
    print
      "<p><div align=center><font face=arial size=2 color=FF0000><p>Er
+ror - The image file size is too large\!</font></p>\n",
      "<p><font face=arial size=2>Sorry but your upload image size can
+ not be over $config{'imagesize'}k.</font></p>\n",
      $q->end_html;
    exit 0;
}

my %uploads_done;
for my $upfile ( @uploadfiles ) {
    if ( defined $upfile ) {
        my $fstype = ( $upfile =~ /\\/ ) ? "MSWin32" : "Unix";
        fileparse_set_fstype( $fstype );
        my ( $fname, $path, $type ) = fileparse( $upfile, @ext );
        if ( $type ) {
            my $newimage = ( $config{'closedays2'} * 86400 + time );
            my $file  = "$newimage.$type";
            my $bytesread = undef;
            open( OUTFILE, ">$config{imageuploaddir}/$file" )
                or error("Cannot open $config{imageuploaddir}/$file: $
+!");
            binmode OUTFILE;
            while ( $bytesread = read( $upfile, my $buffer, 10240 )) {
                print OUTFILE $buffer;
            }
            close(OUTFILE);
            $uploads_done{$file} = $upfile;
            sleep 2;    # Wait 2 seconds
        }
        else {
            error(
"<center><font face=arial size=2><b>Image format not supported.</b><p>
+$upfile</p><b>Upload has failed.</b></font></center>"
            );
        }
    }
}
[download]

That is based on the version you posted, it compiles with strict and warnings enabled, and it covers everything except your "upload()" and "error()" subroutines. (Your "upload()" sub would undergo a similar amount of shortening by using a loop over the elements of the "%uploads_done" hash, which is populated in the "for" loop that I'm suggesting here.)

There are still likely to be problems -- the code you posted seems to be using bunch of different stuff in a "%config" hash even though you only assign one thing to that hash ($config{header}); there are a few other variables being used without anything being assigned to them ($method and $action -- but CGI probably provides sensible defaults for these). And assuming your "upload()" sub does something different from the CGI built-in "upload()", your sub should probably be given a different name. Also, the idea of using a template system of some sort would help.

Final summary: I'm still not sure any of this addresses your problem with memory consumption, unless you find something that needs fixing about your handling of the file uploads. You may still need to add some diagnostics to find out what's going on with the memory usage.

Comment on Re^7: Poorly written script Select or Download Code


P is for Practical
	PerlMonks