Album
view release on metacpan or search on metacpan
script/album view on Meta::CPAN
}
}
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) = @_;
# Sony DSC-V1 produces the following files:
# DSC0nnnn.JPG still image
# DSC0nnnn.JPE mail mode image*
# DSC0nnnn.MPG voice mode image*
# DSC0nnnn.TIF uncompressed image*
# CLP0nnnn.GIF clip motion file
# CLP0nnnn.HTM clip motion file index
# MBL0nnnn.GIF clip motion file, mobile mode
# MBL0nnnn.HTM clip motion file index, mobile mode
# MOV0nnnn.MPG movie
# Files marked with * have a normal still image associated.
# Normal still image.
if ( $file =~ /^(.{4})(\d{4})\.($picpat)$/i ) {
my ($type, $seq, $ext) = ($1, $2, $3);
my $fd = $el->xDateTime || "";
if ( $fd =~ /(\d\d\d\d):(\d\d):(\d\d) (\d\d):(\d\d):(\d\d)/ && $2 != 0) {
my $time = timelocal($6,$5,$4,$3,$2-1,$1);
my $new = "$1$2$3$4$5$6$seq";
my $ii = cache_entry("$new.$ext");
if ( $ii && !$ii->orig_name ) {
$ii->orig_name(fjoin($import_dir, $file));
}
$el->type(T_JPG);
$el->dest_name("$new.$ext");
$el->timestamp($time);
$file = "$new.$ext";
cache_entry($file, $el) unless $ii;
}
else {
warn(fjoin($import_dir, $file).": Missing or unparsable file date [$fd]\n")
if $verbose;
$el->type(T_JPG);
}
if ( $next && $next eq "$type$seq.mpg" ) {
warn(fjoin($import_dir, $file).": Changed to VOICE\n") if $verbose;
$el->type(T_VOICE);
(my $t = $file) =~ s/\.jpg$/.mp3/i;
$el->assoc_name($t);
$implist->add($el);
return 1;
}
$implist->add($el);
}
# MPEG movie.
elsif ( $file =~ /^(.{4})(\d{4})\.($movpat)$/i ) {
my ($type, $seq, $ext) = ($1, $2, $3);
my $new = $el->xDateTime;
if ( $new && $new =~ /(\d\d\d\d):(\d\d):(\d\d) (\d\d):(\d\d):(\d\d)/ && $2 != 0 ) {
$new = "$1$2$3$4$5$6$seq";
}
else {
# We have to trust the file date...
my $time = $el->timestamp;
my @tm = localtime($time);
$new = sprintf("%04d%02d%02d%02d%02d%02d$seq",
1900+$tm[5], 1+$tm[4], @tm[3,2,1,0]);
}
my $ii = cache_entry("$new.$ext");
if ( $ii && !$ii->orig_name ) {
$ii->orig_name(fjoin($import_dir, $file));
}
$el->type(T_MPG);
$el->dest_name("$new.$ext");
$el->assoc_name($new."s.jpg");
$implist->add($el, "$new.$ext");
$file = "$new.$ext";
cache_entry($file, $el) unless $ii;
}
# Assume ordinary JPEG or some picture.
elsif ( $file =~ /^.*$picpat$/) {
$el->type(T_JPG);
$el->orig_name(fjoin($import_dir, $file));
$el->dest_name($file);
$implist->add($el, $file);
}
# Assume ordinary MPEG or some movie.
elsif ( $file =~ /^(.*)($movpat)$/) {
$el->type(T_MPG);
$el->orig_name(fjoin($import_dir, $file));
$el->dest_name($file);
$el->assoc_name($1."s.jpg");
$implist->add($el, $file);
}
return 0;
}
sub update_filelist {
my $todo = new FileList;
my $el;
my %seen;
my $missing;
my $prev;
foreach $el ( $filelist->entries ) {
my $f = $el->dest_name;
$seen{$f}++;
print STDERR ("todo[inf]: $f") if $trace;
my $entry = $gotlist->byname($f);
if ( $entry ) {
print STDERR (" -- got") if $trace;
}
elsif ( $entry = $implist->byname($f) ) {
print STDERR (" -- imp") if $trace;
script/album view on Meta::CPAN
return '' unless $t;
$t =~ s/\n+/$br/go;
$t;
}
sub indent($$) {
# Shift contents to the right so it fits pretty.
my ($t, $n) = @_;
$n = " " x $n;
return $n unless $t;
$t = detab($t);
$t =~ s/\n+$//;
$t =~ s/\n/\n$n/g;
$t;
}
sub img($%) {
my ($file, %atts) = @_;
my $ret = "<img src='" . $file . "'";
foreach ( sort(keys(%atts)) ) {
$ret .= " $_='" . $atts{$_} . "'";
}
$ret . "/>";
}
#### Size helpers.
sub bytes($) {
my $t = shift;
return $t . "b" if $t < 10*1024;
return ($t >> 10) . "kb" if $t < 10*1024*1024;
($t >> 20) . "Mb";
}
sub size_info($;$) {
my ($el, $med) = @_;
return unless $el->width;
my $ret = "";
$ret .= $el->width . "x" . $el->height if $el->width;
for ( $med ? $el->medium_size : $el->file_size ) {
next unless $_;
$ret .= "," if $ret;
$ret .= bytes($_);
}
$ret;
}
#### EXIF helpers.
sub restyle_exif($) {
my ($el) = @_;
my $ret = "";
my $v;
my $app = sub {
$ret .= "<tr><td>".htmln($_[0])."</td>".
"<td>".htmln($_[1])."</td></tr>\n";
};
$app->("Date", $v) if $v = $el->xDateTime;
my $t = $el->ExposureTime || 0;
# if ( $t && $t <= 0.5 ) {
# $t = "1/".int(0.5 + 1/$t)."s";
# }
$app->("Exposure",
join(" ", $el->ExposureMode || "",
$el->ExposureProgram || "", $t)) if $t;
$app->("Aperture", sprintf("%.1f", $v))
if $v = $el->FNumber;
if ( $v = $el->FocalLength ) {
if ( my $v2 = $el->FocalLengthIn35mmFormat ) {
$v .= " ($v2 eqv.)";
}
$app->("Focal length", $v);
}
$app->("ISO", $v) if $v = $el->ISOSpeedRatings;
$app->("Flash", $v)
if ($v = $el->Flash) && $v !~ /did not fire/i;
$app->("Metering", $v) if $v = $el->MeteringMode;
$app->("FocusMode", $v) if ($v = $el->FocusMode) && $v ne 'Auto';
$app->("WhiteBalance", $v) if ($v = $el->WhiteBalance) && $v ne 'Auto';
$app->("Scene", $v) if ($v = $el->SceneCaptureType) && $v ne 'Standard';
$app->("Camera", join(" ", $v, $el->Model)) if $v = $el->Make;
}
#### Caption helpers.
sub f_caption($) {
my ($el) = @_;
my $s = htmln($el->type == T_REF ? $el->orig_name : $el->dest_name);
if ( $el->Make ) {
$s = " $s<a href='#' class='info'> <span>".
"<table border='1' width='100%'>\n".
restyle_exif($el) . "</table>\n".
"</span></a>";
}
$s;
}
sub s_caption($) {
my ($el) = @_;
size_info($el, $medium);
}
sub t_caption($) {
my ($el) = @_;
$el->tag ? htmln($el->tag) : "";
}
sub c_caption($) {
my ($el) = @_;
my $t = $el->description || "";
$t =~ s/\n.*//;
htmln($t);
}
#### Misc.
sub update_if_needed($$) {
my ($fname, $new) = @_;
script/album view on Meta::CPAN
--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 => "",
annotation => [],
tag => "",
hidden => 0,
};
if ( $file && -f $file ) {
my @st = stat(_);
my $ii = ::cache_entry($file);
if ( $ii ){
$self = $ii;
delete($self->{$_}) foreach grep { /^_/ } keys(%$self);
}
# Else, get image info.
else {
# my $ii = Image::Info::image_info($file);
my $ii = Image::ExifTool->new->ImageInfo($file);
$self->{file_size} = $st[7];
$self->{timestamp} = $st[9];
unless ( exists($ii->{error}) ) {
for my $key ( @exif_fields ) {
my $val = $ii->{$key};
next unless defined $val;
if ( $key eq "Orientation" ) {
($self->{rotation}, $self->{mirror}) =
@{$exif_rot->{$val}}
if exists $exif_rot->{$val};
}
else {
$val = $val->as_float
if UNIVERSAL::can($val,"as_float");
$self->{$key} = $val;
}
}
::cache_entry($file, $self);
}
}
# Actualize.
$self->{file_size} = $st[7];
$self->{timestamp} = $st[9];
}
bless($self, $pkg);
}
INIT {
no strict 'refs';
for my $sub ( @std_fields, @exif_fields ) {
$sub = "_".$sub if $sub eq "rotation";
*{"ImageInfo::$sub"} = sub {
my ($self, $value) = @_;
$self->{$sub} = $value if defined($value);
$self->{$sub};
};
}
}
sub xDateTime {
my ( $self ) = @_;
my $skew = $skew;
my $dt = $self->DateTimeOriginal || $self->CreateDate || $self->MediaCreateDate || $self->DateTime;
if ( $self->TimeZone ) {
my ( $m, $h, $min ) = $self->TimeZone =~ /^([-+])(\d+):(\d+)/;
$min += 60 * $h;
$min = -$min if $m eq "-";
$skew += $min * 60;
}
return ($dt) unless $skew;
my $fd = $dt || "";
if ( $fd =~ /(\d\d\d\d):(\d\d):(\d\d) (\d\d):(\d\d):(\d\d)/ && $2 != 0) {
use Time::Local;
my $time = timelocal($6,$5,$4,$3,$2-1,$1)+$skew;
my @t = localtime($time);
$dt = sprintf("%04d:%02d:%02d %02d:%02d:%02d",
1900+$t[5], 1+$t[4], $t[3],
$t[2], $t[1], $t[0]);
return $dt;
}
return "";
}
sub rotation {
my ($self) = @_;
defined($self->{_rotation}) ? $self->{_rotation} : $self->{rotation};
}
sub html_name {
my ($self) = @_;
sprintf("img%04d.html", $self->seq);
}
package FileList;
use Class::Struct "FileList" =>
[ _tally => '$',
_data => '$',
_hash => '$',
];
sub add {
my ($self, $el, $name) = @_;
my $data = $self->_data;
my $hash = $self->_hash;
$self->_hash($hash = {}) unless $hash;
$self->_data($data = []) unless $data;
push(@$data, $el);
$hash->{$name || $el->dest_name || ""} = $el;
$self->_tally(($self->_tally||0)+1);
$el->seq($self->_tally);
$self;
}
sub byname {
my ($self, $file) = @_;
$self->_hash ? $self->_hash->{$file} : undef;
}
sub entries {
my ($self) = @_;
( run in 0.954 second using v1.01-cache-2.11-cpan-389fe586d7c )