| Category: | Web Stuff |
| Author/Contact Info | /msg sulfericacid |
| Description: | http://sulfericacid.perlmonk.org/gallery/gallery.pl - See the gallery print in action! There are two scripts: image upload, image display. With these two files you can have yourself your very own image gallery! User uploads an image at a time and specifies some image information (such as title and description). The image display prints/displays 20 images per page (5x4) as thumbnails (100x100 with link that opens in new window. Under each image displays: file name, image title, image description, image height, image width. What I learned from this: You will need to go through both files and change all pertaining links to directories and paths as I left them in so you could see what format they had to be in. |
upload.pl
#!/usr/bin/perl -w
#
# IMAGES FOLDER MUST BE CHMOD TO 777 otherwise script fails
#
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.<br>";
print start_form(
-method => 'post',
-enctype => 'multipart/form-data'
),
table(
Tr(
td(""),
td("Please keep filenames, descriptions and titles short to
+ preserve a more uniformed appearance (under 20 chars)"),
),
Tr(
td("Image Title: "),
td(
textfield(
-name => 'title',
-size => 50,
-maxlength => 80
),
),
),
Tr(
td("Short Description: "),
td(
textfield(
-name => 'desc',
-size => 50,
-maxlength => 80
),
),
),
Tr(
td("File: "),
td(
filefield(
-name => 'upload',
-size => 50,
-maxlength => 80
),
),
),
Tr( td(), td( submit( 'button', 'submit' ), ) )
),
end_form(), hr;
if ( param() ) {
# take form data
my $remotefile = param('upload');
my $desc = param('desc');
$desc =~ s/::/\&\#58\;\&\#58\;/g; # remove semicolons
my $title = param('title');
$title =~ s/::/\&\#58\;\&\#58\;/g; # remove semicolons
my $category = param('category');
$category =~ s/::/\&\#58\;\&\#58\;/g; # remove semicolons
# make new variable to prevent overwriting of form data
my $filename = $remotefile;
# remove all directories in the file name path
$filename =~ s/^.*[\\\/]//;
$filename =~ s/::/\&\#58\;\&\#58\;/g; # remove semicolons
foreach (keys %upload) {
my ( $filename1, $title, $desc, $width, $height ) = split ( /::/, $upl
+oad{$_} );
if ($filename1 eq $filename) {
print qq(<font color="red">A file with that name already exists. Uplo
+ad aborted.</font>);
exit;
}
}
# full file path to upload directory (must include filename)
my $localfile = "/home/sulfericacid/public_html/gallery/images/$fi
+lename";
# full url to upload directory (cannot include filename or an end
+slash /)
my $url = "http://sulfericacid.perlmonk.org/gallery/images";
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: $!";
print "-----------------------------<br>";
print
qq(File was uploaded to <a href="$url\/$filename">$url\/$filename</a>)
+;
# 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";
}
# declaring the width and heighth of your image
my ( $w, $h ) = dim($info);
my $combo = join("::", $filename, $title, $desc $w, $h);
$upload{localtime()} = "$combo";
print "<br><br><br>";
print "Image code:<br>";
print
qq(<p style =\"background:url\($url\/$filename\)\;width:$w\;height:
+$h\;\">);
print "<br>-----------------------------<br>";
}
#####################################################
gallery.pl
#!/usr/bin/perl -w
use warnings;
use CGI qw/:standard/;
use POSIX;
use DB_File;
my %upload;
my $upload = "imagegallery.db";
# full file path to image directory
my $imagedir = "http://sulfericacid.perlmonk.org/gallery/images/";
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/gallery/galleryprint2.pl";
print qq(<a href="$url?page=$group">Page: $group</a>|\n);
}
|
|
Back to
Code Catacombs