gal/bin/gal-gen

   1 #!/usr/bin/perl
   2 # UCW Gallery: Generate published photos
   3 # (c) 2004--2014 Martin Mares <mj@ucw.cz>
   4
   5 use strict;
   6 use warnings;
   7
   8 use UCW::Gallery;
   9 use Image::EXIF;
  10 use Image::Magick;
  11 use IO::Handle;
  12 use File::Spec;
  13 use File::Path;
  14
  15 STDOUT->autoflush(1);
  16
  17 my $gal = UCW::Gallery->load_config;
  18
  19 my $orig_list = $gal->read_list('gallery.list') or die "Cannot read gallery.list: $!\n";
  20
  21 my $photo_dir = $gal->get('PhotoDir');
  22 if (-d $photo_dir) {
  23         print "Using existing output directory: $photo_dir\n";
  24 } else {
  25         print "Creating output directory: $photo_dir\n";
  26         File::Path::mkpath($photo_dir) or die "Unable to create $photo_dir: $!\n";
  27 }
  28
  29 my $photo_meta = $gal->photo_meta_name;
  30 my $old_meta = {};
  31 if (-f $photo_meta) {
  32         print "Reading old meta-data\n";
  33         $old_meta = $gal->read_meta($photo_meta);
  34         # use Data::Dumper; print "Read old meta: ", Dumper($old_meta), "\n";
  35 }
  36 my $meta = { 'photo' => {} };
  37
  38 sub get_meta_basic($$$) {
  39         my ($f, $m, $p) = @_;
  40         my $rotate = $f->{orientation};
  41
  42         my ($orig_w, $orig_h, $orig_size, $orig_format) = $p->PingImage($f->{orig}) or die "Error reading " . $f->{orig} . "\n";
  43         print "${orig_w}x${orig_h} ";
  44
  45         my ($w0, $h0) = ($rotate eq "l" || $rotate eq "r") ? ($orig_h, $orig_w) : ($orig_w, $orig_h);
  46         my ($w, $h) = ($w0, $h0);
  47         if ($w > $gal->get('PhotoMaxWidth')) {
  48                 my $s = $gal->get('PhotoMaxWidth') / $w;
  49                 $w = $w * $s;
  50                 $h = $h * $s;
  51         }
  52         if ($h > $gal->get('PhotoMaxHeight')) {
  53                 my $s = $gal->get('PhotoMaxHeight') / $h;
  54                 $w = $w * $s;
  55                 $h = $h * $s;
  56         }
  57         $w = int($w + .5);
  58         $h = int($h + .5);
  59
  60         $m->{o} = $rotate;
  61         $m->{xf} = $f->{xfrm};
  62         $m->{w0} = $w0;
  63         $m->{h0} = $h0;
  64         $m->{w} = $w;
  65         $m->{h} = $h;
  66 }
  67
  68 sub get_meta_exif($$) {
  69         my ($f, $m) = @_;
  70         $gal->get('CacheExif') or return;
  71
  72         my $e = new Image::EXIF($f->{orig});
  73         my $i = $e->get_all_info();
  74         if ($e->error) {
  75                 print "[EXIF error: ", $e->error, "] ";
  76                 return;
  77         }
  78         # use Data::Dumper; print Dumper($i);
  79
  80         my $lat = $i->{image}->{'Latitude'};
  81         if ($lat) {
  82                 if ($lat =~ m{^([NS]) (\d+)\xb0 ([0-9.]+)'$}) {
  83                         $lat = $2 + $3/60;
  84                         $lat = -$lat if $1 eq 'S';
  85                         $lat = sprintf "%.6f", $lat;
  86                 } else {
  87                         print "[EXIF: unable to parse latitude $lat] ";
  88                         $lat = undef;
  89                 }
  90         }
  91
  92         my $lon = $i->{image}->{'Longitude'};
  93         if ($lon) {
  94                 if ($lon =~ m{^([WE]) (\d+)\xb0 ([0-9.]+)'$}) {
  95                         $lon = $2 + $3/60;
  96                         $lon = -$lon if $1 eq 'W';
  97                         $lon = sprintf "%.6f", $lon;
  98                 } else {
  99                         print "[EXIF: unable to parse longitude $lon] ";
 100                         $lon = undef;
 101                 }
 102         }
 103
 104         my $alt = $i->{image}->{'Altitude'};
 105         if ($alt) {
 106                 if ($alt =~ m{^([0-9.]+) m$}) {
 107                         $alt = $1;
 108                 } else {
 109                         print "[EXIF: unable to parse altitude $alt] ";
 110                         $alt = undef;
 111                 }
 112         }
 113
 114         # printf "[GEO: lat=%s lon=%s alt=%s] ", $lat // '?', $lon // '?', $alt // '?';
 115         if ($lat && $lon) {
 116                 $m->{lat} = $lat;
 117                 $m->{lon} = $lon;
 118         }
 119         $m->{alt} = $alt if $alt;
 120
 121         my $time = $i->{image}->{'Image Created'};
 122         if ($time) {
 123                 if ($time =~ m{^(\d{4}):(\d{2}):(\d{2}) (\d{2}:\d{2}:\d{2})$}) {
 124                         $m->{t} = "$1-$2-$3 $4";
 125                         # print "[TIME: ", $m->{t}, "] ";
 126                 } else {
 127                         print "[EXIF: unable to parse time $time] ";
 128                 }
 129         }
 130 }
 131
 132 sub generate_photo($$$) {
 133         my ($f, $m, $p) = @_;
 134
 135         my $e;
 136         $e = $p->Read($f->{orig}) and die "Error reading " . $f->{orig} . ": $e";
 137         $p->Strip;
 138         $p->SetAttribute(quality=>90);
 139
 140         my $xfrm = $m->{xf};
 141         if ($xfrm =~ /s/) {
 142                 print "-> sharpen ";
 143                 $p->Sharpen(1);
 144         }
 145         if ($xfrm =~ /h/) {
 146                 print "-> equalize ";
 147                 $p->Equalize();
 148         }
 149         if ($xfrm =~ /n/) {
 150                 print "-> normalize ";
 151                 $p->Normalize();
 152         }
 153
 154         my $rotate = $m->{o};
 155         my $rot = 0;
 156         if ($rotate eq "l") { $rot = 270; }
 157         elsif ($rotate eq "r") { $rot = 90; }
 158         elsif ($rotate eq "u") { $rot = 180; }
 159         if ($rot) {
 160                 print "-> rotate $rot ";
 161                 $p->Rotate(degrees=>$rot);
 162         }
 163
 164         my ($w, $h) = ($m->{w}, $m->{h});
 165         if ($w != $m->{w0} || $h != $m->{h0}) {
 166                 print "-> ${w}x${h} ";
 167                 $p->Resize(width=>$w, height=>$h);
 168         }
 169
 170         my $photo = $gal->photo_name($m, $f->{id});
 171         my $tmp = "$photo.new";
 172         $e = $p->Write($tmp) and die "Unable to write $tmp: $e";
 173         rename $tmp, $photo or die "Cannot rename $tmp to $photo: $!\n";
 174 }
 175
 176 for my $f (@$orig_list) {
 177         my $id = $f->{id};
 178         print "$id: ";
 179
 180         my $m = { };
 181         $meta->{photo}->{$id} = $m;
 182         $f->{orig} = File::Spec->rel2abs($f->{file}, $gal->get('OrigDir'));
 183
 184         my $p = new Image::Magick;
 185         get_meta_basic($f, $m, $p);
 186         get_meta_exif($f, $m);
 187
 188         my $om = $old_meta->{photo}->{$id};
 189         if ($om &&
 190             $om->{o} eq $m->{o} &&
 191             $om->{xf} eq $m->{xf} &&
 192             $om->{w} eq $m->{w} &&
 193             $om->{h} eq $m->{h}) {
 194                 print "... uptodate\n";
 195                 next;
 196         }
 197
 198         generate_photo($f, $m, $p);
 199         print "... OK\n";
 200 }
 201
 202 print "Cleaning up stale files\n";
 203 for my $f (<$photo_dir/*.jpg>) {
 204         my ($vv, $dd, $id) = File::Spec->splitpath($f);
 205         $id =~ s{\..*$}{};
 206         unless (defined $meta->{photo}->{$id}) {
 207                 print "$id: removing\n";
 208                 unlink $f;
 209         }
 210 }
 211
 212 print "Writing meta-data\n";
 213 $gal->write_meta($photo_meta, $meta);
 214 exit 0;