Album
view release on metacpan or search on metacpan
script/album view on Meta::CPAN
$err++;
}
$err;
}
sub set_defaults {
# Load settings from user files.
my $sl;
unless ( $sl = $ENV{ALBUMCONFIG} ) {
$sl = ".albumrc";
$sl .= ":".$ENV{HOME}."/.albumrc" if $ENV{HOME};
}
foreach my $cf ( split(/:/, $sl) ) {
unless ( -f $cf ) {
warn("$cf: $!\n") if $ENV{ALBUMCONFIG};
next;
}
open(my $fh, "<$cf") || next;
warn("parsing: $cf\n") if $trace;
my $err = 0;
while ( <$fh> ) {
next if /^\s*#/;
next unless /\S/;
$err += parse_line($_);
}
close($fh);
die("Errors in config file $cf, aborted\n") if $err;
}
# Finally, apply defaults if necessary.
warn("apply defaults\n") if $trace;
setopt("album_title", DEFAULTS->{title});
setopt("index_rows", DEFAULTS->{indexrows});
setopt("index_columns", DEFAULTS->{indexcols});
setopt("thumb", DEFAULTS->{thumbsize});
setopt("datefmt", DEFAULTS->{dateformat});
setopt("icon", DEFAULTS->{icon});
$medium = DEFAULTS->{mediumsize} if defined($medium) && !$medium || $mediumonly;
$medium = 0 if defined($medium) && $medium < 0;
# Caption values.
setopt("caption", DEFAULTS->{( -s $info_file || $import_dir) ?
"caption" : "captionmin" });
die("Invalid value for caption: $caption\n")
unless $caption =~ /^[fsct]*$/i;
$caption = lc($caption);
if ( $locale ) {
setlocale(LC_TIME, $locale);
setlocale(LC_COLLATE, $locale);
}
if ( defined($lib_common) ) {
$lib_common =~ s;/+$;;;
}
$lib_common ||= "";
}
sub load_info {
my %typemap = ( 'p' => T_JPG, 'm' => T_MPG, 'v' => T_VOICE );
# If an info has been supplied, it'd better exist.
if ( $info_file ) {
die("$info_file: $!\n") unless -s $info_file;
}
else {
# Try default.
$info_file = d_dest(DEFAULTS->{info});
unless ( -s $info_file ) {
my $add_new; $add_new++ if $import_dir;
my $add_src; $add_src++ if -d d_large();
print STDERR ("No ", DEFAULTS->{info});
print STDERR (", adding images from ") if $add_src || $add_new;
print STDERR (d_large()) if $add_src;
print STDERR (" and ") if $add_src && $add_new;
print STDERR ($import_dir) if $add_new;
print STDERR ("\n");
return;
}
}
my $err = 0;
my $file;
my $tag;
my $fh = do { local *FH; *FH };
die("$info_file: $!\n")
unless open($fh, $info_file);
warn("parsing: $info_file\n") if $trace;
my $el;
my %dirs;
while ( <$fh> ) {
chomp;
next if /^\s*#/;
next unless /\S/;
if ( /^\s+/ && $el ) {
$el->description($el->description . "\n" . $_);
next;
}
if ( /^!\s*(\S.*)/ ) {
$_ = $1;
if ( /^tag\s*(.*)/ ) {
$tag = $1;
$tag =~ s/\s$//;
$tag =~ s/\s+/ /g;
}
elsif ( /^subdirs\s*(.*)/ ) {
foreach ( split(' ', $1)) {
$dirs{$_}++;
}
}
elsif ( /^journal\s*(.*)/ ) {
if ( $filelist->tally ) {
warn("\"!journal\" must precede image info\n");
$err++;
}
load_info_journal($err, $fh);
return;
}
else {
$err += parse_line("!".$_);
}
next;
}
($file, $a) = $_ =~ /^(.+?$xsuffixpat)\s*(.*)/;
my $rotate;
my $type = T_JPG;
my $assc;
while ( $a && $a =~ /^-(\w):(\S+)\s*(.*)/ ) {
if ( lc($1) eq 'o' ) {
$rotate = 90 * ($2 % 4);
}
elsif ( lc($1) eq 'i' ) {
$assc = fjoin(basename($file), $2);
unless ( -s $assc && -r _ ) {
warn("$file (info): $assc [$!]\n");
undef $assc;
}
}
elsif ( lc($1) eq 't' ) {
$type = $typemap{lc($2)}
or warn("$file (info): Illegal type: $2\n"), $err++;
}
$a = $3;
}
$el = new ImageInfo($file);
$el->type($type);
$el->description($a) if $a;
$el->tag($tag) if $tag;
$el->_rotation($rotate) if defined($rotate);
if ( $file =~ /^(.+)\.$movpat$/i ) {
$el->type(T_MPG);
$el->assoc_name($1."s.jpg"); # associates still image
}
elsif ( $type == T_VOICE ) {
(my $t = $file) =~ s/\.jpg$/.mp3/i;
$el->assoc_name($t);
}
elsif ( $file =~ /.\.html?$/i ) {
$type = T_REF;
}
if ( $type == T_REF ) {
for ( fjoin(dirname($file), "icon.jpg") ) {
$assc = $_ if !defined $assc && -f $_;
}
$assc = d_icons("extern.jpg") unless defined $assc;
$el->assoc_name($assc);
$el->dest_name($file);
$el->type($type);
}
$filelist->add($el);
$dirs{$1} = 1 if $type != T_REF && $file =~ m;^(.+)[/\\][^/\\]+$;;
}
close($fh);
die("Aborted\n") if $err;
@subdirs = sort(keys(%dirs));
}
sub load_info_journal {
my $err = shift;
my $fh = shift;
#### WARNING: EXPERIMENTAL ####
warn("parsing (journal mode)\n") if $trace;
my %typemap = ( 'p' => T_JPG, 'm' => T_MPG, 'v' => T_VOICE );
my $tag;
my $nexttag = 0;
my $annotation = "";
my $tags = 0;
my %dirs;
local($/) = ""; # para mode
while ( <$fh> ) {
chomp;
next if /^\s*#/;
next unless /\S/;
# Handle controls.
if ( /^!\s*(\S.*)/ ) {
$_ = $1;
if ( /^tag\s*(.*)/ ) {
$tag = $1;
$tag =~ s/\s$//;
$tag =~ s/\s+/ /g;
if ( $tag !~ /\S/ ) {
warn("Tag may not be empty\n");
$err++;
next;
}
if ( exists($jnltags{$tag}) ) {
warn("Tag \"$tag\" is not unique\n");
$err++;
}
$jnltags{$tag} = sprintf("%04d", ++$nexttag);
my $el = new ImageInfo;
$el->tag($tag);
$el->type(T_TAG);
push(@journal, $el);
$tags++;
}
elsif ( /^subdirs\s*(.*)/ ) {
foreach ( split(' ', $1)) {
$dirs{$_}++;
}
}
elsif ( /^journal\s*(.*)/ ) {
if ( $filelist->tally ) {
warn("\"!journal\" must precede image info\n");
$err++;
}
# Ignore.
}
else {
$err += parse_line("!".$_);
}
next;
}
if ( /^\*\s*(.*)/s ) {
$_ = $1;
}
else {
my $el = new ImageInfo;
$el->annotation($_);
$el->tag($tag);
$el->type(T_ANN);
push(@journal, $el);
next;
}
s/\s*\n\s+/ /g;
my @a = split(/\n/, $_);
$_ = shift(@a);
my $annotation = join(" ", @a);
my ($file, $a) = $_ =~ /^(.+?)$xsuffixpat\s*(.*)/;
my $rotate;
my $type = T_JPG;
my $assc;
while ( $a && $a =~ /^-(\w):(\S+)\s*(.*)/ ) {
if ( lc($1) eq 'o' ) {
$rotate = 90 * ($2 % 4);
}
elsif ( lc($1) eq 'i' ) {
$assc = fjoin(basename($file), $2);
unless ( -s $assc && -r _ ) {
warn("$file (info): $assc [$!]\n");
undef $assc;
}
}
elsif ( lc($1) eq 't' ) {
$type = $typemap{lc($2)}
or warn("$file (info): Illegal type: $2\n"), $err++;
}
$a = $3;
}
my $el = new ImageInfo($file);
$el->type($type);
$el->description($a) if $a;
$el->tag($tag) if $tag;
# $annotation ||= $a;
if ( $annotation ) {
$annotation =~ s/^\s+//;
$annotation =~ s/\s+$//;
$annotation =~ s/\s+/ /g;
$el->annotation($annotation);
}
$el->_rotation($rotate) if defined($rotate);
if ( $file =~ /^(.+)\.$movpat$/i ) {
$el->type(T_MPG);
$el->assoc_name($1."s.jpg"); # associates still image
}
elsif ( $type == T_VOICE ) {
(my $t = $file) =~ s/\.jpg$/.mp3/i;
$el->assoc_name($t);
}
elsif ( $file =~ /.\.html?$/i ) {
$type = T_REF;
}
if ( $type == T_REF ) {
for ( fjoin(dirname($file), "icon.jpg") ) {
$assc = $_ if !defined $assc && -f $_;
}
$assc = d_icons("extern.jpg") unless defined $assc;
$el->assoc_name($assc);
$el->dest_name($file);
$el->type($type);
}
if ( $type > T_PSEUDO ) {
my @a = ($annotation);
my $pi = scalar(@journal) - 1;
while ( $pi >= 0 ) {
my $e = $journal[$pi];
last if $e->type != T_ANN;
push(@a, $e->annotation);
$pi--;
}
$el->annotation([@a]) if @a;
}
$filelist->add($el);
push(@journal, $el) if !$a || $a !~ /^--/;
$dirs{$1} = 1 if $type != T_REF && $file =~ m;^(.+)[/\\][^/\\]+$;;
}
close($fh);
die("Aborted\n") if $err;
@subdirs = sort(keys(%dirs));
$journal = $tags; # no tags -- no journal...
}
sub load_files {
my $dh = do { local *DH; *DH; };
opendir($dh, d_large())
or die("Cannot opendir " . d_large() . ": $!\n");
my @files = sort grep { !/^\./ && /$suffixpat$/ } readdir($dh);
closedir($dh);
foreach my $dir ( @subdirs ) {
opendir($dh, d_large($dir))
or die("Cannot opendir " . d_large($dir) . ": $!\n");
push(@files,
map { "$dir/$_" }
sort grep { !/^\./ && /$suffixpat$/ } readdir($dh));
closedir($dh);
}
while ( @files ) {
my $f = shift(@files);
next unless -f d_large($f);
my $el = new ImageInfo(d_large($f));
$el->type(T_JPG);
if ( $f =~ /^(.+)\.$picpat$/ ) {
my $m = "$1.mp3";
if ( -s d_large($m) ) {
$el->type(T_VOICE);
$el->assoc_name($m);
warn(d_large($f).": Changed to VOICE\n") if $verbose;
}
}
elsif ( $f =~ /^(.+)\.$movpat$/i ) {
$el->type(T_MPG);
my $assoc = $1."s.jpg";
$el->assoc_name($assoc);
if ( @files && $files[0] eq $assoc ) {
shift(@files);
warn(d_large($assoc).": Skipped still\n") if $verbose;
}
}
$gotlist->add($el, $f);
}
}
sub load_import {
my $dh = do { local *DH; *DH; };
opendir($dh, $import_dir)
or die("Cannot opendir $import_dir: $!\n");
my @files = sort grep { !/^\./ && /$suffixpat$/ } readdir($dh);
closedir($dh);
while ( @files ) {
my $f = shift(@files);
next unless -f fjoin($import_dir, $f);
my $el = new ImageInfo(fjoin($import_dir, $f));
if ( $import_exif ) {
shift(@files) if handle_exif($f, $files[0], $el);
}
else {
$el->type(T_JPG);
if ( $f =~ /^(.+)\.$movpat$/i ) {
$el->type(T_MPG);
$el->assoc_name($1."s.jpg");
}
$implist->add($el, $f);
}
}
}
sub handle_exif {
my ($file, $next, $el) = @_;
script/album view on Meta::CPAN
<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",
border => 0, alt => "[$Tag]");
$active ? "<a class='info' href='$link' alt='[$Tag]'>$b</a>" : $b;
script/album view on Meta::CPAN
my $el = $filelist->byseq(($_ * $index_rows * $index_columns) + 1);
$t .= "<a";
if ( my $tag = $el->tag ) {
$t .= " title=\"$tag\"";
}
$t .= " href='" . ixname($_) . "'>" . ($_+1) . "</a>\n";
}
}
$t .= "...\n" if $ixlist[-1] < $num_indexes-1;
}
elsif ( $lib_common ) {
push(@b, button("up", join("/",$lib_common,"index.html"), 0, 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 = "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;
( run in 0.497 second using v1.01-cache-2.11-cpan-39bf76dae61 )