Shortening long and dirty code

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

This is the same SOPW I posted a few days ago but I finally got access to my server again so I tried writing the new script feature. I have an upload form which uploaded 1 file per page which I wanted to change so it could upload 4 files on the same page.

I successfully set it up so 4 files can be uploaded at a time but the script has become less managable and a nightmare to look at (from so much repetitive code). The script nearly quadroupled in size just for the last three uploades to be possible.

Can anyone take a few minutes and look through the mess below to see if there's a way to shorten it? The method I found easiest for me was to make each upload field in it's own if iteration but that meant I had to duplicate the same code three more times. Does anyone know of a way to have upload, upload2, upload3 and upload4 as form fields and do the required upload without so much clutter?

Thanks for your help.

#!/usr/bin/perl -w

open( STDERR, ">>/home/sulfericacid/public_html/test/error.log" )
  or die "Cannot open error log, weird...an error opening an error log
+: $!";

use warnings;
use CGI qw/:standard/;

use POSIX;

my $mode = 0755;

print header, start_html('upload form');

print "Upload formats allowed: jpg, gif, bmp.<br>";

print start_form(
    -method  => 'post',
    -enctype => 'multipart/form-data',
    -action=> ''
  ),
  table(
    Tr(
        td("File: "),
        td(
            filefield(
                -name      => 'upload',
                -size      => 50,
                -maxlength => 80
            ),
        ),
    ),
        Tr(
        td("File: "),
        td(
            filefield(
                -name      => 'upload2',
                -size      => 50,
                -maxlength => 80
            ),
        ),
    ),
            Tr(
        td("File: "),
        td(
            filefield(
                -name      => 'upload3',
                -size      => 50,
                -maxlength => 80
            ),
        ),
    ),
            Tr(
        td("File: "),
        td(
            filefield(
                -name      => 'upload4',
                -size      => 50,
                -maxlength => 80
            ),
        ),
    ),
    Tr( td(), td( submit( 'button', 'submit' ), ) )
  ),
  end_form(), hr;

print "By clicking Submit you are agreeing to any legal discreptancies
+ involved with the images you upload";
print " leaving the designer of this script or the webhost itself not 
+responsible.  You are agreeing these";
print " pictures are not copyright material, do not contain viruses an
+d does not promote sexual or violence";
print " activities.  It is a legal signature of awknowledgement once y
+ou click the Submit button.<br><br>";



if ( param('upload') ) {

    # take form data
    my $remotefile = param('upload');

    # make new variable to prevent overwriting of form data
    my $filename = $remotefile;

    # remove all directories in the file name path
    $filename =~ s/^.*[\\\/]//;

    # full file path to upload directory (must include filename)
    my $localfile = "/home/sulfericacid/public_html/amy/files/$filenam
+e";

    # full url to upload directory (cannot include filename or an end 
+slash /)
    my $url = "http://sulfericacid.perlmonk.org/amy/files";

    my $type = uploadInfo($remotefile)->{'Content-Type'};
    unless ( $type eq 'image/pjpeg' || $type eq 'image/gif' || $type e
+q 'image/bmp') {
        print "Wrong!  This is not a supported file type.";
        exit;
    }
# print "type: $type <br><br>";

    # open a new file and transfer bit by bit from what's in the buffe
+r
    open( SAVED, ">>$localfile" );    # || die $!;
    while ( $bytesread = read( $remotefile, $buffer, 1024 ) ) {
        print SAVED $buffer;
    }
    close SAVED;

    chmod $mode, "$localfile";        # or die "can't chmod: $!";

    # required since module was not preinstalled on server
    use lib "/home/sulfericacid/public_html/lib/";
    use Image::Info qw(image_info dim);
  
    # assigning info to a filename (better be an image)
    my $info =
      image_info("$localfile");
   # if for any reason we can't open the file, this error trap should 
+pick it up
    if ( my $error = $info->{error} ) {
        #die "Can't parse image info: $error\n";
    }
    # unommit next line if you want to use/post the image's color
    #my $color = $info->{color_type};

    # declaring the width and heighth of your image
    my ( $w, $h ) = dim($info);

    print "<br>";
    print "<b>File 1:</b><br>";
    print
qq(File was uploaded to <a href="$url\/$filename">$url\/$filename</a><
+br>);    
    print
qq(&lt;p style =\"background:url\($url\/$filename\)\;width:$w\;height:
+$h\;\"&gt;);
print "<br>";
}




