Album
view release on metacpan or search on metacpan
script/album view on Meta::CPAN
#!/usr/bin/perl -w
# Author : Johan Vromans
# Created On : Tue Sep 15 15:59:04 2002
# Last Modified By: Johan Vromans
# Last Modified On: Wed Jul 8 16:55:54 2026
# Update Count : 3376
# Status : Unknown, Use with caution!
################ Common stuff ################
use strict;
# Package or program libraries, if appropriate.
# $LIBDIR = $ENV{'LIBDIR'} || '/usr/local/lib/sample';
# use lib qw($LIBDIR);
# require 'common.pl';
use Album;
# Package name.
my $my_package = 'Sciurix';
# Program name and version.
my $my_name = "album";
my $my_version = $Album::VERSION;
my $creator = qq{Created with <a href="https://metacpan.org/dist/Album">Album</a> $my_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
our $dest_dir = "."; # needs occasional 'local'
my $info_file;
my $linkthem = 1; # link orig to large, if possible
my $clobber = 0; # overwrite medium/thumbnails
my $mediumonly = 0; # only medium size (for web export)
my $forcemedium = 0; # force medium size if large is smaller
my $externalize_css = 0; # create external css files
my $externalize_formats = 0; # create external format files
my $select = 'default'; # select images
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;
our $home_link;
our $skew; # time skew
# These are not command line options.
my $journal; # create journal
my $encoding; # info_file encoding
# 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|nef|webp)};
my $movpat = qr{(?i:mpe?g|mov|avi|mp4|mts)};
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,
script/album view on Meta::CPAN
# Formats version.
my $fmt_major = 1;
my $fmt_minor = 0;
# 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::ExifTool;
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();
# Perform selection. Normally, hidden entries are ignored.
# Option --select=all overrides this.
$filelist = $filelist->filter($select);
#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_index(), d_medium()], $verbose > 1);
rmtree([d_journal()], $verbose > 1);
}
mkpath([d_index(), d_large(), d_icons()], $verbose > 1);
mkpath([d_medium()], $verbose > 1) if $medium;
# 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;
}
# Copy the button images over to the target directory.
add_button_images();
# Init formats and stylesheets.
init_formats();
init_stylesheets();
# Write the individual pages.
write_image_pages();
# Write the index pages.
script/album view on Meta::CPAN
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;
}
# Restore local scope.
$fjoin = \&fjoin;
$dest_dir = $orig_dd;
update_if_needed(d_dest($dir, $htmllist[$i]),
process_fmt($format_for{$dir},
title => $it || $tt,
css => css_for($dir),
dir => $dir,
ltop => $it2,
rtop => $tt2,
hbuttons => hbuttons(@b),
vbuttons => vbuttons(@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;
# Local scope...
my $orig_dd = $dest_dir;
local $dest_dir = ".";
local $fjoin = \&hjoin;
# Construct buttons and index selector.
if ( $num_indexes > 1 ) {
$nav{next} = ixname($x+1, 1) if $x < $num_indexes-1;
$nav{prev} = ixname($x-1, 1) if $x > 0;
if ( $lib_common ne "" ) {
$nav{up} = join("/","..",$lib_common,"index.html");
}
elsif ( $home_link ) {
$nav{up} = join("/","..",$home_link);
}
push(@b, button("up", $nav{up}, 1, 1)) if $nav{up};
push(@b,
button("first", ixname(0, 1), 1, $x > 0 ),
button("prev", ixname($x-1, 1), 1, $x > 0 ),
button("next", ixname($x+1, 1), 1, $x < $num_indexes-1),
button("last", ixname($num_indexes-1, 1), 1, $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;
unshift(@ixlist, $ixlist[0]-1)
if @ixlist < IXLIST && $ixlist[0] > 0;
}
}
$t .= "...\n" if $ixlist[0];
foreach ( @ixlist ) {
if ( $_ == $x ) {
$t .= ($x+1) . "\n";
}
else {
my $el = $filelist->byseq(($_ * $index_rows * $index_columns) + 1);
$t .= "<a";
if ( my $tag = $el->tag ) {
$t .= " title=\"$tag\"";
}
$t .= " href='" . ixname($_, 1) . "'>" . ($_+1) . "</a>\n";
}
}
$t .= "...\n" if $ixlist[-1] < $num_indexes-1;
}
elsif ( $lib_common ) {
push(@b, button("up", join("/","..",$lib_common,"index.html"), 1, 1));
$nav{up} = join("/","..",$lib_common,"index.html");
}
my $first_in_row = $x * $entries_per_page;
if ( $journal && exists $jnltags{$filelist->byseq($first_in_row+1)->tag} ) {
my $page = d_up(d_journal("jnl".$jnltags{$filelist->byseq($first_in_row+1)->tag} .
".html#img" . sprintf("%04d", $first_in_row+1)));
push(@b, button("journal", $page, 1, 1));
$nav{jnl} = $page;
}
# Construct the actual index part.
my $cc = "<table class='outer'>\n";
script/album view on Meta::CPAN
sub indexicon {
my @imgs;
for ( my $i = 0; $i < $index_rows*$index_columns; $i++ ) {
next if $i >= $num_entries;
my $el = $filelist->byseq($i+1);
my $file = $el->dest_name;
my $img;
if ( $el->type == T_REF ) {
$img = $el->assoc_name;
}
else {
$img = $el->type == T_MPG ? $el->assoc_name : $file;
$img = d_index($img);
}
push(@imgs, $img);
}
my $iconfile = "icon.jpg";
my $ii = cache_entry(" indexicon ");
if ( -f $iconfile && $ii && $ii->dest_name eq "@imgs" ) {
return 0;
}
my $el = new ImageInfo($iconfile);
$el->dest_name("@imgs");
cache_entry(" indexicon ", $el);
$cache_update++;
my $image = new Image::Magick->new;
foreach ( @imgs ) {
$image->Read($_);
}
my $width = $thumb;
my $height = int($thumb*0.75);
$image = $image->Montage(tile=>"${index_columns}x${index_rows}",
texture=>"xc:gray90");
$image->Resize(geometry=>"${width}x${height}");
$image->Write($iconfile);
1;
}
################ Subroutines ################
sub app_options {
my $help = 0; # handled locally
my $ident = 0; # handled locally
my $sel; # handled locally;
if ( !GetOptions(
# Run time options.
'clobber' => \$clobber,
'dcim=s' => sub { $import_dir = $_[1]; $import_exif++ },
'exif' => \$import_exif,
'import=s' => \$import_dir,
'info=s' => \$info_file,
'link!' => \$linkthem,
'update' => \$update,
'mediumonly' => \$mediumonly,
'select=s' => \$sel,
'extcss' => \$externalize_css,
'extformats' => \$externalize_formats,
# Album options. Can also be set in info/config files.
'captions=s' => \$caption,
'cols|columns=i' => \$index_columns,
'icon!' => \$icon,
'medium' => sub { $medium = 0 },
'mediumsize=i' => \$medium,
'rows=i' => \$index_rows,
'thumbsize=i' => \$thumb,
'title=s' => \$album_title,
'home=s' => \$home_link,
'skew=i' => \$skew,
# Miscellaneous.
'debug' => \$debug,
'help|?' => \$help,
'ident' => \$ident,
'quiet' => sub { $verbose = 0 },
'test' => \$test,
'trace' => \$trace,
'verbose+' => \$verbose,
)
or $help
or @ARGV > 1
or @ARGV && ! -d $ARGV[0]
)
{
app_usage(2);
}
app_ident() if $ident;
$dest_dir = @ARGV ? shift(@ARGV) : ".";
$dest_dir =~ s;^\./;;;
if ( $import_dir ) {
die("$import_dir: Not a directory\n")
unless -d $import_dir;
$import_dir =~ s;^\./;;;
}
set_selector($sel);
}
sub app_ident {
print STDERR ("This is $my_package [$my_name $my_version]\n");
}
sub app_usage {
my ($exit) = @_;
app_ident();
print STDERR heredoc(<<" EndOfUsage", 4);
Usage: $0 [options] [ directory ]
Album:
--info XXX description file, default "@{[DEFAULTS->{info}]}" (if it exists)
--title XXX album title, default "@{[DEFAULTS->{title}]}"
--[no]icon [do not] produce an album icon
--home XXX up link for index pages
Index:
--cols NN number of columns per page, default @{[DEFAULTS->{indexcols}]}
--rows NN number of rows per page, default @{[DEFAULTS->{indexrows}]}
--thumbsize NNN the max size of thumbnail images, default @{[DEFAULTS->{thumbsize}]}
--captions XXX f: filename s: size c: description t: tag
Medium:
--medium produce medium sized images of size @{[DEFAULTS->{mediumsize}]}
--mediumsize NNN the max size of medium sized images, default @{[DEFAULTS->{mediumsize}]}
--mediumonly ignore large images and links (for web export)
Importing:
--import XXX original images
--exif use w/ EXIF info, if possible
--dcim XXX as --import with --exif
--update add new entries from import, if needed
--[no]link [do not] link to original, instead of copying. Default is link.
Miscellaneous:
--clobber recreate everything (except large)
--clobbercss recreate (overwrite) style sheets
--select=XXX select images (default, all, hidden, tag:...)
--test verify only
--help this message
--ident show identification
--verbose verbose information
EndOfUsage
exit $exit if defined $exit && $exit != 0;
}
sub set_selector {
my $sel = shift || 'default';
my $tag;
if ( $sel =~ /^(tag):(.+)/i ) {
$sel = 'tag:...';
if ( $2 =~ /^\/(.+?)\/?$/ ) {
$tag = $1;
}
else {
$tag = quotemeta($2);
$tag =~ s/(\\ )+/\\s+/g;
}
warn("tag = \"$tag\"\n");
}
my %selectors =
( default => sub { ! $_[0]->hidden },
all => sub { 1 },
hidden => sub { $_[0]->hidden },
'tag:...' => sub { $_[0]->tag =~ $tag }
);
die("Unknown selection: $sel\n".
"Possible values are: ", join(", ", sort keys %selectors), ".\n")
unless $select = $selectors{lc($sel)};
}
################ Modules ################
package ImageInfo;
my @std_fields;
my @exif_fields;
my $exif_rot;
INIT {
@std_fields = qw(type seq next prev hidden
dest_name orig_name assoc_name
timestamp file_size medium_size
tag description annotation
rotation mirror);
@exif_fields = qw(DateTime DateTimeOriginal ExifImageLength ExifImageWidth
ExposureMode ExposureProgram ExposureTime
FNumber Flash FocalLength FocalLengthIn35mmFormat
FocusMode ISOSpeedRatings
ImageDescription Make Model
MeteringMode SceneCaptureType Orientation
CreateDate MediaCreateDate TimeZone
WhiteBalance
height width file_ext);
$exif_rot = { top_left => [ 0, '' ], # 1: no corr. needed
top_right => [ 0, 'v' ], # 2: flop (V)
bot_right => [ 180, '' ], # 3: 180
bot_left => [ 0, 'h' ], # 4: flip (H)
left_top => [ 90, 'h' ], # 5: flip 90
right_top => [ 90, '' ], # 6: 90
right_bot => [ 90, 'v' ], # 7: flop 90
left_bot => [ 270, '' ], # 8: 270
'Rotate 270 CW' => [ 270, '' ], # 270 CW = 90 CCW
'Rotate 180' => [ 180, '' ], # 180 CW = 180 CCW
'Rotate 90 CW' => [ 90, '' ], # 90 CW = 270 CCW
};
}
my $largepat;
sub basename_nolarge {
my ($f) = @_;
unless ( $largepat ) {
$largepat = quotemeta(::d_large());
$largepat = qr;^$largepat[/\\];;
}
$f =~ s;$largepat;;;
$f;
}
sub new {
my ($pkg, $file) = @_;
$pkg = ref($pkg) if ref($pkg);
my $self = { $file ?
(orig_name => $file,
dest_name => basename_nolarge($file)) : (),
description => "",
( run in 0.709 second using v1.01-cache-2.11-cpan-e623d60df62 )