#!/usr/bin/perl
# #############################################################################
#
# Author: Vulcho Nedelchev <kumcho@vulcho.com>
#
# Version: 1.2
#
# Latest versions will be available at:
# http://www.vulcho.com/perl/kumcho_vulcho_gallery/
#
# Todo:
# Optimize speed of execution time with .gallery index file. This will be
# added in some of next versions soon.
#
# Bugs:
# 25.06.2004 - Fixed bug of listing. Missing file sindrom :)
#
# Note:
# If You use this script please drop me a line.
#
# History:
# v1.0 - all files was listed in one page
# v1.1 - fixed missing file sindorm bug
#
# Usage:
# 1. Put all images in one directory and place this script there;
#
# 2. Setup your web server to read this script as default file in this
# direcotry. Just like setting up index.php, index.html, index.pl,
# index.cgi or wahterver You want. Reaname the script if directoryIndex
# file is using different name;
#
# 3. Place yours header and footer files in this directory;
#
# 4. If You want to place template images in working script directory, You
# must add its images in the banned HASH in subroutine banned() or place
# it in new directory;
#
# 5. Don't forget to make this script executable perms must be 755 and the
# script must be able to write in working directory.
#
# #############################################################################
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use strict;
use DirHandle;
my $q = new CGI;
my $VERSION = 'v1.2';
my $PAGE = $q->param('page') || 1;
my $HEADER = my_header();
my $FOOTER = my_footer();
my @IMAGES = images();
my $TOTAL_IMAGES = scalar(@IMAGES);
my $PAGES = pages(scalar(@IMAGES));
my $MENU = navigation();
my $BODY = body();
my $COPYRIGHT = copyright();
$PAGE = $PAGE !~ /^\d+$/ ? 1 : $PAGE;
sub copyright {
return "<p><font size=1><b>Vulcho's Gallery, $VERSION, coded in Perl</b></font></p>\n";
}
sub main {
print $q->header;
print $HEADER;
print "<b>You are now watching page# $PAGE;</b><br>\n";
print "<b>Images are $TOTAL_IMAGES placed in $PAGES pages;</b><br><br>\n";
print $BODY;
print "<HR size=\"1px\" style=\"color:#35332C\">\n";
print "<center>$MENU $COPYRIGHT</center>\n";
print $FOOTER;
}
sub body {
my @img = @IMAGES;
my @page_images = splice(@img, ((($PAGE-1)*20 > 0) ? (($PAGE-1)*20) : 0), 20);
my $i = 1;
my $body;
$body.="<table cellspacing=5 cellpadding=5 border=0>";
while (scalar(@page_images)) {
my @arr = splice @page_images, 0, 4;
map { $_ = $q->a({-href=>"$_", -title=>$_, -target=>'_blank'}, $q->img({src=>"thumb_$_", border=>0, title=>"Name: $_\nSize: ".size($_)." Bytes"})."\n" ) } @arr;
$body.=$q->Tr( $q->td({-valign=>'top'}, \@arr) );
}
$body.= "<table>\n";
return $body;
}
sub navigation {
my $menu;
my $script = $ENV{SCRIPT_NAME};
for (1..$PAGES) {
if ($PAGE == $_) {
$menu .= " [$_] ";
} else {
$menu .= " " . $q->a({-href=>"$script?page=$_"}, $_) . " ";
}
}
$menu.="<br>\n";
if ($PAGE>1) {
$menu.=$q->a({-href=>"$script?page=".($PAGE-1)}, '<<BACKWARD')." ";
}else{
$menu.=' <<BACKWARD ';
}
$menu.=' ' . $q->a({-href=>"$script?page=1"}, 'START') . ' ';
if ($PAGE < $PAGES) {
$menu.=" ".$q->a({-href=>"$script?page=".($PAGE+1)}, 'FORWARD>>');
}else{
$menu.=' FORWARD>> ';
}
return $menu;
}
sub pages {
my $files = shift;
return(($files%20)?(int($files/20)+1):($files/20));
}
sub my_footer {
return file('footer.tmpl');
}
sub my_header {
return file('header.tmpl');
}
sub file {
open FF, $_[0] or die "Cannot read file $_[0]";
my @data = <FF>;
close FF;
return join '', @data;
}
sub images {
my $d = new DirHandle ".";
my @files;
if (defined $d) {
while (defined($_ = $d->read)) {
next unless m/\.png|\.gif|\.jpg|\.jpeg/i;
next if m/^thumb_/i;
next if banned($_);
thumb($_);
push @files, $_;
}
undef $d;
}
#sort @files;
return(sort(@files));
}
sub thumb {
my $image = shift;
make_thumb($image) unless (-f "thumb_$image");
}
sub make_thumb {
eval{system("/usr/bin/convert", "-resize", '100x100', $_[0], "thumb_$_[0]") };
die "$@ kurec" if $@;
}
sub banned {
my %banned=(
'blank.gif' => 1,
'spacer.gif' => 1,
'_logo.gif' => 1,
'_logo.jpg' => 1,
'_logo.png' => 1,
'_logo.jpeg' => 1,
);
return exists $banned{ lc($_[0]) } ? 1 : undef;
}
sub size {
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = stat($_[0]);
return $size;
}
main();
exit;