if ( param('upload2') ) {

    # take form data
    my $remotefile = param('upload2');

    # make new variable to prevent overwriting of form data
    my $filename = $remotefile;

    # remove all directories in the file name path
    $filename =~ s/^.*[\\\/]//;

    # full file path to upload directory (must include filename)
    my $localfile = "/home/sulfericacid/public_html/amy/files/$filenam
+e";

    # full url to upload directory (cannot include filename or an end 
+slash /)
    my $url = "http://sulfericacid.perlmonk.org/amy/files";

    my $type = uploadInfo($remotefile)->{'Content-Type'};
    unless ( $type eq 'image/pjpeg' || $type eq 'image/gif' || $type e
+q 'image/bmp') {
        print "Wrong!  This is not a supported file type.";
        exit;
    }

    # open a new file and transfer bit by bit from what's in the buffe
+r
    open( SAVED, ">>$localfile" );    # || die $!;
    while ( $bytesread = read( $remotefile, $buffer, 1024 ) ) {
        print SAVED $buffer;
    }
    close SAVED;

    chmod $mode, "$localfile";        # or die "can't chmod: $!";

    # required since module was not preinstalled on server
    use lib "/home/sulfericacid/public_html/lib/";
    use Image::Info qw(image_info dim);
  
    # assigning info to a filename (better be an image)
    my $info =
      image_info("$localfile");
   # if for any reason we can't open the file, this error trap should 
+pick it up
    if ( my $error = $info->{error} ) {
        #die "Can't parse image info: $error\n";
    }
    # unommit next line if you want to use/post the image's color
    #my $color = $info->{color_type};

    # declaring the width and heighth of your image
    my ( $w, $h ) = dim($info);

    print "<br>";
    print "<b>File 2:</b><br>";
    print
qq(File was uploaded to <a href="$url\/$filename">$url\/$filename</a><
+br>);
    print
qq(&lt;p style =\"background:url\($url\/$filename\)\;width:$w\;height:
+$h\;\"&gt;);
print "<br>";
}



if ( param('upload3') ) {

    # take form data
    my $remotefile = param('upload3');

    # make new variable to prevent overwriting of form data
    my $filename = $remotefile;

    # remove all directories in the file name path
    $filename =~ s/^.*[\\\/]//;

    # full file path to upload directory (must include filename)
    my $localfile = "/home/sulfericacid/public_html/amy/files/$filenam
+e";

    # full url to upload directory (cannot include filename or an end 
+slash /)
    my $url = "http://sulfericacid.perlmonk.org/amy/files";

    my $type = uploadInfo($remotefile)->{'Content-Type'};
    unless ( $type eq 'image/pjpeg' || $type eq 'image/gif' || $type e
+q 'image/bmp') {
        print "Wrong!  This is not a supported file type.";
        exit;
    }
# print "type: $type <br><br>";

    # open a new file and transfer bit by bit from what's in the buffe
+r
    open( SAVED, ">>$localfile" );    # || die $!;
    while ( $bytesread = read( $remotefile, $buffer, 1024 ) ) {
        print SAVED $buffer;
    }
    close SAVED;

    chmod $mode, "$localfile";        # or die "can't chmod: $!";

    # required since module was not preinstalled on server
    use lib "/home/sulfericacid/public_html/lib/";
    use Image::Info qw(image_info dim);
  
    # assigning info to a filename (better be an image)
    my $info =
      image_info("$localfile");
   # if for any reason we can't open the file, this error trap should 
+pick it up
    if ( my $error = $info->{error} ) {
        #die "Can't parse image info: $error\n";
    }
    # unommit next line if you want to use/post the image's color
    #my $color = $info->{color_type};

    # declaring the width and heighth of your image
    my ( $w, $h ) = dim($info);

    print "<br>";
    print "<b>File 3:</b><br>";
    print
qq(File was uploaded to <a href="$url\/$filename">$url\/$filename</a><
+br>);
    print
qq(&lt;p style =\"background:url\($url\/$filename\)\;width:$w\;height:
+$h\;\"&gt;);
print "<br>";
}

if ( param('upload4') ) {

    # take form data
    my $remotefile = param('upload4');

    # make new variable to prevent overwriting of form data
    my $filename = $remotefile;

    # remove all directories in the file name path
    $filename =~ s/^.*[\\\/]//;

    # full file path to upload directory (must include filename)
    my $localfile = "/home/sulfericacid/public_html/amy/files/$filenam
+e";

    # full url to upload directory (cannot include filename or an end 
+slash /)
    my $url = "http://sulfericacid.perlmonk.org/amy/files";

    my $type = uploadInfo($remotefile)->{'Content-Type'};
    unless ( $type eq 'image/pjpeg' || $type eq 'image/gif' || $type e
+q 'image/bmp') {
        print "Wrong!  This is not a supported file type.";
        exit;
    }
# print "type: $type <br><br>";

    # open a new file and transfer bit by bit from what's in the buffe
