Category: CGI
Author/Contact Info /msg sulfericacid
Description: Image uploader/gallery. Upload images via your website to make an elegant (and easy!) image gallery with thumbnails and everything! It's not true thumbnails yet, but it's the best I could do.

New updates:
Removed ascii code exploit/bug
Allow 4 files uploaded at a time instead of just one

What I've learned

*More aquainted with CGI, specifically CGI tables
*To use localtime as a hash key for multiple uploads, you better use sleep or you may lose all your information! *sigh*
*How to pass values into a subroutine and used my first real subroutine in this script

Upload.pl
#!/usr/bin/perl -w

use CGI::Carp qw(fatalsToBrowser);

use warnings;
use CGI qw/:standard/;

use POSIX;

use DB_File;

my %upload;
my $upload = "imagegallery.db";

tie %upload, "DB_File", "$upload", O_CREAT|O_RDWR, 0644, $DB_BTREE
    or die "Cannot open file 'upload': $!\n";

my $mode = 0755;

print header, start_html('upload form');

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

print start_form(
    -method  => 'post',
    -enctype => 'multipart/form-data',
    -action=> ''
  ),
  table({-border=>1, -width=>600, -bgcolor=>'D3D3D3', cellpadding=>0, 
+cellspacing=>0},
       Tr(
        td({bgcolor => '000080'}, '<center><b><font color=white>IMAGE 
+1</b></font></center>'),
        td({bgcolor => '000080'}, '<center><b><font color=white>IMAGE 
+2</b></font></center>'), 
    Tr(
        td("Title: "),
        td("Title: "),

    Tr(
                td(
            textfield(
                -name        =>  'title1',
                -size        =>  50,
                -maxlength    =>  80
            ),
                td(
            textfield(
                -name        =>  'title2',
                -size        =>  50,
                -maxlength    =>  80
            ),
    
     Tr(
        td("Description: "),
        td("Description: "),  
       
        Tr(
                td(
            textfield(
                -name        =>  'desc1',
                -size        =>  50,
                -maxlength    =>  80
            ),
                td(
            textfield(
                -name        =>  'desc2',
                -size        =>  50,
                -maxlength    =>  80
            ),

     Tr(
        td("Upload: "),
        td("Upload: "), 
        Tr( 
        td(
            filefield(
                -name      => 'upload1',
                -size      => 50,
                -maxlength => 80
            ),
        td(
            filefield(
                -name      => 'upload2',
                -size      => 50,
                -maxlength => 80
            ),


               Tr(
        td({bgcolor => '000080'}, '<center><b><font color=white>IMAGE 
+3</b></font></center>'),
        td({bgcolor => '000080'}, '<center><b><font color=white>IMAGE 
+4</b></font></center>'), 
            
       Tr(
        td("Title: "),
        td("Title: "),         
    
    Tr(
    td(
            textfield(
                -name        =>  'title3',
                -size        =>  50,
                -maxlength    =>  80
            ),
                td(
            textfield(
                -name        =>  'title4',
                -size        =>  50,
                -maxlength    =>  80
            ),
   
     Tr(
        td("Description: "),
        td("Description: "),  
       
        Tr(
                td(
            textfield(
                -name        =>  'desc3',
                -size        =>  50,
                -maxlength    =>  80
            ),
                td(
            textfield(
                -name        =>  'desc4',
                -size        =>  50,
                -maxlength    =>  80
            ),
     Tr(
        td("Upload: "),
        td("Upload: "),  
        Tr(
        td(
            filefield(
                -name      => 'upload3',
                -size      => 50,
                -maxlength => 80
            ),
        td(
            filefield(
                -name      => 'upload4',
                -size      => 50,
                -maxlength => 80
            ),

   
   
    Tr( td(), td( submit( 'button', 'submit' ), ) )
  ),
  ),
  ),
  ),
  ),
  ),
  ),
  ),
  ),
  ),
  ),
  ),
  ),
  ),
  ),
  ),
  ),  
  ),
  ),  
  ),
  ),  
  ),
  ),
  ),
  ),  
  ),
  ),

  end_form(), 
  hr;

if ( param('upload1') ) {

my $num = 1;

&dirty_work($num);

}

if ( param('upload2') ) {

my $num = 2;

&dirty_work($num);
}

if ( param('upload3') ) {

my $num = 3;

&dirty_work($num);
}

if ( param('upload4') ) {

my $num = 4;
&dirty_work($num);
}







sub dirty_work {
my $num = shift;
    # take form data
    my $remotefile = param("upload$num");
# make new variable to prevent overwriting of form data
    my $filename = $remotefile;
    
    my $title = param("title$num");
    $title =~ s/&/&\#38/g;
    my $desc = param("desc$num");
    $desc =~ s/&/&\#38/g;
    # 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/playground/upload/
+files/$filename";

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

    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: $!";

    # requi 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);

my $combo = join("::", $filename, $title, $desc, $w, $h);
$upload{localtime()} = "$combo";
sleep 2;



    print "<br>";
    print "<b>File:</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>";
}
####################################### GALLERY.pl
#!/usr/bin/perl -w

use warnings;
use CGI qw/:standard/;
use CGI::Carp qw(fatalsToBrowser);

use POSIX;

use DB_File;

my %upload;
my $upload = "imagegallery.db";

# full file path to image directory
my $imagedir = "http://sulfericacid.perlmonk.org/playground/upload/fil
+es/";

tie %upload, "DB_File", "$upload", O_CREAT | O_RDWR, 0644, $DB_BTREE
  or die "Cannot open file 'upload': $!\n";

print header, start_html('My Image Gallery');

my $page = url_param('page');
$page ||= 1; # if no url_param exists, make it 1

my $first = ($page - 1) * 20;
my $last  = $first + 19;

print "<table>\n";

my $counter = 0;

for (grep defined($_), (reverse keys %upload)[$first .. $last]) {

    my ( $filename, $title, $desc, $width, $height ) = split ( /::/, $
+upload{$_} );
    print " <tr>" unless ( $counter % 5 );

$title    =~ s/(\S{11})/$1 /g;
$desc     =~ s/(\S{11})/$1 /g;





    print qq(<td valign="top" width="120" height="120">),
          qq[<A HREF="javascript:window.open('$imagedir/$filename', 
'','toolbar=no width=$width height=$height scrolling=yes'); void('');"
+>],
          qq[<img src="$imagedir/$filename" height="100" width="100"><
+/a><br>];
$filename =~ s/(\S{11})/$1 /g;          
    print qq(<b><font size=2>Filename:</b>$filename<br></font>),
          qq(<b><font size=2>Title:</b>$title<br></font>),
          qq(<b><font size=2>Desc:</b>$desc<br></font>),
          qq(<b><font size=2>Dimens:</b> $width x $height<br></font>),
          qq(</td>);
    unless ( ++$counter % 5 ) {
        print "</tr>\n";
    }
}
print "</table>";

my @keys  = sort keys %upload;
my $group = 0;

while (my @group = splice(@keys, 0, 20)) {

  $group++;


my $url = "http://sulfericacid.perlmonk.org/playground/upload/newuploa
+d.pl";
  print qq(<a href="$url?page=$group">Page: $group</a>|\n);

}
Replies are listed 'Best First'.
Re: Image Gallery 1.8
by Anonymous Monk on Sep 06, 2003 at 07:54 UTC
    What about credit? (how many monks helped you bang out this script? you need to acknowledge every single one)