codekasten/imageindex

2996 lines
85 KiB
Perl
Executable File

#!/usr/bin/perl -w
#
## this versions hasa some minor changes by age@systemausfall.org
#
# Edwin Huffstutler <edwinh@computer.org>
# John Reynolds <johnjen@reynoldsnet.org>
#
# perl script for: web page index/thumbnails of photos.
# orginally started life as a menu selector for fvwm2 backgrounds...
#
# USAGE:
#
# imageindex [options] <directory>
#
# <directory> is assumed to be "." if not given
#
# Options: (can be abbreviated if unique)
#
# -title <string> title for this page (saved for susbsequent runs)
# -destdir <dir> export image/html tree to dir (will be created if needed)
# -[no]recurse enable/disable recursion into subdirectories
# -[no]medium enable/disable medium size images/links
# -[no]slide enable/disable slideshow files
# -[no]detail enable/disable detail file
# -[no]dirs enable/disable directory entries
# -[no]montage enable/disable directory montages
# -forceregen force regeneration of thumbnails
# -columns <num> number of columns in html table (saved for susbsequent runs)
# -exclude <file> Exclude <file> from processing. Can be used multiple times
# -includeall Nullifies excluded file list (saved from previous run)
# -skipmont <file> Exclude <file> from being included in a directory montage.
# -reverse Order timestamps with newest first
# -x <num> override thumbnail x size
# -y <num> override thumbnail y size
# -help show this text
# -version show the current version
# -d 'var=val' force override of global variable
#
# See also the configuration section at the top of the program itself,
# or in ~/.imageindexrc
#
# (non-html-generating, utility options)
#
# -lowercase Lowercase all image files in a directory
# -caption <file> <string> Store comment in image
# -rotate <file> [cw|ccw] Rotate an image clockwise or counterclockwise
# -showexcluded Show which files were excluded in a prior run
#
######################################################################
#
# Configuration options
#
# sizes / dirs
$thumbnail_dir = 'thumbnail';
$default_thumbnail_x = 200;
$default_thumbnail_y = 200;
# If both dimensions of the original are within this much of the thumb
# dimensions we will skip the thumbnail and just use the original
$thumbnail_threshold = 1.0;
$med_x = 512;
$med_y = 384;
$med_dir = 'medium';
# If both dimensions of the original are within this much of the "medium"
# dimensions we will skip creating the medium-size format and just use the
# original
$med_threshold = 1.6;
# Enable/disable features, set default for various flags
$do_recurse = 0; # Recurse into subdirs?
$do_medium = 1; # Generate medium-format?
$do_slide = 1; # Generate slides/frame view?
$do_detail = 1; # Generate details page?
$do_dirs = 1; # Create directory entries?
$do_montage = 1; # Create directory montages?
$do_emoticons = 1; # Replace ASCII smiley's with images?
$do_reverse = 0; # Sort timestamps in reverse order?
# What the various image links point to - can be 'index', 'fullsize',
# 'medium', 'thumbnail', 'slide', or 'details'
$index_linkto = 'slide';
$details_linkto = 'index';
$slide_linkto = 'fullsize';
# Default number of columns to use
$default_columns = 3;
# Orientation of slide frame - 'horizontal' or 'vertical'
$frame_orient = 'vertical';
# Location of items in slide pages; 'top', 'bottom', or 'none'
$slide_caption = 'top';
$slide_date = 'bottom';
# Details index uses thumbs reduced by this amount
$detailshrink = 2;
# Quality for generated images
$thumb_quality = 50;
$med_quality = 80;
# Minimum and maximum number of tiles in directory montage images
$montage_min = 4;
$montage_max = 36;
# Space between montage images
$montage_whitespace = 2;
# What to do with leftover montage tiles; can be
# 'blank' or 'repeat'
$montage_fill = 'blank';
# Stylesheet specs
# Set element font, etc. properties here
$stylesheet = '
body { color: black; background: white; }
/* Fonts in the title */
h1.title { font-family: "Comic Sans MS",Helvetica,sans-serif; font-size: 200%; font-weight: bold; text-align: center; }
h2.daterange { font-family: Arial,Helvetica,sans-serif; font-size: 125%; text-align: center; }
h3 { font-family: Arial,Helvetica,sans-serif; font-size: 90%; text-align: center; }
/* Photo captions & Directory titles */
div.caption { font-family: Arial,Helvetica,sans-serif; font-size: 100%; font-weight: bold; margin: 1em; }
/* Overall fonts on the index and details page */
div.index { font-family: Arial,Helvetica,sans-serif; font-size: 80%; }
div.detail { font-family: Arial,Helvetica,sans-serif; font-size: 80%; }
div.credits { font-family: Arial,Helvetica,sans-serif; font-size: 80%; text-align: right; margin: 10px }
/* Table attributes */
table.index { background: #ffffff; border: none; border-spacing: 8px; }
td.index { border: none; padding: 3px }
table.frame { background: #ffffff; border: none }
td.frame { border: none; padding: 0px }
/* Image attributes */
img.index { border: none; }
img.slide { border: none; }
img.frame { border: none; }
/* Link attributes */
a:link { color: blue; }
a:visited { color: green; }
a:hover { color: red; }
a:active { color: red; }
';
# Text
$emptycell = "<I>empty</I>";
$updirtext = "up one directory";
$framelinktext = "slideshow view (frames)";
$detaillinktext = "details index";
$indexlinktext = "main index";
$default_titletext = "Image directory";
# These five variables control the TITLE attribute on anchor constructs in the
# index and frame views. When TITLE attributes are given they are usually
# rendered as "tooltip" bubbles that show text when a cursor hovers and stops
# over the active link. We use them here to give a visual cue about the image.
# These variables work much like printf(1) strings.
#
# %f => replaced with the filename of the image
# %d => replaced with the date/time of the image (or mtime of the file)
# %s => replaced with the size of the file (in Kb)
# %r => replaced with the resolution (XxY) of the original image
# %c => replaced with the image's caption (if stored with one)
# %% => replaced with a literal '%' character
#
# The following are used when directories are processed and a montage of
# that directory is used as the thumbnail of the dir.
#
# %n => replaced with number of images in a directory
# %b => replaced with the "begin" date from a directory of images
# %e => replaced with the "end" date from a directory of images
# %t => replaced with the "title" from a directory of images
#
# Other characters (including spaces) are literal. "undef" these in
# your ~/.imageindexrc file if you don't want them to show up. The "date/time"
# related constructs are interpolated using the date/time format variables
# defined below.
#
$framethumbtitle = "%f - %d";
$indexthumbtitle = "%f (%s)";
$slidethumbtitle = "%f (%s)";
$detailthumbtitle = "%c";
$montagetitle = "%n images %b through %e";
# Date/Time format strings. These strings are formatted much like the above
# variables and the definitions of the escape sequences come from the POSIX
# strftime(3) definitions. NOT ALL of strftime(3) are supported for obvious
# reasons.
#
# %S is replaced by the second as a decimal number (00-60).
# %M is replaced by the minute as a decimal number (00-59).
# %I is replaced by the hour (12-hour clock) as a decimal number (01-12).
# %H is replaced by the hour (24-hour clock) as a decimal number (00-23).
# %p is replaced by national representation of either "ante meridiem" or
# "post meridiem" as appropriate (currently only U.S. "am" or "pm")
# %R is equivalent to "%H:%M" (in *timeformat variables only).
# %r is equivalent to "%I:%M:%S %p" (in *timeformat variables only).
#
# %Y is replaced by the year with century as a decimal number.
# %y is replaced by the year without century as a decimal number (00-99).
# %m is replaced by the month as a decimal number (01-12).
# %d is replaced by the day of the month as a decimal number (01-31).
# %F is equivalent to "%Y-%m-%d" (in *dateformat variables only).
# %D is equivalent to "%m/%d/%y" (in *dateformat variables only).
# %% is replaced by a literal "%".
$framedateformat = "%m/%d/%Y";
$frametimeformat = "%r";
$indexdateformat = "%m/%d/%Y";
$indextimeformat = "%r";
$slidedateformat = "%m/%d/%Y";
$slidetimeformat = "%r";
$detaildateformat = "%m/%d/%Y";
$detailtimeformat = "%I:%M %p";
# Pathnames
$indexfile = 'index.html';
$detailfile = 'details.html';
$framefile = 'frame.html';
$slidefile = 'slides.html';
$slide_dir = 'slides';
$stylefile = 'style.css';
$montagefile = 'montage.jpg';
$emoticonprefix = 'ii_';
$emoticonsmile = $emoticonprefix . 'smile.png';
$emoticonwink = $emoticonprefix . 'wink.png';
$emoticonfrown = $emoticonprefix . 'frown.png';
# File exclusion customization (regex)
# (Anything non-image and non-dir will be skipped automatically, this just
# makes it silent)
@exclude = qw(
^CVS$
^.nautilus-metafile.xml$
^.thumbnails$
^.xvpics$
^.thumbcache$
^ALBUM.OFA$
^desktop.ini$
);
# Metatags
$columnsmetatag = 'Columns';
$titlemetatag = 'Title';
$begindatemetatag = 'DateBegin';
$enddatemetatag = 'DateEnd';
$excludemetatag = 'ExcludedFiles';
$skipmetatag = 'SkipMontageFiles';
$numimagesmetatag = 'NumImages';
$reversemetatag = 'Reverse';
$thumbxmetatag = 'ThumbnailX';
$thumbymetatag = 'ThumbnailY';
# Any of the above can be overridden in an rc file in the user's home dir
$rcfile = "$ENV{'HOME'}/.imageindexrc";
######################################################################
#
# $Id: imageindex,v 1.164 2003/12/30 23:12:00 jjreynold Exp $
#
# imageindex is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# imageindex is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with imageindex; see the file COPYING.
#
######################################################################
use Image::Magick; # comes with ImageMagick
# from CPAN - optional
eval('use Image::Info qw(image_info)');
# Shipped with perl
use POSIX;
use Getopt::Long;
use FileHandle;
use File::Basename;
use File::Copy;
use English;
use Carp;
require 'flush.pl';
# to shut up -w
use vars qw($opt_recurse);
use vars qw($opt_slide);
use vars qw($opt_dirs);
use vars qw($opt_detail);
use vars qw($opt_lowercase);
use vars qw($opt_help);
use vars qw($opt_debug);
use vars qw($opt_showexcluded);
use vars qw($opt_version);
&GetOptions(
'title=s',
'columns=i',
'x=i',
'y=i',
'forceregen',
'medium!',
'slide!',
'detail!',
'dirs!',
'montage!',
'recurse!',
'destdir=s',
'lowercase',
'caption=s',
'rotate=s',
'exclude=s@',
'skipmont=s@',
'showexcluded',
'includeall',
'version',
'help',
'debug',
'reverse!',
'd=s%'
) or die ("Invalid flag\n");
# Find out which platform we're on so we don't give incorrect options to needed
# commands
#
$uname = `uname -s`;
chomp ($uname);
# Override config variables
foreach my $var (keys %opt_d) {
$value = $opt_d{$var};
print "(override) $var = $value\n";
eval("\$$var=\"$value\"");
}
&init_png_array();
# Read RC file
if (-e $rcfile) {
print "Using settings in $rcfile...\n" if ! defined ($opt_version);
require $rcfile;
}
# Rotate or caption image (then exit)
if (defined ($opt_rotate)) {
&rotate_image($opt_rotate,\@ARGV);
exit (0);
} elsif (defined ($opt_caption)) {
&caption_image($opt_caption,\@ARGV);
exit (0);
} elsif (defined ($opt_showexcluded)) {
&showexcluded($ARGV[0]);
exit (0);
} elsif (defined ($opt_version)) {
printf ("imageindex version: %s\n", &versionstring);
exit (0);
}
# The directory to search is the first argument
if (defined($ARGV[0])) {
$srcdir = $ARGV[0];
$srcdir =~ s:/$::;
} else {
$srcdir = ".";
}
# Give usage message
if (defined($opt_help)) {
&usage();
exit(0);
}
# Show backtrace if debug given
if (defined($opt_debug)) {
$SIG{__WARN__} = \&Carp::cluck;
}
# Where to generate files
$destdir = $srcdir;
if (defined($opt_destdir)) {
$destdir = $opt_destdir;
$destdir =~ s:/$::;
print "Exporting to $destdir\n";
unless (-d $destdir) {
printf ("Creating destination directory '$destdir'.\n");
mkdir ($destdir, 0755);
}
}
unless (-w $destdir) {
printf ("No write permission for $destdir\n");
exit (1);
}
if (defined($opt_medium)) {
$do_medium = $opt_medium
}
if (defined($opt_slide)) {
$do_slide = $opt_slide;
}
if (defined($opt_detail)) {
$do_detail = $opt_detail;
}
if (defined($opt_dirs)) {
$do_dirs = $opt_dirs;
}
if (defined($opt_montage)) {
$do_montage = $opt_montage;
}
if (defined($opt_recurse)) {
$do_recurse = $opt_recurse;
}
# no montages if we aren't doing dirs anyway
if ($do_dirs == 0) {
$do_montage = 0;
}
&initialize_current_vars();
&read_stored_meta_data();
&override_by_commandline();
if (!defined(&image_info)) {
print "Image::Info not found, not extracting EXIF data\n";
}
opendir(DIR, "$srcdir") || die "Can't open dir $srcdir: ($!)\n";
@files = readdir DIR;
closedir(DIR);
@files = grep (!/^\.?\.$/, @files);
# Skip the files/dirs we use or generate. Any other patterns go in the
# config section (@exclude) or in exclude file
my @generated_files = ($thumbnail_dir, $med_dir, $slide_dir,
$indexfile, $detailfile, $stylefile,
);
foreach my $pattern (@generated_files, @exclude) {
@files = grep (!/$pattern/, @files);
}
@files = &exclude_files(@files);
# Change all the names of image files to lowercase.
if (defined ($opt_lowercase)) {
&lower_case_files(@files);
exit (0);
}
# Keep track of which column to be in
my $col_counter = 1;
# Count how many files we create
my $object_counter = 0;
my $dir_counter = 0;
my $image_counter = 0;
my $thumbnail_counter = 0;
my $med_counter = 0;
my $slide_counter = 0;
my $modified_thumb = 0;
# Keep track of max thumb sizes to use for slide frame width
my $max_thumb_x = 0;
my $max_thumb_y = 0;
# Keep track of max thumb sizes to use for montage creation
my $max_mont_thumb_x = 0;
my $max_mont_thumb_y = 0;
# Extract info
print "Extracting image info";
flush (STDOUT);
foreach my $file (@files) {
# If directory, grab the timestamp
if (-d "$srcdir/$file") {
my $ts;
# Grab timestamp from meta tag
if (-e "$srcdir/$file/$indexfile") {
my $begin = &extract_meta_tag($begindatemetatag,"$srcdir/$file/$indexfile");
if (defined($begin)) {
if (!defined($firstdate) or ($begin < $firstdate)) {
$firstdate = $begin;
}
$ts = $begin;
}
my $end = &extract_meta_tag($enddatemetatag,"$srcdir/$file/$indexfile");
if (defined($end)) {
if (!defined($lastdate) or ($end > $lastdate)) {
$lastdate = $end;
}
$ts = $end if (!defined($ts));
}
}
# Fallback on dir mtime
if (!defined($ts)) {
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = stat("$srcdir/$file");
$ts = POSIX::strftime ("%Y%m%d%H%M.%S",localtime($mtime));
}
push(@{$dir_timestamp{$ts}}, $file);
} else {
# Collect info from the image
&fill_image_info($file);
}
}
print "\n";
# Do dirs first
if ($do_dirs) {
foreach my $ts (sort bynumber keys %dir_timestamp) {
foreach my $dir (sort @{$dir_timestamp{$ts}}) {
&dir_entry($dir);
} # foreach dir that has this timestamp
} # foreach timestamp
}
# Bail if nothing here
if ($object_counter == 0) {
print "Nothing to do!\n";
unlink("$destdir/$indexfile") if (-e "$destdir/$indexfile");
unlink("$destdir/$detailfile") if (-e "$destdir/$detailfile");
unlink("$destdir/$stylefile") if (-e "$destdir/$stylefile");
exit(0);
}
# Make thumb dirs if needed
foreach my $checkdir ($thumbnail_dir, $med_dir, $slide_dir) {
unless (-d "$destdir/$checkdir") {
mkdir("$destdir/$checkdir",0777);
}
}
# Nuke old thumbnails if original image gone
&nuke_out_of_date();
# Iterate over the files based on timestamp
# This is just to get back/forward links
undef $prev;
foreach (sort bynumber keys %timestamp) {
foreach my $pathname (sort @{$timestamp{$_}}) {
if (defined($prev)) {
my ($name,$path,$suffix);
($name,$path,$suffix) = fileparse($prev,'\.\S+');
$back{$pathname} = "$name.html";
($name,$path,$suffix) = fileparse($pathname,'\.\S+');
$forward{$prev} = "$name.html";
}
$prev = $pathname;
} # foreach image that has this timestamp
} # foreach timestamp
# Iterate over the files based on timestamp
# This will do the real work
foreach (sort bynumber keys %timestamp) {
foreach my $pathname (sort @{$timestamp{$_}}) {
my $filename = $info{$pathname}{'file'};
my $thumbnail = $info{$pathname}{'thumb'};
my $medium = $info{$pathname}{'medium'};
my $slide = $info{$pathname}{'slide'};
if (!defined($firstdate) or ($info{$pathname}{'date'} < $firstdate)) {
$firstdate = $info{$pathname}{'date'};
}
if (!defined($lastdate) or ($info{$pathname}{'date'} > $lastdate)) {
$lastdate = $info{$pathname}{'date'};
}
#
# First, deal with medium format of the image since we can save time shrinking
# the medium down to the thumbnail rather than fullsize->thumbnail
#
# Skip if we want no medium images at all
#
if ($do_medium == 0) {
$skipmedium{$pathname} = 1;
unlink("$destdir/$medium") if (-e "$destdir/$medium");
} elsif (($info{$pathname}{'x'} <= ($med_x * $med_threshold)) and
($info{$pathname}{'y'} <= ($med_y * $med_threshold))) {
# Skip if we are below the threshold size
$skipmedium{$pathname} = 1;
unlink("$destdir/$medium") if (-e "$destdir/$medium");
} else {
my $image = new Image::Magick;
my $retval;
# Create medium sized pic if it is not there,
# or is out of date with respect to original image
if ((! -e "$destdir/$medium") or
( -M $pathname < -M "$destdir/$medium") or
defined($opt_forceregen)) {
my $newgeom = $med_x . "x" . $med_y;
print "Creating $destdir/$medium\n";
$retval = $image->Read(filename=>$pathname);
warn "$retval" if "$retval";
$retval = $image->Resize(geometry=>$newgeom);
warn "$retval" if "$retval";
$retval = $image->Set(interlace=>Line);
warn "$retval" if "$retval";
$retval = $image->Set(quality=>$med_quality);
warn "$retval" if "$retval";
$retval = $image->Write(filename=>"$destdir/$medium");
warn "$retval" if "$retval";
$image_cache{$pathname} = $image;
} else {
# Up to date, existing medium, grab dimensions
# Get the right hsize/vsize tags for the medium slides. Simply do a "Read" of
# the file here and the code below will set the med_x/y properties.
#
$retval = $image->Read("$destdir/$medium");
warn "$retval" if "$retval";
}
$info{$pathname}{'med_size'} = &convert_to_kb($image->Get('filesize'));
$info{$pathname}{'med_x'} = $image->Get('width');
$info{$pathname}{'med_y'} = $image->Get('height');
$med_counter++;
}
#
# Next, deal with the thumbnail for this image. If we have just created a medium
# version of the image, then an open image "handle" will exist for it. We simply
# shrink that down to thumbnail size (if appropriate) rather than reading in the
# original file again just to shrink it (saves processing time).
#
# Skip thumb if we are below the threshold size
if (($info{$pathname}{'x'} <= ($current_thumbnail_x * $thumbnail_threshold)) and
($info{$pathname}{'y'} <= ($current_thumbnail_y * $thumbnail_threshold))) {
$info{$pathname}{'thumb_x'} = $info{$pathname}{'x'};
$info{$pathname}{'thumb_y'} = $info{$pathname}{'y'};
$skipthumb{$pathname} = 1;
if (-e "$destdir/$thumbnail") {
unlink("$destdir/$thumbnail");
$modified_thumb++;
}
push(@montagefiles,"$destdir/$filename");
} else {
my $image = new Image::Magick;
my $retval;
# Create thumbnail if it is not there,
# or is out of date with respect to original image
if ((! -e "$destdir/$thumbnail") or
( -M $pathname < -M "$destdir/$thumbnail") or
defined($opt_forceregen)) {
my $newgeom = $current_thumbnail_x . "x" . $current_thumbnail_y;
print "Creating $destdir/$thumbnail\n";
if (defined ($image_cache{$pathname})) {
$image = $image_cache{$pathname};
$retval = $image->Resize(geometry=>$newgeom);
warn "$retval" if "$retval";
$retval = $image->Set(quality=>$thumb_quality);
warn "$retval" if "$retval";
$retval = $image->Write(filename=>"$destdir/$thumbnail");
warn "$retval" if "$retval";
}
else {
$retval = $image->Read(filename=>$pathname);
warn "$retval" if "$retval";
$retval = $image->Resize(geometry=>$newgeom);
warn "$retval" if "$retval";
$retval = $image->Set(interlace=>Line);
warn "$retval" if "$retval";
$retval = $image->Set(quality=>$thumb_quality);
warn "$retval" if "$retval";
$retval = $image->Write(filename=>"$destdir/$thumbnail");
warn "$retval" if "$retval";
}
push(@montagefiles,"$destdir/$thumbnail");
$modified_thumb++;
} else {
# Up to date, existing thumb
# Get the right hsize/vsize tags for the inline thumbs. Simply do a "Read" of
# the file here and the code below will set the thumb_x/y properties.
#
$retval = $image->Read("$destdir/$thumbnail");
warn "$retval" if "$retval";
push(@montagefiles,"$destdir/$thumbnail");
}
$info{$pathname}{'thumb_size'} = &convert_to_kb($image->Get('filesize'));
$info{$pathname}{'thumb_x'} = $image->Get('width');
$info{$pathname}{'thumb_y'} = $image->Get('height');
$thumbnail_counter++;
}
# Set the max thumb sizes, to be used for slide frame width
if ($info{$pathname}{'thumb_x'} > $max_thumb_x) {
$max_thumb_x = $info{$pathname}{'thumb_x'};
}
if ($info{$pathname}{'thumb_y'} > $max_thumb_y) {
$max_thumb_y = $info{$pathname}{'thumb_y'};
}
# Set the max montage thumb sizes, to be used when creating montage images
#
$bn = basename ($thumbnail);
unless (defined ($skipmont{$bn})) {
if ($info{$pathname}{'thumb_x'} > $max_mont_thumb_x) {
$max_mont_thumb_x = $info{$pathname}{'thumb_x'};
}
if ($info{$pathname}{'thumb_y'} > $max_mont_thumb_y) {
$max_mont_thumb_y = $info{$pathname}{'thumb_y'};
}
}
#
# Finally, create html for this image
#
&image_entry($pathname);
} # foreach image that has this timestamp
} # foreach timestamp
# Finish up the columns if needed
if (($col_counter != 1) and
($col_counter <= $current_columns) and
($object_counter > $current_columns)) {
foreach ($col_counter..$current_columns) {
push(@index, " <TD CLASS=\"index\" VALIGN=\"middle\" ALIGN=\"center\">$emptycell</TD>\n");
push(@details, " <TD CLASS=\"index\" VALIGN=\"middle\" ALIGN=\"center\">$emptycell</TD>\n");
}
push(@index, " </TR>\n");
push(@details, " </TR>\n");
}
# Nuke generated dirs if no contents
system("rm -rf $destdir/$thumbnail_dir") if ($thumbnail_counter == 0);
system("rm -rf $destdir/$slide_dir") if ($slide_counter == 0);
system("rm -rf $destdir/$med_dir") if ($med_counter == 0);
# Create montage if we had more than just dir entries here
if (($dir_counter != $object_counter)) {
&create_montage(@montagefiles);
}
# Create stylesheet
&write_css();
# Write index web page
open(INDEX,">$destdir/$indexfile") or die ("Can't open $destdir/$indexfile: $!\n");
&page_header('index', $index_linkto);
foreach (@index) {
print INDEX;
}
&page_footer('index');
close(INDEX);
# Write photo details file
if ($do_detail == 1) {
open(INDEX,">$destdir/$detailfile") or die ("Can't open $destdir/$indexfile: $!\n");
&page_header('detail', $details_linkto);
foreach (@details) {
print INDEX;
}
&page_footer('detail');
close(INDEX);
} else {
unlink("$destdir/$detailfile") if (-e "$destdir/$detailfile");
}
# Write slide/frame files
if (($do_slide == 1) and ($slide_counter > 1)) {
&write_frameset();
} else {
system("rm -rf $destdir/$slide_dir") if (-d "$destdir/$slide_dir");
}
# Optionally export images somewhere else
if ($opt_destdir) {
printf ("Copying image files from '$srcdir' to '$destdir'.\n");
foreach my $image (keys %info) {
# BSD's default 'cp' cannot preserve links like GNU fileutils cp can
#
if ($uname =~ /BSD/) {
system("cp -pv $image $destdir");
}
else {
system("cp -dpuv $image $destdir");
}
}
}
if (defined ($do_emoticons) && $do_emoticons) {
foreach $icon ('wink', 'smile', 'frown') {
if ($emoticon{$icon}) {
&write_emoticon_png ($icon);
} else {
unlink ($destdir . '/' . $thumbnail_dir . "/$emoticonprefix${icon}.png");
}
}
}
######################################################################
#
# Write the various HTML parts for this image
#
######################################################################
sub image_entry {
my $pathname = shift(@_);
my $filename = $info{$pathname}{'file'};
my $link;
&index_html($pathname);
if ($do_detail == 1) {
&details_html($pathname);
}
if (($do_slide == 1) and ($image_counter > 1)) {
&slide_html($pathname);
} else {
my $file = $info{$pathname}{slide};
unlink($file) if (-e $file);
}
# Increment for next time
$col_counter++;
$col_counter = 1 if ($col_counter > $current_columns);
}
###############################################################################
#
# Generate HTML for index page entry
#
###############################################################################
sub index_html {
my $pathname = shift(@_);
my $filename = $info{$pathname}{'file'};
my $link;
my $anchortext;
# At beginning of row?
if ($col_counter == 1) {
push(@index, " <TR>\n");
}
# Image
push(@index, " <TD CLASS=\"index\" VALIGN=\"middle\" ALIGN=\"center\">\n");
push(@index, " <DIV CLASS=\"index\">");
push(@index, &format_date($info{$pathname}{'date'}, 'index'));
push(@index,"</DIV>\n");
if (($index_linkto eq 'details') and ($do_detail == 1)) {
$link = "$detailfile#$filename";
} elsif (($index_linkto eq 'medium') and !defined($skipmedium{$pathname})) {
$link = $info{$pathname}{'medium'};
} elsif (($index_linkto eq 'thumbnail') and !defined($skipthumb{$pathname})) {
$link = $info{$pathname}{'thumb'};
} elsif (($index_linkto eq 'slide') and ($do_slide == 1) and ($image_counter > 1)) {
$link = $info{$pathname}{'slide'};
} else {
$link = $filename;
}
$anchortext = " <A HREF=\"$link\" ";
if (defined ($indexthumbtitle) && $indexthumbtitle ne '') {
my ($str);
$str = &interpolate_title_string ($indexthumbtitle, $pathname, 'index');
if ($str ne '') {
$anchortext .= sprintf ("TITLE=\"%s\" ", $str);
}
}
$anchortext .= "NAME=\"$filename\">";
push(@index, $anchortext);
if (defined($skipthumb{$pathname})) {
push(@index,"<IMG SRC=\"$filename\"");
} else {
push(@index,"<IMG SRC=\"$info{$pathname}{thumb}\"");
}
push(@index," WIDTH=\"$info{$pathname}{thumb_x}\" HEIGHT=\"$info{$pathname}{thumb_y}\"");
push(@index," ALT=\" $filename \"");
push(@index," CLASS=\"index\"");
push(@index,"></A>\n");
push(@index, " <DIV CLASS=\"index\">");
# Full size link
push(@index,"<A HREF=\"$filename\">full size</A>");
# Medium size link if within the threshold
unless (defined($skipmedium{$pathname})) {
push(@index,"&nbsp;|&nbsp;<A HREF=\"$info{$pathname}{medium}\">medium</A>");
}
# Detail list link
if ($do_detail == 1) {
push(@index,"&nbsp;|&nbsp;<A HREF=\"$detailfile#$filename\">details</A>");
}
push(@index,"</DIV>\n");
# Caption if any (jpeg comment field)
if (defined($info{$pathname}{'comment'})) {
my ($tmp);
push(@index, " <DIV CLASS=\"caption\">");
# Hack: if a comment has an ellipsis at the very end, make the HTML use a
# non-breakable space before it so that the ellipsis doesn't "wrap" inside
# the table field. It just looks better for those cases where the comment
# is just long enough to wrap when rendered in the space given
#
$tmp = $info{$pathname}{'comment'};
$tmp = &htmlize_caption ($tmp);
if ($tmp =~ /(\s+)\.\.\.\s*$/) {
$tmp =~ s/(\s+)\.\.\.\s*$/&nbsp;.../;
}
push(@index, $tmp);
push(@index,"</DIV>\n");
}
push(@index, " </TD>\n\n");
# At end of row?
if ($col_counter == $current_columns) {
push(@index, " </TR>\n");
}
}
###############################################################################
#
# Generate HTML for slide/frame pages
#
###############################################################################
sub slide_html {
my $pathname = shift(@_);
my $filename = $info{$pathname}{'file'};
my $link;
my $anchortext;
#
# First the index frame info
#
if ($frame_orient eq 'horizontal') {
push(@frame," <TD CLASS=\"frame\" ALIGN=\"center\" VALIGN=\"middle\">\n");
} else {
push(@frame," <TR>\n <TD CLASS=\"frame\" ALIGN=\"center\" VALIGN=\"middle\">\n");
}
$anchortext = " <A HREF=\"../$info{$pathname}{slide}\" ";
if (defined ($framethumbtitle) && $framethumbtitle ne '') {
my ($str);
$str = &interpolate_title_string ($framethumbtitle, $pathname, 'frame');
if ($str ne '') {
$anchortext .= sprintf ("TITLE=\"%s\" ", $str);
}
}
$anchortext .= "TARGET=\"view\">";
push(@frame, $anchortext);
if (defined($skipthumb{$pathname})) {
push(@frame,"<IMG SRC=\"../$filename\"");
} else {
push(@frame,"<IMG SRC=\"../$info{$pathname}{thumb}\"");
}
push(@frame," WIDTH=\"$info{$pathname}{thumb_x}\" HEIGHT=\"$info{$pathname}{thumb_y}\"");
push(@frame," ALT=\" $filename \"");
push(@frame," CLASS=\"frame\"");
push(@frame,"></A>\n");
if ($frame_orient eq 'horizontal') {
push(@frame," </TD>");
} else {
push(@frame," </TD>\n </TR>");
}
push(@frame,"\n");
#
# Then the individual slides
#
my $slide = new FileHandle "> $destdir/$info{$pathname}{slide}";
if (!defined($slide)) {
die("$destdir/$info{$pathname}{slide}: $!");
}
select($slide);
print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\"\n";
print "\"http://www.w3.org/TR/html401/strict.dtd\">\n";
print "<HTML>\n";
print "<HEAD>\n";
$verstring = &versionstring();
printf ("<META NAME=\"GENERATOR\" CONTENT=\"imageindex %s\">\n", $verstring);
printf ("<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=ISO-8859-1\">\n");
print "<TITLE>$current_titletext - $filename</TITLE>\n";
print "<LINK TYPE=\"text/css\" REL=\"stylesheet\" HREF=\"../$stylefile\">\n";
print "</HEAD>\n<BODY>\n";
&next_prev_links($pathname);
# Caption if any
if (($slide_caption eq 'top') and defined($info{$pathname}{'comment'})) {
print "<DIV CLASS=\"caption\">";
my $tmp = &htmlize_caption ($info{$pathname}{'comment'}, 'slide');
print $tmp;
print "</DIV>\n";
}
# Date, filename
if ($slide_date eq 'top') {
print "<DIV CLASS=\"index\">";
print &format_date($info{$pathname}{'date'}, 'slide');
print " $filename";
print "</DIV>\n";
}
if ($slide_linkto eq 'index') {
$link = "../$indexfile#$filename";
} elsif (($slide_linkto eq 'details') and ($do_detail == 1)) {
$link = "../$detailfile#$filename";
} elsif (($slide_linkto eq 'medium') and !defined($skipmedium{$pathname})) {
$link = "../$info{$pathname}{medium}";
} elsif (($slide_linkto eq 'thumbnail') and !defined($skipthumb{$pathname})) {
$link = "../$info{$pathname}{thumb}";
} else {
$link = "../$filename";
}
print "\n<P>\n";
$anchortext = "<A HREF=\"$link\"";
if (defined ($slidethumbtitle) && $slidethumbtitle ne '') {
my ($str);
$str = &interpolate_title_string ($slidethumbtitle, $pathname, 'slide');
if ($str ne '') {
$anchortext .= sprintf (" TITLE=\"%s\"", $str);
}
}
$anchortext .= ">";
print $anchortext;
if (defined($skipmedium{$pathname})) {
print "<IMG SRC=\"../$filename\"";
print " WIDTH=\"$info{$pathname}{x}\" HEIGHT=\"$info{$pathname}{y}\"";
} else {
print "<IMG SRC=\"../$info{$pathname}{medium}\"";
print " WIDTH=\"$info{$pathname}{med_x}\" HEIGHT=\"$info{$pathname}{med_y}\"";
}
print " ALT=\" $filename \"";
print " CLASS=\"slide\">";
print "</A>\n";
print "</P>\n";
# Caption if any
if (($slide_caption eq 'bottom') and defined($info{$pathname}{'comment'})) {
print "<DIV CLASS=\"caption\">";
my $tmp = &htmlize_caption ($info{$pathname}{'comment'}, 'slide');
print $tmp;
print "</DIV>\n";
}
# Date, filename
if ($slide_date eq 'bottom') {
print "<DIV CLASS=\"index\">";
print &format_date($info{$pathname}{'date'}, 'slide');
print " $filename";
print "</DIV>\n";
}
&next_prev_links($pathname);
print "</BODY>\n</HTML>\n";
select(STDOUT);
$slide->close();
$slide_counter++;
unless(defined($first_slide)) {
$first_slide = $info{$pathname}{'slide'};
}
}
###############################################################################
#
# Generate HTML for details page
#
###############################################################################
sub details_html {
my $pathname = shift(@_);
my $filename = $info{$pathname}{'file'};
my ($link, $anchortext);
# At beginning of row?
if ($col_counter == 1) {
push(@details, " <TR>\n");
}
if ($details_linkto eq 'index') {
$link = "$indexfile#$filename";
} elsif (($details_linkto eq 'medium') and !defined($skipmedium{$pathname})) {
$link = "$info{$pathname}{medium}";
} elsif (($details_linkto eq 'thumbnail') and !defined($skipthumb{$pathname})) {
$link = "$info{$pathname}{thumb}";
} elsif (($details_linkto eq 'slide') and ($do_slide == 1) and ($image_counter > 1)) {
$link = $info{$pathname}{'slide'};
} else {
$link = $filename;
}
push(@details," <TD CLASS=\"index\" VALIGN=\"middle\" ALIGN=\"center\">\n");
push(@details," <TABLE BORDER=0 WIDTH=\"100%\">\n");
push(@details," <TR>\n");
push(@details," <TD VALIGN=\"middle\" ALIGN=\"center\">\n");
push(@details," <DIV CLASS=\"detail\">\n");
push(@details," <A NAME=\"$filename\">");
push(@details, &format_date($info{$pathname}{'date'}, 'detail'));
push(@details,"</A><BR>\n");
$anchortext = "<A HREF=\"$link\"";
if (defined ($detailthumbtitle) && $detailthumbtitle ne '') {
my ($str);
$str = &interpolate_title_string ($detailthumbtitle, $pathname, 'detail');
if ($str ne '') {
$anchortext .= sprintf (" TITLE=\"%s\"", $str);
}
}
$anchortext .= ">";
push(@details, $anchortext);
if (defined($skipthumb{$pathname})) {
push(@details,"<IMG SRC=\"$filename\"");
} else {
push(@details,"<IMG SRC=\"$info{$pathname}{thumb}\"");
}
my $x = $info{$pathname}{'thumb_x'} / $detailshrink ;
my $y = $info{$pathname}{'thumb_y'} / $detailshrink ;
push(@details, sprintf(" WIDTH=\"%d\" HEIGHT=\"%d\"", $x, $y));
push(@details," ALT=\" $filename \"");
push(@details," CLASS=\"index\"");
push(@details,"></A><BR>");
push(@details,"$filename<BR>");
push(@details,"</DIV>\n");
push(@details," </TD>\n\n");
push(@details," <TD VALIGN=\"middle\" ALIGN=\"left\">\n");
push(@details," <DIV CLASS=\"detail\">");
push(@details,"Original:&nbsp;<A HREF=\"$filename\">$info{$pathname}{geometry}</A>");
push(@details,"&nbsp;($info{$pathname}{size})<BR>");
unless (defined($skipmedium{$pathname})) {
push(@details,"Medium:&nbsp;<A HREF=\"$info{$pathname}{medium}\">");
push(@details,$info{$pathname}{'med_x'} . 'x' . $info{$pathname}{'med_y'} . "</A>");
push(@details,"&nbsp;($info{$pathname}{med_size})<BR>");
}
unless (defined($skipthumb{$pathname})) {
push(@details,"Thumbnail:&nbsp;<A HREF=\"$info{$pathname}{thumb}\">");
push(@details,$info{$pathname}{'thumb_x'} . 'x' . $info{$pathname}{'thumb_y'} . "</A>");
#push(@details,"&nbsp;($info{$pathname}{thumb_size})<BR>");
push(@details,"<BR>");
}
#
# EXIF data
#
if (defined($info{$pathname}{'flash'})) {
push(@details,"Flash:&nbsp;$info{$pathname}{flash}<BR>");
}
if (defined($info{$pathname}{'exposure_time'})) {
push(@details,"Exposure time:&nbsp;$info{$pathname}{exposure_time}<BR>");
}
if (defined($info{$pathname}{'focus_dist'})) {
push(@details,"Focus distance:&nbsp;$info{$pathname}{focus_dist}<BR>");
}
if (defined($info{$pathname}{'focal_length'})) {
push(@details,"Focal length:&nbsp;$info{$pathname}{focal_length}<BR>");
}
if (defined($info{$pathname}{'aperture'})) {
push(@details,"Aperture:&nbsp;$info{$pathname}{aperture}<BR>");
}
push(@details,"\n");
push(@details," </DIV>\n");
push(@details," </TD>\n");
push(@details," </TR>\n");
push(@details," </TABLE>\n");
push(@details," </TD>\n");
# At end of row?
if ($col_counter == $current_columns) {
push(@details, " </TR>\n");
}
}
######################################################################
#
# Extract info from image
#
######################################################################
sub fill_image_info {
my $filename = shift (@_);
my $pathname = "$srcdir/$filename";
my $image = new Image::Magick;
my $retval;
print ".";
flush (STDOUT);
$retval = $image->Read($pathname);
if ($retval ne "") {
print "\nSkipping $pathname";
flush (STDOUT);
return;
} else {
$object_counter++;
$image_counter++;
}
$info{$pathname}{'file'} = $filename;
# Use mtime as a fallback date in case we don't have exif data
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = stat($pathname);
$info{$pathname}{'date'} = POSIX::strftime ("%Y%m%d%H%M.%S",localtime($mtime));
$info{$pathname}{'x'} = $image->Get('width');
$info{$pathname}{'y'} = $image->Get('height');
$info{$pathname}{'geometry'} = $info{$pathname}{'x'} . "x" . $info{$pathname}{'y'};
$info{$pathname}{'size'} = &convert_to_kb($image->Get('filesize'));
$info{$pathname}{'format'} = $image->Get('format');
$info{$pathname}{'comment'} = $image->Get('comment');
my ($name,$path,$suffix) = fileparse($filename,'\.\S+');
if ($info{$pathname}{'format'} =~ /JFIF/i) {
$info{$pathname}{'thumb'} = "$thumbnail_dir/$filename";
$thumb_backref{"$thumbnail_dir/$filename"} = $pathname;
$info{$pathname}{'medium'} = "$med_dir/$filename";
$med_backref{"$med_dir/$filename"} = $pathname;
if (defined(&image_info)) {
my $exif = image_info("$pathname");
if (my $error = $exif->{error}) {
warn "Can't parse image info: $error\n";
}
if (defined($opt_debug)) {
print "EXIF data for $pathname:\n";
foreach (keys %$exif) {
print " $_ = $exif->{$_}\n";
}
print "\n";
}
if (defined($exif->{DateTimeOriginal})) {
$exif->{DateTimeOriginal} =~ /\s*([\d:]+)\s+([\d:]+)/;
my $dt = $1;
my $tm = $2;
$tm =~ s/://;
$tm =~ s/:/\./;
$dt =~ s/://g;
$info{$pathname}{'date'} = $dt . $tm;
}
if (defined($exif->{Flash})) {
$info{$pathname}{'flash'} = $exif->{'Flash'};
$info{$pathname}{'flash'} =~ s/0/no/;
$info{$pathname}{'flash'} =~ s/1/yes/;
}
if (defined($exif->{FocalLength})) {
$info{$pathname}{'focal_length'} = sprintf("%4.1fmm", eval("$exif->{FocalLength}"));
}
if (defined($exif->{SubjectDistance})) {
$info{$pathname}{'focus_dist'} = sprintf("%4.1fm", eval("$exif->{SubjectDistance}"));
}
if (defined($exif->{ExposureTime})) {
$info{$pathname}{'exposure_time'} = $exif->{ExposureTime} . 's';
}
if (defined($exif->{FNumber})) {
$info{$pathname}{'aperture'} = "f/" . eval ("$exif->{FNumber}");
}
}
} else {
$info{$pathname}{'thumb'} = "$thumbnail_dir/$name.jpg";
$thumb_backref{"$thumbnail_dir/$name.jpg"} = $pathname;
$info{$pathname}{'medium'} = "$med_dir/$name.jpg";
$med_backref{"$med_dir/$name.jpg"} = $pathname;
}
$info{$pathname}{'slide'} = "$slide_dir/$name.html";
$slide_backref{"$slide_dir/$name.html"} = $pathname;
push(@{$timestamp{"$info{$pathname}{date}"}}, $pathname);
}
######################################################################
#
# Write HTML for directory entries
#
######################################################################
sub dir_entry {
my $dir = shift(@_);
my $destdirname = "$destdir/$dir";
my $srcdirname = "$srcdir/$dir";
my $anchortext;
print "Processing directory $srcdirname\n";
# Recurse first
if ($do_recurse == 1) {
my $flags = "";
$flags .= "-medium " if ($do_medium == 1);
$flags .= "-nomedium " if ($do_medium == 0);
$flags .= "-slide " if ($do_slide == 1);
$flags .= "-noslide " if ($do_slide == 0);
$flags .= "-dirs " if ($do_dirs == 1);
$flags .= "-nodirs " if ($do_dirs == 0);
$flags .= "-montage " if ($do_montage == 1);
$flags .= "-nomontage " if ($do_montage == 0);
$flags .= "-detail " if ($do_detail == 1);
$flags .= "-nodetail " if ($do_detail == 0);
$flags .= "-reverse " if ($do_reverse == 1);
$flags .= "-noreverse " if ($do_reverse == 0);
$flags .= "-forceregen " if (defined($opt_forceregen));
$flags .= "-includeall " if (defined($opt_includeall));
$flags .= "-columns $current_columns " if (defined($opt_columns));
$flags .= "-x $opt_x " if (defined($opt_x));
$flags .= "-y $opt_y " if (defined($opt_y));
$flags .= "-destdir $destdirname " if ($destdir ne $srcdir);
foreach my $var (keys %opt_d) {
$flags .= " -d $var=$opt_d{$var}";
}
system("cd $srcdirname ;$0 $flags -recurse");
}
my $dirtitle = "";
my $first;
my $last;
my $montage;
my $montage_x;
my $montage_y;
# Only add entry if this dir has an index file
if (-r "$destdirname/$indexfile") {
# Go fetch the title and dates from the HTML
my $tmp1 = &extract_meta_tag ($titlemetatag,"$destdirname/$indexfile");
my $tmp2 = &extract_meta_tag ($begindatemetatag,"$destdirname/$indexfile");
my $tmp3 = &extract_meta_tag ($enddatemetatag,"$destdirname/$indexfile");
if (defined($tmp1)) {
$dirtitle = $tmp1;
}
if (defined($tmp2)) {
$first = $tmp2;
}
if (defined($tmp3)) {
$last = $tmp3;
}
# If we found generated files in this dir, flag that we found something
# valid to index
$object_counter++;
$dir_counter++;
# Set montage file if we found it
if (($do_montage == 1) and ( -r "$destdirname/$thumbnail_dir/$montagefile")) {
print "Found montage in $destdirname\n" if defined($opt_debug);
$montage = "$destdirname/$thumbnail_dir/$montagefile";
my $image = new Image::Magick;
my $retval;
$retval = $image->Read(filename=>$montage);
warn "$retval" if "$retval";
$montage_x = $image->Get('width');
$montage_y = $image->Get('height');
}
# At beginning of row?
if ($col_counter == 1) {
push(@index, "<TR>\n");
push(@details, "<TR>\n");
}
# Entry for this directory in main & details file
push(@index, "<TD CLASS=\"index\" VALIGN=\"middle\" ALIGN=\"center\">\n");
push(@details, "<TD CLASS=\"index\" VALIGN=\"middle\" ALIGN=\"center\">\n");
push(@details, "<TABLE BORDER=\"0\" WIDTH=\"100%\">\n");
if (defined($montage)) {
push(@details, "<TR><TD VALIGN=\"middle\" ALIGN=\"center\">\n");
} else {
push(@details, "<TR><TD COLSPAN=\"2\" VALIGN=\"middle\" ALIGN=\"center\">\n");
}
if (defined($first)) {
my ($tmp_first, $tmp_last);
push(@index, "<DIV CLASS=\"index\">");
push(@details, "<DIV CLASS=\"detail\">");
$tmp_first = &format_date ($first, 'index', 'dayonly');
$tmp_last = &format_date ($last, 'index', 'dayonly');
if ($first ne $last) {
push(@index, "$tmp_first - $tmp_last");
} else {
push(@index, "$tmp_first");
}
$tmp_first = &format_date ($first, 'detail', 'dayonly');
$tmp_last = &format_date ($last, 'detail', 'dayonly');
if ($first ne $last) {
push(@details, "$tmp_first - $tmp_last");
} else {
push(@details, "$tmp_first");
}
push(@index, "</DIV>\n");
push(@details, "</DIV>\n");
}
if (defined($montage)) {
$anchortext = "<A HREF=\"$dir/$indexfile\"";
if (defined ($montagetitle) && $montagetitle ne '') {
my ($str);
$str = &interpolate_title_string_dir ($montagetitle, $dir, 'index');
if ($str ne '') {
$anchortext .= sprintf (" TITLE=\"%s\"", $str);
}
}
$anchortext .= ">";
push(@index, $anchortext);
push(@index, "<IMG CLASS=\"index\" SRC=\"$dir/$thumbnail_dir/$montagefile\"");
push(@index, " WIDTH=\"$montage_x\" HEIGHT=\"$montage_y\"");
push(@index, " ALT=\"\"");
push(@index, ">");
push(@index, "</A>\n");
push(@index,"<DIV CLASS=\"index\">");
push(@index, "<A HREF=\"$dir/$indexfile\">$dir</A>");
push(@index,"</DIV>\n");
$anchortext = "<A HREF=\"$dir/$detailfile\"";
if (defined ($montagetitle) && $montagetitle ne '') {
my ($str);
$str = &interpolate_title_string_dir ($montagetitle, $dir, 'index');
if ($str ne '') {
$anchortext .= sprintf (" TITLE=\"%s\"", $str);
}
}
$anchortext .= ">";
push(@details, $anchortext);
push(@details, "<IMG CLASS=\"index\" SRC=\"$dir/$thumbnail_dir/$montagefile\"");
my $x = $montage_x / $detailshrink ;
my $y = $montage_y / $detailshrink ;
push(@details, sprintf(" WIDTH=\"%d\" HEIGHT=\"%d\"", $x, $y));
push(@details, " ALT=\"\"");
push(@details, ">");
push(@details, "</A>");
push(@details, "</TD><TD VALIGN=\"middle\" ALIGN=\"left\">\n");
} else {
push(@index,"<DIV CLASS=\"index\">");
push(@index, "<A HREF=\"$dir/$indexfile\">$dir</A>");
push(@index,"</DIV>\n");
}
push(@index, "<DIV CLASS=\"caption\">");
push(@details, "<DIV CLASS=\"detail\">");
if ($dirtitle ne "") {
push(@index, "$dirtitle");
push(@details, "$dirtitle");
}
push(@details, "<BR><A HREF=\"$dir/$detailfile\">$dir</A>");
push(@index, "</DIV>\n");
push(@details, "</DIV>\n");
push(@details,"</TD></TR></TABLE>\n");
push(@index, "</TD>\n");
push(@details, "</TD>\n");
# At end of row?
if ($col_counter == $current_columns) {
push(@index, "</TR>\n");
push(@details, "</TR>\n");
}
# Increment for next item
$col_counter++;
$col_counter = 1 if ($col_counter > $current_columns);
} # if dir had index file
}
######################################################################
#
# Top of HTML index/detail files
#
######################################################################
sub page_header {
my $this = shift(@_);
my $linkto = shift(@_);
my $numlink = 0;
my $verstring;
select(INDEX);
print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\"\n";
print "\"http://www.w3.org/TR/html401/strict.dtd\">\n";
print "<HTML>\n";
print "<HEAD>\n";
$verstring = &versionstring();
printf ("<META NAME=\"GENERATOR\" CONTENT=\"imageindex %s\">\n", $verstring);
printf ("<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=ISO-8859-1\">\n");
if (defined ($write_meta_tag{$titlemetatag})) {
print "<META NAME=\"$titlemetatag\" CONTENT=\"$current_titletext\">\n";
}
if (defined ($write_meta_tag{$columnsmetatag})) {
print "<META NAME=\"$columnsmetatag\" CONTENT=\"$current_columns\">\n";
}
if (defined ($write_meta_tag{$thumbxmetatag})) {
print "<META NAME=\"$thumbxmetatag\" CONTENT=\"$current_thumbnail_x\">\n";
}
if (defined ($write_meta_tag{$thumbymetatag})) {
print "<META NAME=\"$thumbymetatag\" CONTENT=\"$current_thumbnail_y\">\n";
}
if (defined ($write_meta_tag{$reversemetatag})) {
print "<META NAME=\"$reversemetatag\" CONTENT=\"$current_reverse\">\n";
}
if (defined($firstdate)) {
print "<META NAME=\"$begindatemetatag\" CONTENT=\"$firstdate\">\n";
}
if (defined($lastdate)) {
print "<META NAME=\"$enddatemetatag\" CONTENT=\"$lastdate\">\n";
}
if (!defined ($opt_includeall) && defined (@opt_exclude) && scalar (@opt_exclude)) {
my $tmp = join (',', @opt_exclude);
my $etmp;
# We need to "encode" this string in the HTML so that raw filenames
# (that people should not try to access) are not exposed to the
# outside world.
#
$etmp = &encodestring ($tmp);
printf ("<META NAME=\"$excludemetatag\" CONTENT=\"%s\">\n", $etmp);
}
printf ("<META NAME=\"$numimagesmetatag\" CONTENT=\"%d\">\n", $image_counter);
if (defined (@opt_skipmont) && scalar (@opt_skipmont)) {
my $tmp = join (',', @opt_skipmont);
printf ("<META NAME=\"$skipmetatag\" CONTENT=\"%s\">\n", $tmp);
}
print "<TITLE>$current_titletext</TITLE>\n";
print "<LINK TYPE=\"text/css\" REL=\"stylesheet\" HREF=\"$stylefile\">\n";
print "</HEAD>\n";
print "<BODY>\n";
# Break out of frames
print "<SCRIPT TYPE=\"text/javascript\">\n";
print "if (parent.frames.length > 0) {\n";
print " parent.location.href = self.document.location\n";
print "}\n";
print "</SCRIPT>\n";
print "<H1 CLASS=\"title\">$current_titletext</H1>\n";
print "<H3>";
# On all these links, check to see if the variable is also defined. If
# not (done in a .imageindexrc file perhaps) then skip the link
if ((-e "$destdir/../$indexfile") and
($do_dirs == 1) and defined($updirtext)) {
print "<A HREF=\"../$indexfile\">$updirtext</A>";
$numlink++;
}
if (($do_detail == 1) and ($this eq 'index') and defined($detaillinktext)) {
print "&nbsp;&nbsp;|&nbsp;&nbsp;" if ($numlink != 0);
print "<A HREF=\"$detailfile\">$detaillinktext</A>";
$numlink++;
}
if (($this eq 'detail') and defined($indexlinktext)) {
print "&nbsp;&nbsp;|&nbsp;&nbsp;" if ($numlink != 0);
print "<A HREF=\"$indexfile\">$indexlinktext</A>";
$numlink++;
}
if (($do_slide == 1) and ($slide_counter > 1) and
defined($framelinktext)) {
print "&nbsp;&nbsp;|&nbsp;&nbsp;" if ($numlink != 0);
print "<A HREF=\"$slide_dir/$framefile\">$framelinktext</A>";
$numlink++;
}
#age test:
print "&nbsp;&nbsp;|&nbsp;&nbsp;" if ($numlink != 0);
print "<A HREF=\"../\">$updirtext</A>";
#age ende
print "\n<BR>\n" if ($numlink != 0);
print "</H3>\n";
if (defined($firstdate) and defined($lastdate)) {
my $tmp1 = &format_date($firstdate, $this, 'dayonly');
my $tmp2 = &format_date($lastdate, $this, 'dayonly');
if ($tmp1 ne $tmp2) {
if ($current_reverse == 0) {
print "<H2 CLASS=\"daterange\">$tmp1 - $tmp2</H2>\n";
} else {
print "<H2 CLASS=\"daterange\">$tmp2 - $tmp1</H2>\n";
}
} else {
print "<H2 CLASS=\"daterange\">$tmp1</H2>\n";
}
}
print "<TABLE WIDTH=\"100%\" CLASS=\"index\">\n";
select(STDOUT);
}
######################################################################
#
# Bottom of HTML file
#
######################################################################
sub page_footer {
my $time = localtime(time);
my $progurl = 'http://www.edwinh.org/imageindex/';
select(INDEX);
print "</TABLE>\n";
print "<DIV CLASS=\"credits\">";
print "<BR>\n";
print "<BR>\n";
print "<I>..erstellt mit <A HREF=\"$progurl\">imageindex</A>..</I>";
print "</DIV>\n";
print "</BODY>\n</HTML>\n";
select(STDOUT);
}
######################################################################
#
# A "quickie" routine to show which files were excluded in a prior run
#
######################################################################
sub showexcluded {
my ($file) = @_;
my ($rfile, $tmp, $utmp, @files, $str);
if (! defined ($file)) {
if (-r $indexfile) {
$rfile = $indexfile;
}
}
else {
$rfile = $file;
}
$tmp = &extract_meta_tag ($excludemetatag, $rfile);
if (defined($tmp)) {
# We need to "decode" this string as it has been encoded for storage
# in the HTML so that raw filenames (that people should not try to
# access) are not exposed to the outside world.
#
$utmp = &decodestring ($tmp);
(@files) = split (/,/, $utmp);
$str = join (',', @files);
printf ("File '$rfile' shows the following record of excluded files:\n");
printf ("%s\n", $str);
}
else {
printf ("File '$rfile' shows no record of excluded files.\n");
}
return;
}
######################################################################
#
# Ignore certain files via META data stored in the index.html file
#
# Exports global variable %skipmont used later during montage
# generation.
#
######################################################################
sub exclude_files {
my @files = @_;
my (@filelist, $f, %exclude, $token, @tokens);
undef %exclude;
# -skipmont flags override any META data found. Else, look for the META tag
# then process. Check to see if any of the -skipmont options were given as
# strings of filenames concatenated with ',' characters. If so, support it.
#
if (defined (@opt_skipmont)) {
foreach (@opt_skipmont) {
(@tokens) = split (/,/, $_);
foreach $token (@tokens) {
$skipmont{$token}++;
}
}
}
elsif (-r "$destdir/$indexfile") {
my $tmp = &extract_meta_tag ($skipmetatag, "$destdir/$indexfile");
if (defined($tmp)) {
(@opt_skipmont) = split (/,/, $tmp);
my $str = join (',', @opt_skipmont);
printf ("Using saved skip-montage files: %s\n", $str);
foreach (@opt_skipmont) {
$skipmont{$_}++;
}
}
}
# -exclude flags override any META data found. Else, look for the META tag
# then process. Check to see if any of the -exclude options were given as
# strings of filenames concatenated with ',' characters. If so, support it.
#
if (defined (@opt_exclude)) {
# -includeall takes priority over -exclude on the commandline if they are
# used together (wierd, but ...)
#
unless (defined ($opt_includeall)) {
foreach (@opt_exclude) {
(@tokens) = split (/,/, $_);
foreach $token (@tokens) {
$exclude{$token}++;
}
}
}
}
elsif (-r "$destdir/$indexfile") {
my $tmp = &extract_meta_tag ($excludemetatag, "$destdir/$indexfile");
my $utmp;
if (defined($tmp) && !defined ($opt_includeall)) {
# We need to "decode" this string as it has been encoded for storage
# in the HTML so that raw filenames (that people should not try to
# access) are not exposed to the outside world.
#
$utmp = &decodestring ($tmp);
(@opt_exclude) = split (/,/, $utmp);
my $str = join (',', @opt_exclude);
printf ("Using saved excluded files: %s\n", $str);
foreach (@opt_exclude) {
$exclude{$_}++;
}
}
}
foreach $f (@files) {
if (! $exclude{$f}) {
push (@filelist, $f);
} else {
print "Excluding '$f'\n";
if (-d $f) {
chmod (0700, $f);
}
else {
chmod (0600, $f);
}
}
}
return (@filelist);
}
######################################################################
#
# Nuke generated files if original image gone
#
######################################################################
sub nuke_out_of_date {
foreach my $checkdir ($thumbnail_dir, $med_dir, $slide_dir) {
opendir(THUMBS,"$destdir/$checkdir") || die "Can't open dir $checkdir: ($!)\n";
foreach (readdir(THUMBS)) {
next if (m/^\.?\.$/);
next if (m/$framefile/);
next if (m/$slidefile/);
next if (m/$montagefile/);
next if (m/$emoticonsmile/);
next if (m/$emoticonwink/);
next if (m/$emoticonfrown/);
if (!defined($thumb_backref{"$checkdir/$_"}) and
!defined($slide_backref{"$checkdir/$_"}) and
!defined($med_backref{"$checkdir/$_"})) {
print "Removing stale $destdir/$checkdir/$_\n";
unlink("$destdir/$checkdir/$_") || warn "Can't unlink $destdir/$checkdir/$_: ($!)\n";
$modified_thumb++;
}
}
closedir(THUMBS);
}
}
######################################################################
#
# Convert bytes to kb string
#
######################################################################
sub convert_to_kb {
my $bytes = shift(@_);
$bytes = sprintf("%dk", $bytes / 1024);
return($bytes);
}
######################################################################
#
# Sortq by integer date stamp
#
######################################################################
sub bynumber {
if ($current_reverse == 0) {
$a <=> $b;
} else {
$b <=> $a;
}
}
######################################################################
#
# Write frameset file for slideshows
#
######################################################################
sub write_frameset {
# This is impossible to get rid of
my $framefudge = 35;
my $verstring;
open(FRAME,">$destdir/$slide_dir/$framefile") or die ("Can't open $destdir/$slide_dir/$framefile: $!\n");
select(FRAME);
print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Frameset//EN\"\n";
print "\"http://www.w3.org/TR/html401/frameset.dtd\">\n";
print "<HTML>\n";
print "<HEAD>\n";
$verstring = &versionstring();
printf ("<META NAME=\"GENERATOR\" CONTENT=\"imageindex %s\">\n", $verstring);
printf ("<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=ISO-8859-1\">\n");
print "<LINK TYPE=\"text/css\" REL=\"stylesheet\" HREF=\"../$stylefile\">";
print "<TITLE>$current_titletext</TITLE>\n";
print "<LINK TYPE=\"text/css\" REL=\"stylesheet\" HREF=\"../$stylefile\">\n";
print "</HEAD>\n";
if ($frame_orient eq 'horizontal') {
printf("<FRAMESET ROWS=\"%d, *\">\n", $max_thumb_y + $framefudge);
} else {
printf("<FRAMESET COLS=\"%d, *\">\n", $max_thumb_x + $framefudge);
}
print "<FRAME NAME=\"thumb\" SRC=\"$slidefile\">\n";
print "<FRAME NAME=\"view\" SRC=\"../$first_slide\">\n";
print "<NOFRAMES>No frames in this browser...go back</NOFRAMES>\n";
print "</FRAMESET>\n";
print "</HTML>\n";
select(STDOUT);
close (FRAME);
open(FRAME,">$destdir/$slide_dir/$slidefile") or die ("Can't open $destdir/$slide_dir/$slidefile: $!\n");
select(FRAME);
print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\"\n";
print "\"http://www.w3.org/TR/html401/strict.dtd\">\n";
print "<HTML>\n";
print "<HEAD>\n";
$verstring = &versionstring();
printf ("<META NAME=\"GENERATOR\" CONTENT=\"imageindex %s\">\n", $verstring);
printf ("<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=ISO-8859-1\">\n");
print "<LINK TYPE=\"text/css\" REL=\"stylesheet\" HREF=\"../$stylefile\">\n";
print "<TITLE>$current_titletext</TITLE>\n";
print "</HEAD>\n<BODY>\n";
print "<TABLE CLASS=\"frame\"\n";
print " <TR>\n" if ($frame_orient eq 'horizontal');
foreach (@frame) {
print;
}
print " </TR>\n" if ($frame_orient eq 'horizontal');
print "</TABLE>\n";
print "</BODY>\n</HTML>\n";
select(STDOUT);
close(FRAME);
}
######################################################################
#
# Do next/index/prev links on slide pages
#
######################################################################
sub next_prev_links {
my $pathname = shift(@_);
print "<DIV CLASS=\"index\">";
if (defined($back{$pathname})) {
print "<A HREF=\"$back{$pathname}\">&lt;&nbsp;previous</A>&nbsp;|&nbsp;";
} else {
print "&lt;&nbsp;previous&nbsp;|&nbsp;";
}
print "<A HREF=\"../$indexfile\" TARGET=\"_parent\">index</A>";
if (defined($forward{$pathname})) {
print "&nbsp;|&nbsp;<A HREF=\"$forward{$pathname}\">next&nbsp;&gt;</A>";
} else {
print "&nbsp;|&nbsp;next&nbsp;&gt;";
}
print "</DIV>\n";
}
######################################################################
#
# Lower-case all the filenames. I hate the uppercase filenames that come
# from my camera's default software (and Windud software). Plus I didn't
# want this "utility" in another script, so just place it here.
#
######################################################################
sub lower_case_files {
my (@files) = @_;
my ($newfile, $lowername);
foreach $name (@files) {
($lowername = $name) =~ tr/A-Z/a-z/;
if ($name =~ /[A-Z]/) {
print "Moving '$name' to '$lowername'\n";
move("$name","$lowername");
}
}
}
######################################################################
#
# extract the NAME tag from an HTML file
#
######################################################################
sub extract_meta_tag {
my ($tag, $filename) = @_;
my ($name, $content, $retval);
if (! (open (FILE, $filename))) {
print STDERR "Cannot open '$filename' for reading - $!\n";
return (0);
}
# <META NAME="Columns" CONTENT="3">
#
while (<FILE>) {
if (/<META\s+NAME=\"(.*?)\"\s+CONTENT=\"(.*)\">/) {
$name = $1;
$content = $2;
if ($name eq $tag) {
$retval = $content;
last;
}
}
}
close (FILE);
return ($retval);
}
###############################################################################
#
# Rotate given image 90 degrees
#
###############################################################################
sub rotate_image {
my $file = shift(@_);
my $argv = shift(@_);
if ($file =~ m/^(cw|ccw)$/) {
# If file is cw or ccw,
# assume the args were given backwards
my $tmp = $file;
$file = $$argv[0];
$$argv[0] = $tmp;
}
-r "$file" || die("$file: ", $!);
-w "$file" || die("$file: ", $!);
# grab the mtime of the file so we can reset it after we update it
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
$ctime,$blksize,$blocks) = stat($file);
my $posix_mtime = POSIX::strftime ("%Y%m%d%H%M.%S",localtime($mtime));
my ($name,$path,$suffix) = fileparse($file,'\.\S+');
my $thumb;
my $medium;
my $image = new Image::Magick;
my $retval = $image->Read("$file");
warn "$retval" if "$retval";
if (!defined($$argv[0]) or
($$argv[0] !~ m/^cc?w$/i)) {
print "Need 'cw' or 'ccw' argument to rotate image clockwise/counterclockwise\n";
exit(1);
}
if ($$argv[0] =~ /^ccw$/i) {
$deg = -90;
} else {
$deg = 90;
}
print "Rotating $file $deg degrees\n";
$retval = $image->Rotate($deg);
warn "$retval" if "$retval";
$retval = $image->Write(filename=>"$file");
warn "$retval" if "$retval";
system ("touch -t $posix_mtime $file");
# Nuke the generated images if they exist
# (touching the timestamp above breaks automatic regeneration logic)
if ($image->Get('format') =~ /JFIF/i) {
$thumb = $path . "$thumbnail_dir/$name" . $suffix;
$medium = $path . "$med_dir/$name" . $suffix;
} else {
$thumb = $path . "$thumbnail_dir/$name.jpg";
$medium = $path . "$med_dir/$name.jpg";
}
unlink($thumb) if (-e "$thumb");
unlink($medium) if (-e "$medium");
}
###############################################################################
#
# Set or display caption for a particular image
#
###############################################################################
sub caption_image {
my $file = shift(@_);
my $argv = shift(@_);
my ($esc_comment, $tmpfile);
-r "$file" || die("$file: ", $!);
# grab the mtime of the file so we can reset it after we update it
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
$ctime,$blksize,$blocks) = stat($file);
my $posix_mtime = POSIX::strftime ("%Y%m%d%H%M.%S",localtime($mtime));
my $image = new Image::Magick;
my $retval = $image->Read("$file");
warn "$retval" if "$retval";
my $format = $image->Get('format');
warn "$retval" if "$retval";
# Set caption if another arg is present, or just display it
if (defined($$argv[0])) {
-w "$file" || die("$file: ", $!);
# Try to find wrjpgcom so we can use it for adding captions to JPG images
my $wrjpgcom_prog = &find_in_path ('wrjpgcom');
my $quote_file = quotemeta ($file);
# If a jpeg file and we found a wrjpgcom program in our path, use
# it! It simply puts the comment in the JPEG header without reading
# (uncompressing) and writing (re-compressing) the file out so
# there is no chance for data loss.
#
if (($format =~ /JFIF/i) and defined($wrjpgcom_prog)) {
$tmpfile = "$file.$$";
my $tmpfile_quote = "$quote_file.$$";
$esc_comment = quotemeta ($$argv[0]);
# FIXME
# check to see how '?' and other punctuation is escaped and fix
# it seems things are not correct.
system ("$wrjpgcom_prog -replace -comment $esc_comment $quote_file > $tmpfile_quote");
if (($? >> 8) != 0) {
printf(STDERR "Error in creating JPEG comment with 'wrjpgcom'. Leaving existing file intact.\n");
} else {
move($tmpfile, $file);
}
} else {
# Fall back to PerlMagick's routines.
#
$retval = $image->Comment("$$argv[0]");
warn "$retval" if "$retval";
$retval = $image->Write(filename=>"$file", quality=>"95",
sampling_factor=>"1x1");
warn "$retval" if "$retval";
}
system ("touch -t $posix_mtime $quote_file");
} else {
my $text = $image->Get('comment');
if (defined($text)) {
print "$file: \"$text\"\n";
} else {
print "$file: (no caption)\n";
}
}
}
###############################################################################
#
# Print usage info from top of file
#
###############################################################################
sub usage {
open(FILE,"$0") or die "Can't open $0: $OS_ERROR";
while(<FILE>) {
last if (m/^\#\s+USAGE:/);
}
while(<FILE>) {
last if (m/^\#\#\#\#\#\#\#/);
s/^\# ?//;
print;
}
close(FILE);
}
######################################################################
#
# Format timestamp for HTML pages. This routine assumes that the date
# given to it is in YYYYMMDDHHMM.SS format that we've created from the
# EXIF/mtime date using strftime().
#
######################################################################
sub format_date {
my ($date, $context, $dayonly) = @_;
my ($timeformat, $dateformat);
if ($context eq 'frame') {
$timeformat = $frametimeformat;
$dateformat = $framedateformat;
}
elsif ($context eq 'index') {
$timeformat = $indextimeformat;
$dateformat = $indexdateformat;
}
elsif ($context eq 'slide') {
$timeformat = $slidetimeformat;
$dateformat = $slidedateformat;
}
else {
$timeformat = $detailtimeformat;
$dateformat = $detaildateformat;
}
# Replace "macro" patterns in the format string first
#
$timeformat =~ s/\%R/\%H:\%M/g;
$timeformat =~ s/\%r/\%I:\%M:\%S \%p/g;
$dateformat =~ s/\%F/\%Y-\%m-\%d/g;
$dateformat =~ s/\%D/\%m\/\%d\/\%y/g;
$date =~ /(\d\d\d\d)(\d\d)(\d\d)(\d\d)?(\d\d)?\.?(\d\d)?/;
my $year = $1;
my $month = $2;
my $day = $3;
my $hour = $4;
my $min = $5;
my $sec = $6;
my ($ampm, $two_digit_year, $twelve_hour);
if ($year =~ /^\d\d(\d\d)$/) {
$two_digit_year = $1;
}
else {
$two_digit_year = '??'; # shouldn't ever been seen
}
# If we're told to, only format a date with no time
#
if (defined ($dayonly)) {
$dateformat =~ s/\%Y/$year/g;
$dateformat =~ s/\%y/$two_digit_year/g;
$dateformat =~ s/\%m/$month/g;
$dateformat =~ s/\%d/$day/g;
$dateformat =~ s/\%\%/\%/g;
return ($dateformat);
}
else {
if (defined($hour)) {
$twelve_hour = $hour;
$ampm = 'AM';
if ($hour > 12) {
$twelve_hour -= 12;
$ampm = 'PM';
}
}
else {
$hour = '??';
$twelve_hour = '??';
$ampm = '??'; #again, should never be seen
}
if (! defined ($min)) {
$min = '??';
}
if (! defined ($sec)) {
$sec = '??';
}
$dateformat =~ s/\%Y/$year/g;
$dateformat =~ s/\%y/$two_digit_year/g;
$dateformat =~ s/\%m/$month/g;
$dateformat =~ s/\%d/$day/g;
$dateformat =~ s/\%\%/\%/g;
$timeformat =~ s/\%S/$sec/g;
$timeformat =~ s/\%M/$min/g;
$timeformat =~ s/\%I/$twelve_hour/g;
$timeformat =~ s/\%H/$hour/g;
$timeformat =~ s/\%p/$ampm/g;
$timeformat =~ s/\%\%/\%/g;
return("$dateformat $timeformat");
}
}
######################################################################
#
# Return version string from CVS tag
#
######################################################################
sub versionstring {
my $ver = ' $Name: v1_0_7 $ ';
$ver =~ s/Name//g;
$ver =~ s/[:\$]//g;
$ver =~ s/\s+//g;
$ver =~ s/^v//g;
$ver =~ s/_/\./g;
if ($ver eq '') {
$ver = "cvs devel - " . '$Revision: 1.164 $ ';
# Nuke the $ signs -- what if somebody is keeping pages under RCS
# or CVS control?
$ver =~ s/\$//g;
$ver =~ s/\s*$//;
}
return($ver);
}
###############################################################################
#
# Create CSS file that is shared among the HTML pages
#
###############################################################################
sub write_css {
open(CSS,">$destdir/$stylefile") or die ("Can't open $destdir/$stylefile: $!\n");
select(CSS);
print $stylesheet;
select(STDOUT);
close(CSS);
}
###############################################################################
#
# "Interpolate" %? escapes found in our printf-like strings defined for the
# TITLE attributes. See the beginning of this file for their definition
#
###############################################################################
sub interpolate_title_string {
my ($formatstring, $pathname, $context) = @_;
my ($filename, $date, $size, $resolution, $caption);
my ($tmp);
$filename = $info{$pathname}{'file'};
$date = &format_date ($info{$pathname}{'date'}, $context);
$size = $info{$pathname}{'size'};
$resolution = $info{$pathname}{'geometry'};
$caption = $info{$pathname}{'comment'};
if (! defined ($caption)) {
$caption = '';
}
$tmp = $formatstring;
$tmp =~ s/\%f/$filename/g if $filename;
$tmp =~ s/\%d/$date/g if $date;
$tmp =~ s/\%s/$size/g if $size;
$tmp =~ s/\%r/$resolution/g if $resolution;
$tmp =~ s/\%c/$caption/g;
$tmp =~ s/\%\%/%/g;
# In case the format string has " marks in it, change all those to '.
# The " marks are needed to mark the argument to the TITLE attribute.
#
$tmp =~ s/\"/\'/g;
return ($tmp);
}
###############################################################################
#
# "Interpolate" %? escapes found in our printf-like strings defined for the
# TITLE attributes. However, the %? escapes for this function are based on what
# you could conceivably need when processing a directory.
#
# See the beginning of this file for their definition
#
###############################################################################
sub interpolate_title_string_dir {
my ($formatstring, $dir, $context) = @_;
my ($tmp, $num, $date, $metadate, $metatitle);
$tmp = $formatstring;
$num = &extract_meta_tag($numimagesmetatag, "$srcdir/$dir/$indexfile");
# If we plucked out the number of images from the metadata of a directory's
# index.html file, replace it. Else, give a warning if we didn't find it but
# somebody still used %n
#
if (defined ($num)) {
$tmp =~ s/\%n/$num/g if $num;
}
else {
if ($tmp =~ /\%n/) {
if (!defined ($remember_warning{$dir})) {
printf (STDERR "Warning: %%n escape used in format string and %s META tag not found in %s. Re-run imageindex in '$dir'.\n", $numimagesmetatag, "$srcdir/$dir/$indexfile");
$remember_warning{$dir}++;
}
}
}
$metadate = &extract_meta_tag($begindatemetatag, "$srcdir/$dir/$indexfile");
$date = &format_date ($metadate, $context, 'dayonly');
$tmp =~ s/\%b/$date/g if $date;
$metadate = &extract_meta_tag($enddatemetatag, "$srcdir/$dir/$indexfile");
$date = &format_date ($metadate, $context, 'dayonly');
$tmp =~ s/\%e/$date/g if $date;
$metatitle = &extract_meta_tag($titlemetatag, "$srcdir/$dir/$indexfile");
$tmp =~ s/\%t/$metatitle/g if $metatitle;
# In case the format string has " marks in it, change all those to '.
# The " marks are needed to mark the argument to the TITLE attribute.
#
$tmp =~ s/\"/\'/g;
return ($tmp);
}
###############################################################################
#
# Look for external programs we depend on in the $PATH. It just finds the first
# occurence of $prog in $PATH.
#
###############################################################################
sub find_in_path {
my ($prog) = @_;
my ($retval);
undef $retval;
foreach $dir (split (/:/, $ENV{'PATH'})) {
if (-r "$dir/$prog" && -x "$dir/$prog") {
$retval = "$dir/$prog";
}
}
return ($retval);
}
###############################################################################
#
# Encode/decode routines for exclude filenames when stuffed in a meta tag
#
###############################################################################
sub encodestring {
my ($tmp) = @_;
my $etmp;
$etmp = pack ("u*", $tmp);
# Hack the string to get rid of \n chars so we can store it on 1 line
$etmp =~ s/\n/..1xn!_ltr../g;
# Get rid of ampersands
$etmp =~ s/\&/..xn!_ltr1../g;
# Get rid of double-quotes
$etmp =~ s/\"/..sb!_lho1../g;
return ($etmp);
}
sub decodestring {
my ($tmp) = @_;
my $utmp;
# Unhack the string to bring back & characters
$tmp =~ s/\.\.sb\!_lho1\.\./\"/g;
$tmp =~ s/\.\.xn\!_ltr1\.\./\&/g;
# Unhack the string to bring back & characters
$tmp =~ s/\.\.xn\!_ltr1\.\./\&/g;
# Unhack the string to bring back \n characters
$tmp =~ s/\.\.1xn\!_ltr\.\./\n/g;
$utmp = unpack ("u*", $tmp);
return ($utmp);
}
#############################################################################
#
# This routine samples linearly (as possible) across the available files in
# a directory. The first pass at sampling is a simple modulo function based
# upon the ratio of files to the number of tiles we can use in the montage.
# If that first pass sample did not produce enough files, then we go back
# iteratively through the list and as evenly-as-possible select unused
# files from those left in the pool.
#
#############################################################################
sub sample_files_for_montage {
my (@files) = @_;
my ($numdiv, $numchosen, $chunksize, $numfiles, $numleft);
my ($i, $index, $f, @ret);
$numfiles = scalar (@files);
$numdiv = sprintf ("%d", $numfiles / $montage_max);
$numdiv++;
for ($i = 0; $i < $numfiles; $i++) {
if (($i % $numdiv) == 0) {
$chosen{$files[$i]}++;
}
}
$numchosen = scalar (keys %chosen);
$numleft = $montage_max - $numchosen;
if ($numleft) {
$chunksize = sprintf ("%d", $numfiles / $numleft);
$index = 0;
for ($i = 0; $i < $numleft; $i++) {
&mark_next_file_for_montage ($index + 1, $numfiles, @files);
$index = $index + $chunksize;
}
}
foreach $f (@files) {
if ($chosen{$f}) {
push (@ret, $f);
}
}
return (@ret);
}
#############################################################################
#
# cycle through the given list of files. If the list[$index] is already marked
# (via the global hash %chosen) then move onto the next one, etc.
#
#############################################################################
sub mark_next_file_for_montage {
my ($index, $numfiles, @files) = @_;
my ($i);
for ($i = $index; $i < $numfiles; $i++) {
if (! $chosen{$files[$i]}) {
$chosen{$files[$i]}++;
last;
}
}
}
###############################################################################
#
# Exclude certain filenames from the list of thumbnails to be used in the
# montage image.
#
###############################################################################
sub exclude_montage_files {
my (@files) = @_;
my (@tmp, $file);
foreach (@files) {
$file = basename ($_);
unless (defined ($skipmont{$file})) {
push (@tmp, $_);
}
}
return (@tmp);
}
###############################################################################
#
# "html-ize" a caption found in an image. Just in case there are certain
# characters used which we want to "escape."
#
###############################################################################
sub htmlize_caption {
my ($caption, $slide) = @_;
$caption =~ s/\&/\&amp;/g;
$caption =~ s/\</\&lt;/g;
$caption =~ s/\>/\&gt;/g;
$caption =~ s/\"/\&quot;/g;
# Help smiley's render in a "mo-better" way when they are at the end of a
# caption and enclosed in parens
#
if ($caption =~ /(:\-?[\(\)])\s*\)\s*$/) {
my $tmp = $1;
$caption =~ s/:\-?[\(\)]\s*\)\s*$/$tmp\&nbsp;\)/;
}
$caption = &emoticonify ($caption, $slide);
return ($caption);
}
###############################################################################
#
# Translate ASCII smiley's embedded into image captions into emoticons
#
###############################################################################
sub emoticonify {
my ($caption, $slide) = @_;
my ($thumbdir, $attr);
return ($caption) if (! defined ($do_emoticons) || $do_emoticons == 0);
# This is a hack, please ignore and move on ... nothing to see here.
#
$caption =~ s/\&nbsp;/NoNBrEaKaBleSpacE/g;
$thumbdir = $thumbnail_dir;
if ($slide) {
$thumbdir = '../' . $thumbdir;
}
$attr = 'STYLE="vertical-align: middle;" WIDTH="19" HEIGHT="19"';
if ($caption =~ s/:\-?\)/\<IMG SRC=\"$thumbdir\/$emoticonsmile\" $attr ALT=\" \[smiley icon\] \"\>/g) {
$emoticon{'smile'}++;
}
if ($caption =~ s/;\-?\)/\<IMG SRC=\"$thumbdir\/$emoticonwink\" $attr ALT=\" \[smiley icon\] \"\>/g) {
$emoticon{'wink'}++;
}
if ($caption =~ s/:\-?\(/\<IMG SRC=\"$thumbdir\/$emoticonfrown\" $attr ALT=\" \[frown icon\] \"\>/g) {
$emoticon{'frown'}++;
}
# Undo the hack
#
$caption =~ s/NoNBrEaKaBleSpacE/\&nbsp;/g;
return ($caption);
}
###############################################################################
#
# Write out PNG files representing the emoticons
#
###############################################################################
sub write_emoticon_png {
my ($type) = @_;
my ($img);
if (! open (IMG, '>' . $destdir . '/' . $thumbnail_dir . "/$emoticonprefix" . $icon . ".png")) {
printf (STDERR "Could not open emoticon file for '$icon' for writine - $!\n");
return;
}
# UUDecode the small PNG files that represent the emoticons and dump them to
# the appropriate files in $thumbnail_dir
#
$img = unpack ("u*", $png{$type});
print IMG $img;
close (IMG);
}
###############################################################################
#
# Create a montage of images in the current directory. This image will be
# pointed to by the parent directory's index.html file to show a sort of
# "thumbnail preview" of the contents of this directory.
#
###############################################################################
sub create_montage {
my @files = @_;
my (@modfiles);
@files = &exclude_montage_files (@files);
foreach (@files) {
push (@modfiles, quotemeta ($_));
}
# If we have defined that a lesser number of "tiles" can be used in the
# montage vs. the # of files in this directory, then we'll "sample" the
# files as evenly as possible to avoid clustering of shots that might be
# similar to each other.
#
if (scalar (@modfiles) > $montage_max) {
@modfiles = &sample_files_for_montage (@modfiles);
}
if ($do_montage == 1) {
if (($modified_thumb != 0) or (! -e "$destdir/$thumbnail_dir/$montagefile")) {
my $number = $#modfiles + 1;
my $tile_x = 1;;
my $tile_y = 1;
# FIXME these both blindly expand x before expanding y
# Should this depend on some aspect ratio?
while(($tile_x * $tile_y) < $montage_min) {
$tile_x++;
$tile_y++ if (($tile_x * $tile_y) < $montage_min);
}
while(($tile_x * $tile_y) < $number) {
$tile_x++;
$tile_y++ if (($tile_x * $tile_y) < $number);
}
my $index = 0;
while (($#modfiles + 1) < ($tile_x * $tile_y)) {
if ($montage_fill eq 'blank') {
push(@modfiles, "NULL:");
} else {
push(@modfiles, $modfiles[$index]);
$index = ($index+1) % $number;
}
}
my $tile = sprintf("%dx%d", $tile_x, $tile_y);
my $geom = sprintf("%dx%d", $max_mont_thumb_x, $max_mont_thumb_y);
my $newgeom = sprintf("%dx%d", $current_thumbnail_x, $current_thumbnail_y);
print "Picked $tile array of $geom for montage\n" if ($opt_debug);
print "Creating $destdir/$thumbnail_dir/$montagefile\n";
system("montage -quality $thumb_quality -bordercolor white -transparent white -borderwidth $montage_whitespace -geometry $geom -tile $tile @modfiles $destdir/$thumbnail_dir/$montagefile");
if (($? >> 8) != 0) {
printf(STDERR "Error in creating montage file\n");
return(-1);
}
# Resize to std. thumbnail
my $image = new Image::Magick;
my $retval;
$retval = $image->Read(filename=>"$destdir/$thumbnail_dir/$montagefile");
warn "$retval" if "$retval";
$retval = $image->Resize(geometry=>$newgeom);
warn "$retval" if "$retval";
$retval = $image->Set(interlace=>Line);
warn "$retval" if "$retval";
$retval = $image->Write(filename=>"$destdir/$thumbnail_dir/$montagefile");
warn "$retval" if "$retval";
}
} else {
unlink("$destdir/$thumbnail_dir/$montagefile")
if (-e "$destdir/$thumbnail_dir/$montagefile");
}
}
sub read_stored_meta_data {
my ($tmp);
if (-r "$destdir/$indexfile") {
$tmp = &extract_meta_tag ($columnsmetatag, "$destdir/$indexfile");
# If we found data, check it against program defaults
if (defined ($tmp)) {
$current_columns = $tmp;
print "Using saved number of columns: $current_columns\n" if ! defined ($opt_columns);
}
$tmp = &extract_meta_tag ($titlemetatag, "$destdir/$indexfile");
# If we found data, check it against program defaults
if (defined ($tmp)) {
$current_titletext = $tmp;
print "Using saved title: $current_titletext\n" if ! defined ($opt_title);
}
$tmp = &extract_meta_tag ($thumbxmetatag, "$destdir/$indexfile");
# If we found data, check it against program defaults
if (defined ($tmp)) {
$current_thumbnail_x = $tmp;
print "Using saved thumbnail X size: $current_thumbnail_x\n" if ! defined ($opt_x);
}
$tmp = &extract_meta_tag ($thumbymetatag, "$destdir/$indexfile");
# If we found data, check it against program defaults
if (defined ($tmp)) {
$current_thumbnail_y = $tmp;
print "Using saved thumbnail Y size: $current_thumbnail_y\n" if ! defined ($opt_y);
}
$tmp = &extract_meta_tag ($reversemetatag, "$destdir/$indexfile");
# If we found data, check it against program defaults
if (defined ($tmp)) {
$current_reverse = $tmp;
print "Using saved reverse: $current_reverse\n" if ! defined ($opt_reverse);
}
&decide_which_md_to_store();
}
}
sub override_by_commandline {
if (defined($opt_columns)) {
$current_columns = $opt_columns;
}
if (defined($opt_title)) {
$current_titletext = $opt_title;
}
if (defined($opt_reverse)) {
$current_reverse = $opt_reverse;
}
if (defined($opt_x)) {
$current_thumbnail_x = $opt_x;
if ($current_thumbnail_x != $default_thumbnail_x) {
$opt_forceregen = 1;
}
}
if (defined($opt_y)) {
$current_thumbnail_y = $opt_y;
if ($current_thumbnail_y != $default_thumbnail_y) {
$opt_forceregen = 1;
}
}
&decide_which_md_to_store();
}
sub decide_which_md_to_store {
if ($current_columns != $default_columns) {
$write_meta_tag{$columnsmetatag}++;
}
else {
undef $write_meta_tag{$columnsmetatag};
}
if ($current_thumbnail_x != $default_thumbnail_x) {
$write_meta_tag{$thumbxmetatag}++;
}
else {
undef $write_meta_tag{$thumbxmetatag};
}
if ($current_thumbnail_y != $default_thumbnail_y) {
$write_meta_tag{$thumbymetatag}++;
}
else {
undef $write_meta_tag{$thumbymetatag};
}
if ($current_titletext ne $default_titletext) {
$write_meta_tag{$titlemetatag}++;
}
else {
undef $write_meta_tag{$titlemetatag};
}
if ($current_reverse ne $do_reverse) {
$write_meta_tag{$reversemetatag}++;
}
else {
undef $write_meta_tag{$reversemetatag};
}
}
sub initialize_current_vars {
$current_columns = $default_columns;
$current_titletext = $default_titletext;
$current_thumbnail_x = $default_thumbnail_x;
$current_thumbnail_y = $default_thumbnail_y;
$current_reverse = $do_reverse;
}
##############################################################################
#
# Just initialize the 'png' array with UUENCODED PNG files for emoticons. This
# was placed down here so as not to clutter up the top of the file where the
# other globals are initialized.
#
##############################################################################
sub init_png_array {
$png{'wink'} = <<'EOF';
MB5!.1PT*&@H````-24A$4@```!,````3!`,```"`?BO_````$E!,5$7____,
MS``S,P#___\```#__P!/FRMM`````7123E,`0.;89@````%B2T=$!?AOZ<<`
M``!F241!5'C:;8_1#8`P"$3O@Q'L!CJ!#M`FQP`FL/\J%FJ-)O+U<H&7`P!(
M5N2PN"_)TJESH'I.G6'&XFNB`<UV=5,_*]0.->:R.N?=+?A#36P6)H9!(F)Z
CI1BYC1+=-K2?9J^^SQ<7J48K([9O4:P`````245.1*Y"8((`
`
EOF
$png{'smile'} = <<'EOF';
MB5!.1PT*&@H````-24A$4@```!,````3!`,```"`?BO_````$E!,5$7__P#,
MS`!F9@#_,P````#___]]YKD%````!G123E/______P"SOZ2_`````6)+1T0%
M^&_IQP```&U)1$%4>-I-C\$-P"`,`UV)`?I@@#ZZ03M`*L&?!]E_E=H$(5`>
MEP39#MR]E%+=&T@GD*NPD\A"PWBU@4,VADQ$*J,:OHF'<14(BX]14R#0%J1+
M>!.I(&,I=(!Q3+IT2\\+N2D#A\JP)]ORKBM^`[0;1*VK3]P`````245.1*Y"
"8((`
`
EOF
$png{'frown'} = <<'EOF';
MB5!.1PT*&@H````-24A$4@```!,````3!`,```"`?BO_````'E!,5$7____,
MS`"9F0!F9@`S,P#,S#/___\S,S,```#__P`[/ZS;`````7123E,`0.;89@``
M``%B2T=$"?'9I>P```"$241!5'C:78^Q#<,P#`19:@1I`WN!`%G`@`<(8"T0
M>`.GE-R8*EV%OVU(24YA@L7A^>"31$3,G*@6!\!7=D$@\(8%!=K)Q&/#]U-4
M=AC>\;&.0I0A:YQVG$FM)\<E`X9X`F/'5A4UK304G0Z&&3->$;-N<-TJEM;0
@UQOZ@DOVMWO_7_P`Y9]*.M\PG><`````245.1*Y"8((`
`
EOF
}