####################################### GALLERY.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(<p style =\"background:url\($url\/$filename\)\;width:$w\;height: +$h\;\">); print "<br>"; }
#!/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); }
In reply to Image Gallery 1.8 by sulfericacid
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |