#save it as index.cgi somewhere, chmod 0755
#!/usr/bin/perl
use strict;
use Cwd;
##########################################################
# GD Library
#my $il='G'; # comment if you are using ImageMagick instead
#use GD; # comment if you are using ImageMagick instead
##########################################################
# ImageMagick
my $il='I'; # comment if you are using GD library instead
use Image::Magick; # comment if using GD Library instead
BEGIN {
$|=1; use CGI::Carp('fatalsToBrowser');
}
=pod
INDEXGALLERY
Leo Charre
for help etc leo@leocharre.com
make sure to chmod 0755
Requires:
- Image Magick
for more info, view readme.txt
=cut
# MAIN USER DEFINED VARS #
#how many to show per page
my $perpage=10;
# HOW DO YOU WANT THUMBS MADE
my $restrict_type='square';
# both restrict to height and width :both won't go over this..
# width restrict to width
# height restrict to height
# square square - will crop sides or top and bottom to fit. neat.
my $restriction=50; #pixels to restrict by.
my $quality=85; #quality of thumbnails
# if you want to change this later on, you must delete all your .thumbnail files first
# DEVEL #
# how many thumbs to make per page. Others will say "reload to see thumbnail". By default it is the same
# as how many to show per page. This is restricted to 50.
my $make=$perpage;
# uncomment to custom select how many to make at a time
#my $make=10;
my $DEBUG_on=0; # set to 1 to see output.
# #
# ugly hack to keep idiots from blowing up someobody's server
if ($make>50) {$make = 50;} # some kind of control. Please no comments :/
# useful for devel
my $DEBUG;
my $PAGENOW; #present set of img/
my $q=$ENV{'QUERY_STRING'}; #get query string (everything after url?
if ($q=~m/p=(\d+)/){
$PAGENOW=$1; #strip any extra shit (could be in archive)
} else {$PAGENOW=1;}
# accept debug from query string, uncomment to allow
if ($q=~m/debug=1/){
$DEBUG_on=1;
}
my $pwd = cwd;
my $docroot= $ENV{'DOCUMENT_ROOT'};
my $d; #where in htdocs, public_html, etc we will work
my $d=0; #if we are navigating subdir ???
if ($q=~m/d=([^=&]+)/){
$d=$1;
} else {
$d = $pwd;
$d=~ s/^$docroot//; # (example : now /home/user/web/dir is /dir )
}
if ($DEBUG_on) { $DEBUG.=" - d is $d -\n"; }
#start subnavigation
# this allows navigation back and forth if there are multiple directories
# where this script resides (sets), this is in regard to where we are now
my $CURRENT_GALLERY_DIRECTORY;
#warning, stupid hack follows..
#if this is installed in /stuff/gallery , we don't want to go up a directory..
my $sd=$pwd; #where script is
$sd=~s/^.*\///; #take out everything but gallery (in aforementioned case)
# now sd contains the name of the dir in which this cript resides, only that, no slashes
my $f=$d;
$f=~s/^(.*)\/$sd/$sd/; # now we have gallery (or gallery/setthis )
my $prepend=$1;
#end stupid hack
my @p=split('/',$f);
my $path;
foreach (@p){
$path.="/$_";
$CURRENT_GALLERY_DIRECTORY.=qq{$_ : };
}
#end subnavigation
#see what we have here..
# let's look inside and find our images to work with, and or optional sub dirs
my @imgs; my @subdirs;
opendir(DIR,$docroot.$d);
while ($_=readdir(DIR)){
if ($_=~m/\.jpg$|\.jpeg$|\.gif$/i && !($_=~m/^\.thumbnail_/)){
if ($DEBUG_on){ $DEBUG.=" matched $_ --\n"; }
push(@imgs,$_);
} elsif (-d "$docroot$d/$_" && $_ ne '.' && $_ ne '..') {
if ($DEBUG_on){ $DEBUG.=" sub dir found $_ --\n"; }
push(@subdirs,$_);
}
}
#create paging if images found
my $PAGING;
my $imgs_total = 0;
$imgs_total=scalar(@imgs);
my $control=$imgs_total;
my $img_start;
my $OUTPUT; #this will contain thumbnails etc.
if ($imgs_total){ #if imgs present
#paging
if ($control>$perpage){
my $p=1;
while ( ( $control > 0) ){
$PAGING.=qq{[ Pg $p ] };
$p++;
$control=($control - $perpage);
}
}
$img_start=(($PAGENOW*$perpage)-($perpage-1)); #what img to start with
if ($DEBUG_on){
$DEBUG.="- imgs_total: $imgs_total
perpage= $perpage
img_start= $img_start
pagenow= $PAGENOW";
}
#START OUTPUT
my $which= ($img_start-1);
my $control=0; #might be one instead
until ( $perpage == $control || $which>$imgs_total){
$_=$imgs[$which];
my $name=$_; $name=~s/\.\w+$//;$name=~s/_|-/ /g;
if (!-f "$docroot/$d/.thumbnail_$_"){ #check if thumb exists
if ($make){
if ($il eq 'GD'){
make_thumbnail_GD("$docroot/$d/$_","$docroot/$d/.thumbnail_$_",
$restriction,$restrict_type,$quality);
} else {
make_thumbnail_IM("$docroot/$d/$_","$docroot/$d/.thumbnail_$_",
$restriction,$restrict_type,$quality);
}
$OUTPUT.=qq{
$name $which};
$make--;
} else {
$OUTPUT.=qq{
(Reload for Thumb)
$name $which};
}
} else {
$OUTPUT.=qq{
$name $which};
}
$which++;
$control++;
if ($which == $imgs_total ){ last;}
}
} else {
$OUTPUT= q{No images present in this directory.};
}
# create sub dir navigation if dirs found
my $dirs_total = 0;
$dirs_total=scalar(@subdirs);
my $SUBNAVIGATION;
if ($dirs_total){ #if dirs present
$SUBNAVIGATION='Other Sets here:
';
foreach ( @subdirs ){
$SUBNAVIGATION.=qq{[ Set $_ ]
\n };
}
if ($DEBUG_on) {
$DEBUG.="\n- subdirs_total: $dirs_total\n";
}
}
#get template, check that css file is there...
my $html = &htmlcheck(); #will create if nonexistant, also will get html source - this is so people can edit it.
&csscheck(); #will create if nonexistant- so people can edit it.
#see if there are includes
$html=~s//slurp($docroot.$1)/eg;
# make replacements in template read
$html=~s/{PAGING}/$PAGING/;
$html=~s/{PAGENOW}/$PAGENOW/;
$html=~s/{SUBNAVIGATION}/$SUBNAVIGATION/;
$html=~s/{OUTPUT}/$OUTPUT/;
$html=~s/{CURRENT_GALLERY_DIRECTORY}/$CURRENT_GALLERY_DIRECTORY/;
$html=~s/{DEBUG}/$DEBUG/; #obviously if debug was not on, this replaces with nothing.
print qq{Content-type: text/html\n\n$html};
exit;
sub make_thumbnail_GD{
# receives:
# file source (absolute path on machine)
# file target out (absolute path on machine)
# restriction
# restriction type
# quality
my ($src,$out,$restriction,$restrict_type,$quality)=@_;
# both restrict to height and width :both won't go over this..
# width restrict to width
# height restrict to height
# square square - will crop sides or top and bottom to fit. neat.
my $img = GD::Image->newFromJpeg($src);
my ($w,$h) = $img->getBounds(); # find dimensions
#if width is bigger then height, we use restrict to w
if ($restrict_type eq 'both'){
if ($w>$h){
$restrict_type='width';
} else {
$restrict_type='height';
}
}
my $newh; my $neww; # initialize new dimensions # not used if 'square'
if ($restrict_type eq 'height') {
$neww=(($w*$restriction)/$h);
$newh=$restriction;
}
if ($restrict_type eq 'width') {
$newh=(($h*$restriction)/$w);
$neww=$restriction;
}
if ($restrict_type ne 'square'){
my $newimg = new GD::Image($neww,$newh);
$newimg->copyResized($img,0,0,0,0,$neww,$newh,$w,$h);
open(FILE, "> $out") || die;
print FILE $newimg->jpeg;
} else {
#square
my ($cut,$xcut,$ycut);
if ($w>$h){
$cut=$h;
$xcut=(($w-$h)/2);
$ycut=0;
}
if ($w<$h){
$cut=$w;
$xcut=0;
$ycut=(($h-$w)/2);
}
my $newimg = new GD::Image($restriction,$restriction);
$newimg->copyResized($img,0,0,$xcut,$ycut,$restriction,$restriction,$cut,$cut);
open(FILE, "> $out") || die;
print FILE $newimg->jpeg;
}
}
sub make_thumbnail_IM{
# receives:
# file source (absolute path on machine)
# file target out (absolute path on machine)
# restriction
# restriction type
# quality
my ($src,$out,$restriction,$restrict_type,$quality)=@_;
# both restrict to height and width :both won't go over this..
# width restrict to width
# height restrict to height
# square square - will crop sides or top and bottom to fit. neat.
my $img = Image::Magick->new; #blank
$img->Read($src); #read source file into blank
my ($w,$h) = $img->Get('width','height'); # find dimensions
# # #
#if width is bigger then height, we use restrict to w
if ($restrict_type eq 'both'){
if ($w>$h){
$restrict_type='width';
} else {
$restrict_type='height';
}
}
my $newh; my $neww; # initialize new dimensions # not used if 'square'
if ($restrict_type eq 'height') {
$neww=(($w*$restriction)/$h);
$img->Resize(width=>$neww, height=>$restriction);
}
if ($restrict_type eq 'width') {
$newh=(($h*$restriction)/$w);
$img->Resize(width=>$restriction, height=>$newh);
}
if ($restrict_type eq 'square'){
#
my ($cut,$xcut,$ycut);
if ($w>$h){
$cut=$h;
$xcut=(($w-$h)/2);
$ycut=0;
}
if ($w<$h){
$cut=$w;
$xcut=0;
$ycut=(($h-$w)/2);
}
$img->Crop(width=>$cut,height=>$cut,x=>$xcut,y=>$ycut);
$img->Resize(width=>$restriction, height=>$restriction);
#
}
$img->Set(quality=>$quality);
$img->Write($out);
undef $img;
}
sub htmlcheck {
my $html=slurp("$pwd/indexgallery_template.html");
unless ($html){
$html=q|