bin/gal-gen

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