+r
    open( SAVED, ">>$localfile" );    # || die $!;
    while ( $bytesread = read( $remotefile, $buffer, 1024 ) ) {
        print SAVED $buffer;
    }
    close SAVED;

    chmod $mode, "$localfile";        # or die "can't chmod: $!";

    # required since module was not preinstalled on server
    use lib "/home/sulfericacid/public_html/lib/";
    use Image::Info qw(image_info dim);
  
    # assigning info to a filename (better be an image)
    my $info =
      image_info("$localfile");
   # if for any reason we can't open the file, this error trap should 
+pick it up
    if ( my $error = $info->{error} ) {
        #die "Can't parse image info: $error\n";
    }
    # unommit next line if you want to use/post the image's color
    #my $color = $info->{color_type};

    # declaring the width and heighth of your image
    my ( $w, $h ) = dim($info);

    print "<br>";
    print "<b>File 4:</b><br>";
    print
qq(File was uploaded to <a href="$url\/$filename">$url\/$filename</a><
+br>);
    print
qq(&lt;p style =\"background:url\($url\/$filename\)\;width:$w\;height:
+$h\;\"&gt;);
print "<br>";
}
[download]

"Age is nothing more than an inaccurate number bestowed upon us at birth as just another means for others to judge and classify us"

sulfericacid _{janitored by ybiC: balanced <readmore> tags}

Comment on Shortening long and dirty code Download Code

Replies are listed 'Best First'.
Re: Shortening long and dirty code by chromatic (Archbishop) on Sep 04, 2003 at 20:24 UTC
My preferred technique is to pull out duplicate (or nearly-duplicate) code into functions. Take this: `Tr( td("File: "), td( filefield( -name => 'upload', -size => 50, -maxlength => 80 ), ), ), Tr( td("File: "), td( filefield( -name => 'upload2', -size => 50, -maxlength => 80 ), ), ),` [download] It continues for two more fields, but I'm too lazy to paste that much code. The only difference is the `name` field, so it's easy to turn into a function: `sub upload_field { my $name = shift; return Tr( td("File: "), td( filefield( -name => $name, -size => 50, -maxlength => 80 ), ), ); }` [download] That turns your table into something like this: `print start_form( -method => 'post', -enctype => 'multipart/form-data', -action=> '' ), table( ( map { upload_field( "upload$_" ) } ( '', 1 .. 3 ) ), Tr( td(), td( submit( 'button', 'submit' ), ) ) ), end_form(), hr;` [download] The same goes for processing upload fields. Remember to ask the question what's similar and what's different?	[reply] [d/l] [select]
Re: Shortening long and dirty code by hardburn (Abbot) on Sep 04, 2003 at 20:14 UTC
Incorperate the processing of the uploaded file into a subroutine. The subroutine will be passed the result from `param('upload' . $n)`, where `$n` is the number of the upload field. ---- I wanted to explore how Perl's closures can be manipulated, and ended up creating an object system by accident. -- Schemer Note: All code is untested, unless otherwise stated	[reply] [d/l] [select]
Re: Re: Shortening long and dirty code by sulfericacid (Deacon) on Sep 04, 2003 at 20:19 UTC
I have very little experience with subroutines in general but I think you're right, that would be the easiest way to go about doing this. Do you mean I should keep my if statements and instead of posting the same code in the iteration instead just call the same subroutine for each of them? Thanks! "Age is nothing more than an inaccurate number bestowed upon us at birth as just another means for others to judge and classify us" sulfericacid	[reply]
Re: Re: Re: Shortening long and dirty code by hardburn (Abbot) on Sep 04, 2003 at 20:22 UTC
No need to keep the `if`s. Do it in a loop: `foreach my $i (1 .. 4) { call_sub( param("upload$i") ); }` [download] The code in the subroutine would basically be what is now in your `if` statements. ---- I wanted to explore how Perl's closures can be manipulated, and ended up creating an object system by accident. -- Schemer Note: All code is untested, unless otherwise stated	[reply] [d/l] [select]
Re: Shortening long and dirty code by CukiMnstr (Deacon) on Sep 04, 2003 at 20:44 UTC
maybe you don't want to have your script relying on external modules, but I'm going to mention this anyway: try using a templating system, such as HTML::Template. Your code will be much cleaner, and having your perl code and your html separated is a Good Thing (at least in my book). There are a couple of tutorials here in the monastery that will get you started: this one by jeffa and another one by Ovid. hope this helps,	[reply]
Re: Re: Shortening long and dirty code by rob_au (Abbot) on Sep 05, 2003 at 02:19 UTC
... and also take a look at CGI::Application for the dispatch mechanism which it provides that would offer a much more discrete and modular separation of execution elements. Even if the CGI::Application is not deployed within the final application, much of the structure and layout of the script provided for review could be better addressed using some of the techniques employed within this module. (I have also posted a review on the CGI::Application module previously on this site here). `perl -le "print+unpack'N',pack'B32','00000000000000000000001010000010'"`	[reply]