| 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:
*More aquainted with CGI, specifically CGI tables |
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(<p style =\"background:url\($url\/$filename\)\;width:$w\;height:
+$h\;\">);
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 |