Album
view release on metacpan or search on metacpan
script/album view on Meta::CPAN
#!/usr/bin/perl -w
my $RCS_Id = '$Id: album.pl,v 1.86 2007/04/02 09:07:50 jv Exp $ ';
# Author : Johan Vromans
# Created On : Tue Sep 15 15:59:04 2002
# Last Modified By: Johan Vromans
# Last Modified On: Mon Apr 2 11:07:05 2007
# Update Count : 2830
# Status : Unknown, Use with caution!
################ Common stuff ################
$VERSION = "1.06";
use strict;
# Package or program libraries, if appropriate.
# $LIBDIR = $ENV{'LIBDIR'} || '/usr/local/lib/sample';
# use lib qw($LIBDIR);
# require 'common.pl';
# Package name.
my $my_package = 'Sciurix';
# Program name and version.
my ($my_name, $my_version) = $RCS_Id =~ /: (.+).pl,v ([\d.]+)/;
# Tack '*' if it is not checked in into RCS.
$my_version .= '*' if length('$Locker: $ ') > 12;
my $creator = "Created with <a href=\"http://search.cpan.org/~jv/Album/\">Album</a> $::VERSION";
################ Command line parameters ################
use Getopt::Long 2.13;
# Command line options.
my $import_exif = 0;
my $import_dir;
my $update = 0; # add new from large/import
my $dest_dir = ".";
my $info_file;
my $linkthem = 1; # link orig to large, if possible
my $clobber = 0;
my $mediumonly = 0; # only medium size (for web export)
my $externalize_formats = 0; # create external format files
my $verbose = 1; # verbose processing
# These are left undefined, for set_defaults. Note: our, not my.
our $index_columns;
our $index_rows;
our $thumb;
our $medium; # medium size, between large and small
our $album_title;
our $caption;
our $datefmt;
our $icon;
our $locale;
our $lib_common;
# These are not command line options.
my $journal; # create journal
# Development options (not shown with -help).
my $debug = 0; # debugging
my $trace = 0; # trace (show process)
my $test = 0; # test mode.
# Process command line options.
app_options();
# Post-processing.
$trace |= ($debug || $test);
$dest_dir =~ s;^\./;;;
$import_dir =~ s;^\./;; if $import_dir;
################ Presets ################
use constant DEFAULTS => { info => "info.dat",
title => "Photo Album",
medium => 0,
mediumsize => 915,
thumbsize => 200,
indexrows => 3,
indexcols => 4,
caption => "fct",
captionmin => "f",
dateformat => '%F',
icon => 0,
};
my $TMPDIR = $ENV{TMPDIR} || $ENV{TEMP} || '/usr/tmp';
my $picpat = qr{(?i:jpe?g|png|gif)};
my $movpat = qr{(?i:mpe?g|mov|avi)};
my $xtrpat = qw{(?i:html?)};
my $suffixpat = qr{\.$picpat|$movpat};
my $xsuffixpat = qr{\.$picpat|$movpat|$xtrpat};
my %capfun = ('c' => \&c_caption,
'f' => \&f_caption,
's' => \&s_caption,
't' => \&t_caption,
);
my $br = br();
# Max.number of clickable index numbers (should be odd).
use constant IXLIST => 15;
# Helper programs
my $prog_jpegtran = findexec("jpegtran");
my $prog_mplayer = findexec("mplayer");
my $prog_mencoder = findexec("mencoder");
################ The Process ################
use File::Spec;
use File::Path;
use File::Basename;
use Time::Local;
use Image::Info;
use Image::Magick;
use Data::Dumper;
use POSIX qw(locale_h strftime);
use locale;
# The files already there, if any.
my $gotlist = new FileList;
# The files in the import dir, if any.
my $implist = new FileList;
# The list of files, in the order to be processed.
# This list is initialy filled from info.dat, and (optionally) updated
# from the other lists.
my $filelist = new FileList;
# This is the list of all entries to be journalled (all images, plus
# possible interspersed loose annotations).
my @journal;
# Load cached info, if possible.
load_cache();
# Load image names and info from the info file, if any.
# This produces the initial file list.
load_info();
#print STDERR Data::Dumper->Dump([$filelist],[qw(filelist)]);
# Load image names and info for files we already got.
load_files() if -d d_large();
#print STDERR Data::Dumper->Dump([$gotlist],[qw(gotlist)]);
# Load image names and info for files we can import.
load_import() if $import_dir && -d $import_dir;
#print STDERR Data::Dumper->Dump([$implist],[qw(implist)]);
# Apply defaults to unset parameters.
set_defaults();
# warn("date => ", strftime($datefmt, localtime(time)), "\n");
# Verify and update the file list.
my $added = update_filelist();
#print STDERR Data::Dumper->Dump([$filelist],[qw(filelist)]);
my $num_entries = $filelist->tally;
print STDERR ("Number of entries = $num_entries",
$added ? " ($added added)" : "",
"\n") if $verbose > 1;
die("Nothing to do?\n") unless $num_entries > 0;
exit(0) if $test;
# Clean up and create directories.
if ( $clobber ) {
rmtree([d_thumbnails(), d_medium()], $verbose > 1);
}
mkpath([d_large(), d_thumbnails(), d_icons(), d_css()], $verbose > 1);
mkpath([d_medium()], $verbose > 1) if $medium;
# Copy the button images over to the target directory.
add_button_images();
# Create the default style sheets, if necessary.
add_stylesheets();
# Copy images in place, rotate if necessary, and create the thumbnails.
prepare_images();
# Update cache.
update_cache();
my $cache_update = 0;
my $entries_per_page = $index_columns*$index_rows;
my $num_indexes = int(($num_entries - 1) / $entries_per_page) + 1;
my $fn = "img0000";
# Cleanup excess files.
for ( 0 ) {
my $excess = $fn++ . ".html";
unlink(d_medium($excess));
unlink(d_large($excess)) or last;
}
# Map file names to html pages. Start with 1 to match "image N of M".
my @htmllist;
for my $i ( 0 .. $num_entries-1 ) {
$htmllist[$i] = $fn++ . ".html";
}
# Cleanup excess files.
for (my $i = $num_entries ; ; $i++ ) {
my $excess = $fn++ . ".html";
unlink(d_medium($excess));
unlink(d_large($excess)) or last;
}
# Init formats.
init_formats();
# Write the individual pages.
write_image_pages();
# Write the index pages.
write_index_pages();
# Write the journal.
write_journal_pages();
# Create index icon.
create_index_icon();
# Final update, if needed.
update_cache() if $cache_update;
exit 0;
################ Subroutines ################
# Image types.
use constant T_JPG => 1;
use constant T_MPG => 2;
use constant T_VOICE => 3; # still image + sound
# Pseudo types.
use constant T_PSEUDO => 0;
use constant T_TAG => -1;
use constant T_ANN => -2;
use constant T_REF => -3;
# List of possible subdirs to process.
my @subdirs;
# Journal tags
my %jnltags;
# Note: the HTML generators use the file names relatively.
sub fjoin { File::Spec->catfile(@_); }
sub d_dest { unshift(@_, $dest_dir) unless $dest_dir eq ".";
fjoin(@_); }
sub d_large { unshift(@_, "large"); goto &d_dest; }
sub d_medium { unshift(@_, "medium"); goto &d_dest; }
sub d_thumbnails { unshift(@_, "thumbnails"); goto &d_dest; }
sub d_journal { unshift(@_, "journal"); goto &d_dest; }
sub d_destc { unshift(@_, $lib_common) if $lib_common ne ""; goto &d_dest; }
sub d_icons { unshift(@_, "icons"); goto &d_destc; }
sub d_css { unshift(@_, "css"); goto &d_destc; }
sub d_fmt { unshift(@_, "formats"); goto &d_destc;}
my %optcfg; # option set from config files
sub setopt {
no strict qw(refs);
return if defined(${$_[0]});
print STDERR ("setopt $_[0] -> $_[1]\n") if $trace;
${$_[0]} = $_[1];
$optcfg{$_[0]} = 1;
}
sub parse_line {
local ($_) = (@_);
my $err = 0;
if ( /^!?\s*(\S.*)/ ) {
$_ = $1;
if ( /^title\s+(.*)/ ) {
setopt("album_title", $1);
}
elsif ( /^page\s+(\d+)x(\d+)/ ) {
setopt("index_rows", $1);
setopt("index_columns", $2);
}
elsif ( /^thumbsize\s*(\d+)/ ) {
setopt("thumb", $1);
}
elsif ( /^mediumsize\s*(\d+)/ ) {
setopt("medium", $1);
}
elsif ( /^medium\s*(-?\d+)?/ ) {
setopt("medium", $1 || DEFAULTS->{mediumsize});
}
elsif ( /^dateformat\s*(.*)/ ) {
setopt("datefmt", $1);
}
elsif ( /^caption\s*(.*)/ ) {
setopt("caption", $1);
}
elsif ( /^icon\s*(.*)/ ) {
setopt("icon", defined($1) && length($1) ? $1 : 1);
}
script/album view on Meta::CPAN
<td align='right' valign='top'>
<p class='ftr'>
$rbot
</p>
</td>
</tr>
</table>
</body>
</html>
EOD
$fmt_large_page = $load->("large.fmt", $fmt_image_page);
$fmt_medium_page = $load->("medium.fmt", $fmt_image_page);
# Format for journal pages (mostly).
#
# Variables:
#
# $title
# $tag
# $vbuttons / $hbuttons
# $journal
# $jscript
$fmt_journal_page = $load->("journal.fmt", heredoc(<<' EOD', 4));
<?xml version="1.0" encoding="iso-8859-15"?>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<link rel='stylesheet' href='../${lib_common}css/journal.css'>
<title>$title</title>
$jscript
</head>
<body>
<table class='outer'>
<tr class='grey'>
<td>
<p class='hd'>
$tag
</p>
</td>
<td align='right'>
$hbuttons
</td>
</tr>
$journal
<tr class='grey'>
<td> </td>
<td align='right'>
$hbuttons
</td>
</tr>
</table>
</body>
</html>
EOD
print STDERR ("\n") if $did;
}
sub process_fmt {
my ($fmt, %map) = @_;
$fmt =~ s/^(.*?)\$(\w+)\b/$1.indent($map{$2}, length($1))/gme;
$fmt;
}
################ Helpers for Image/Index/Journal pages ################
sub jscript {
my (%nav) = @_;
my $next = $nav{next};
my $prev = $nav{prev};
my $up = $nav{up};
my $down = $nav{down};
my $idx = $nav{idx};
my $jnl = $nav{jnl};
my $js = heredoc(<<" EOD", 4);
<script type='text/javascript'>
function handleKey(e) {
var key;
if ( e == null ) { // IE
key = event.keyCode
}
else { // Mozilla
if ( e.altKey || e.ctrlKey ) {
return true
}
key = e.which
}
switch(key) {
EOD
$js .= " case 8: window.location = '$prev'; break // Backspace\n" if $prev;
$js .= " case 32: window.location = '$next'; break // Space\n" if $next;
$js .= " case 13: window.location = '$down'; break // Enter\n" if $down;
$js .= " case 117: window.location = '$up'; break // 'u'\n" if $up;
$js .= " case 100: window.location = '$idx'; break // 'd'\n" if $idx;
$js .= " case 106: window.location = '$jnl'; break // 'j'\n" if $jnl;
$js .= heredoc(<<" EOD", 4);
default:
}
return false
}
document.onkeypress = handleKey
</script>
EOD
$js;
}
sub button($$;$$) {
my ($tag, $link, $level, $active) = @_;
my $Tag = ucfirst($tag);
$level = 0 unless defined $level;
$active = 1 unless defined $active;
$tag .= "-gr" unless $active;
$level = "../" x $level;
$level .= $lib_common . "/" if $lib_common ne "";
my $b = img("${level}icons/$tag.png", align => "top",
script/album view on Meta::CPAN
$imglink = "<a href='../large/" . $el->dest_name . "'>" .
img($file, alt => "[Click to play movie]", border => 2) .
"</a>";
$nav{down} = "../large/" . $el->dest_name;
}
else {
$imglink = "<a href='../large/".$htmllist[$i]."'>" .
img($file, alt => "[Click for bigger image]", border => 2) .
"</a>";
$nav{down} = "../large/" . $htmllist[$i];
}
}
else {
if ( $movie ) {
$imglink = "<a href='" . $el->dest_name . "'>" .
img($file, alt => "[Click to play movie]", border => 2) .
"</a>";
}
else {
$imglink = img($file, alt => "[Image]", border => 2);
}
$nav{up} = "../medium/" . $htmllist[$i];
}
my $auxright = htmln($el->dest_name);
my $s = size_info($el);
$auxright .= " ($s)" if $s;
$auxright .= " $creator" if $creator;
my $auxleft = htmln($el->tag || "");
my $it2 = $it;
if ( $el->Make ) { # EXIF info
$it2 = "<a href='#' class='info'>" . $it .
"<span>" .
"<table border='1' width='100%'>\n" .
restyle_exif($el) . "</table>\n" .
"</span></a>";
}
my $tt2 = $tt;
if ( $dir eq "medium" && $el->annotation ) {
my @a = UNIVERSAL::isa($el->annotation, "ARRAY")
? @{$el->annotation} : ($el->annotation);
my $t = "";
foreach ( reverse(@{$el->annotation}) ) {
next unless $_;
my $x = $_; # copy
$x = html($x) unless $x =~ /^</;
$t .= "<p>\n" if $t;
$t .= $x;
}
$tt2 = "<a href='#' class='info'>" . $tt .
"<span>" .
"<table border='1' width='100%'>\n" .
"<tr><td>$t</td></tr>" .
"</table>\n" .
"</span></a>" if $t;
}
update_if_needed(d_dest($dir, $htmllist[$i]),
process_fmt($dir eq "medium" ?
$fmt_medium_page :
$fmt_large_page,
title => $it,
dir => $dir,
ltop => $it2,
rtop => $tt2,
hbuttons => join("", @b),
vbuttons => join("$br\n", @b),
jscript => jscript(%nav),
image => $imglink,
lbot => $auxleft,
rbot => $auxright,
));
}
################ Index Pages ################
sub write_index_pages {
print STDERR ("Creating ", $num_indexes, " index page",
$num_indexes == 1 ? "" : "s", "\n") if $verbose > 1;
my $mod = 0;
for my $i ( 0 .. $num_indexes-1 ) {
write_index_page($i) && $mod++;
}
uptodate("index", $mod) if $verbose > 1;
# Cleanup excess indices.
for (my $i = $num_indexes ; ; $i++ ) {
unlink(d_dest("index$i.html")) or last;
}
}
sub write_index_page {
my ($x) = @_;
my $tt = $album_title.": Index"; # left title
my $t = ""; # right (index select)
my @b; # buttons
my %nav;
# Construct buttons and index selector.
if ( $num_indexes > 1 ) {
$nav{next} = ixname($x+1) if $x < $num_indexes-1;
$nav{prev} = ixname($x-1) if $x > 0;
$nav{up} = join("/",$lib_common,"index.html") if $lib_common ne "";
push(@b, button("up", join("/",$lib_common,"index.html"), 0, 1))
unless $lib_common eq "";
push(@b,
button("first", ixname(0), 0, $x > 0 ),
button("prev", ixname($x-1), 0, $x > 0 ),
button("next", ixname($x+1), 0, $x < $num_indexes-1),
button("last", ixname($num_indexes-1), 0, $x < $num_indexes-1));
$tt .= " " . ($x+1) . " of $num_indexes";
my @ixlist = ( 0..$num_indexes-1 );
if ( @ixlist > IXLIST ) {
@ixlist = ( $x );
while ( @ixlist < IXLIST ) {
push(@ixlist, $ixlist[-1]+1)
if $ixlist[-1]+1 < $num_indexes;
script/album view on Meta::CPAN
if ( $journal && exists $jnltags{$filelist->byseq($first_in_row+1)->tag} ) {
my $page = "journal/jnl". $jnltags{$filelist->byseq($first_in_row+1)->tag} .
".html#img" . sprintf("%04d", $first_in_row+1);
push(@b, button("journal", $page, 0, 1));
$nav{jnl} = $page;
}
# Construct the actual index part.
my $cc = "<table class='outer'>\n";
for ( my $i = 0; $i < $index_rows; $i++, $first_in_row += $index_columns ) {
if ( $first_in_row < $num_entries ) {
$cc .= " <tr>\n";
for ( my $j = 0; $j < $index_columns; $j++ ) {
my $this = $first_in_row + $j;
if ( $this < $num_entries ) {
my $el = $filelist->byseq($this+1);
my $file = $el->dest_name;
my $img;
my $base;
my $target = "";
if ( $el->type == T_REF ) {
$img = $el->assoc_name;
$base = $el->orig_name;
$target = " target=\"_blank\"";
}
else {
$img = $el->type == T_MPG ? $el->assoc_name : $file;
$img = "thumbnails/$img";
$base = $medium ? "medium/" : "large/";
$base .= $htmllist[$this];
}
$cc .= heredoc(<<" EOD", 16);
<td align='center' valign='bottom'>
<table class='inner'>
<tr>
<td align='center'>
<a href='$base'$target>@{[img($img, alt => "[Click for bigger image]", border => 0)]}</a>
</td>
</tr>
<tr>
<td align='center'>
<p class='ft'>@{[join($br, map { $capfun{$_}->($el) } split(//, $caption))]}</p>
</td>
</tr>
</table>
</td>
EOD
}
else {
$cc .= " <td width='$thumb'> </td>\n";
}
}
$cc .= " </tr>\n";
}
}
$cc .= "</table>\n";
update_if_needed(d_dest(ixname($x)),
process_fmt($fmt_index_page,
title => $tt,
ltop => $tt,
rtop => $t,
hbuttons => join("", @b),
vbuttons => join("$br\n", @b),
jscript => jscript(%nav),
contents => $cc,
));
}
################ Journal Pages ################
sub write_journal_pages {
return unless $journal;
print STDERR ("Creating ", $journal, " journal page",
$journal == 1 ? "" : "s", "\n") if $verbose > 1;
mkpath([d_journal()], $verbose > 1);
my $mod = write_journal();
uptodate("journal", $mod) if $verbose > 1;
}
sub write_journal {
my $jname = sub { sprintf("jnl%04d.html", shift) };
my @ann;
my $seq = 1;
my $x = 0;
my $tag;
my $flush = sub {
my $jnl = "";
my $ix = int($seq / ($index_rows * $index_columns)) || "";
foreach my $e ( @ann ) {
my $t = $e->annotation;
$t = (UNIVERSAL::isa($t, "ARRAY") ? $t->[0] : $t) || "";
$t = html($t) unless $t =~ /^</i;
if ( $e->type == T_ANN ) {
$jnl .= "<tr>\n".
" <td class='twocol' colspan='2' valign='middle' align='left'>\n".
" " . indent($t, 4) . "\n".
" </td>\n".
"</tr>\n";
next;
}
# We cannot use $el->seq, since that's the info.dat order
# which includes the skipped entries.
my $dst = ($e->type == T_REF) ? $e->assoc_name :
d_thumbnails($e->type == T_MPG ? $e->assoc_name : $e->dest_name);
my $img = "<a name='" . sprintf("img%04d", $seq) . "' " .
($e->type == T_REF ? " target=\"_blank\"" : "").
"href='../" .
($e->type == T_REF ? $e->dest_name : d_medium(sprintf("img%04d.html", $seq))) .
"' border='0'>" .
"<img src='../" .
$dst . "'></a>";
$jnl .= "<tr>\n".
" <td valign='middle' align='left'>\n".
" " . indent($t || " ", 4) . "\n".
" </td>\n".
" <td valign='top' align='left'>\n".
" " . indent($img, 4) . "\n".
" </td>\n".
"</tr>\n";
$seq++;
}
my @b = ( button("first", $jname->(1), 1, $x > 0 ),
button("prev", $jname->($x), 1, $x > 0 ),
button("next", $jname->($x+2), 1, $x < $journal-1),
button("last", $jname->($journal), 1, $x < $journal-1),
button("index", "../index$ix.html", 1, 1 ),
);
my %nav = ( up => "../index$ix.html",
idx => "../index$ix.html" );
$nav{prev} = $jname->($x) if $x > 0;
$nav{next} = $jname->($x+2) if $x < $journal-1;
$x++;
update_if_needed(d_journal("jnl" . $jnltags{$tag} . ".html"),
process_fmt($fmt_journal_page,
title => "Journal: " . htmln($tag),
tag => htmln($tag),
hbuttons => join("", @b),
vbuttons => join("$br\n", @b),
journal => $jnl,
jscript => jscript(%nav),
));
};
my $mod = 0;
foreach my $el ( @journal ) {
my $t = $el->type;
if ( $t == T_TAG ) {
$flush->() && $mod++ if @ann;
$tag = $el->tag;
@ann = ();
}
else {
push(@ann, $el);
}
}
$flush->() && $mod++ if @ann;
$mod;
}
################ ################
#### Persistent info (cache) helpers.
{ my $cache;
my @stats; INIT { @stats = (0, 0, 0); }
sub load_cache {
$cache = new ImageInfoCache
((!$clobber && -s d_dest(".cache")) ? d_dest(".cache") : undef);
}
sub update_cache {
$cache->store(d_dest(".cache"));
}
sub cache_entry {
if ( @_ == 1 ) {
$stats[0]++;
my $ii = $cache->entry(@_);
$stats[1]++ if $ii;
warn("Cache miss: $_[0]\n") if !$ii && $trace;
return $ii;
}
$stats[2]++;
$cache->entry(@_);
}
END {
print STDERR ("Cache: store = $stats[2], lookup = $stats[0], hits = $stats[1]\n")
if $trace;
}
}
#### Miscellaneous.
sub findexec {
my ($bin) = @_;
foreach ( File::Spec->path ) {
my $try = File::Spec->catfile($_, $bin);
return $try if -x $try;
}
undef;
}
sub squote {
my ($t) = @_;
$t =~ s/([\\\"])/\\$1/g;
$t = '"'.$t.'"' if $t =~ /[^-\w.\/]/;
$t;
}
################ Button Images ################
sub add_button_images {
# Extract button images from DATA section.
my $out = do { local *OUT; *OUT };
my $name;
my $doing = 0;
my $did = 0;
while ( <DATA> ) {
if ( $doing ) { # uudecoding...
if ( /^Xend/ ) {
close($out);
$doing = 0; # Done
next;
}
# Select lines to process.
next if /[a-z]/;
next unless /^X(.*)/s;
$_ = $1;
next unless int((((ord() - 32) & 077) + 2) / 3)
== int(length() / 4);
# Decode.
print $out unpack("u",$_);
next;
}
# Otherwise, search for the uudecode 'begin' line.
if ( /^Xbegin\s+\d+\s+(.+)$/ ) {
next if !$clobber && -s d_icons($1);
print STDERR ("Creating icons: ") if $verbose > 1 && !defined($name);
$did++;
$name = d_icons($1);
print STDERR ("$1 ") if $verbose > 1;
open($out, ">$name");
binmode($out);
$doing = 1; # Doing
next;
}
}
print STDERR ("\n") if $verbose > 1;
if ( $doing ) {
die("Error in DATA: still processing $name\n");
unlink($name);
}
}
################ Style Sheets ################
my $add_stylesheet_msg;
sub add_stylesheets {
my $css_fontfam = "font-family: Verdana, Arial, Helvetica";
my $WHITE = "#FFFFFF";
my $BLACK = "#000000";
my $RED = "#FF0000";
my $LGREY = "#E0E0E0";
my $MGREY = "#D0D0D0";
my $DGREY = "#C0C0C0";
$add_stylesheet_msg = 0;
add_stylesheet("common", heredoc(<<" EOD", 4));
body {
font-size: 80%; $css_fontfam;
text: $BLACK;
background: $DGREY;
}
td {
font-size: 80%; $css_fontfam;
}
p.hdl, p.hdr {
font-size: 140%; font-weight: bold;
$css_fontfam;
}
p.ftl, p.ftr {
font-size: 80%; $css_fontfam;
}
a:link {
color: $BLACK; text-decoration: none;
}
a:visited {
color: $BLACK; text-decoration: none;
}
a:active {
color: $RED; text-decoration: none;
}
EOD
add_stylesheet("index", heredoc(<<" EOD", 4));
\@import "common.css";
a.info {
position: relative; z-index: 24; background-color: $LGREY;
color: $BLACK; text-decoration:none;
}
a.info:hover {
z-index: 25; background-color: $LGREY;
}
a.info span {
display: none;
}
a.info:hover span {
display: block;
position: absolute; top: 2em; left: 2em; width: 25em;
( run in 1.158 second using v1.01-cache-2.11-cpan-39bf76dae61 )