gal2/bin/gal-gen

   1 #!/usr/bin/perl
   2 # UCW Gallery: Generate published photos
   3 # (c) 2004--2012 Martin Mares <mj@ucw.cz>
   4
   5 use strict;
   6 use warnings;
   7
   8 use UCW::Gallery;
   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 = $photo_dir . "/gallery.meta";
  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 for my $f (@$orig_list) {
  38         my $id = $f->{id};
  39         my $rotate = $f->{orientation};
  40         my $xfrm = $f->{xfrm};
  41         print "$id: ";
  42
  43         my $p = new Image::Magick;
  44         my $orig = File::Spec->rel2abs($f->{file}, $gal->get('OrigDir'));
  45         my ($orig_w, $orig_h, $orig_size, $orig_format) = $p->PingImage($orig) or die "Error reading $orig\n";
  46         print "${orig_w}x${orig_h} ";
  47
  48         my ($w0, $h0) = ($rotate eq "l" || $rotate eq "r") ? ($orig_h, $orig_w) : ($orig_w, $orig_h);
  49         my ($w, $h) = ($w0, $h0);
  50         if ($w > $gal->get('PhotoMaxWidth')) {
  51                 my $s = $gal->get('PhotoMaxWidth') / $w;
  52                 $w = $w * $s;
  53                 $h = $h * $s;
  54         }
  55         if ($h > $gal->get('PhotoMaxHeight')) {
  56                 my $s = $gal->get('PhotoMaxHeight') / $h;
  57                 $w = $w * $s;
  58                 $h = $h * $s;
  59         }
  60         $w = int($w);
  61         $h = int($h);
  62
  63         my $m = {
  64                 'o' => $rotate,
  65                 'xf' => $xfrm,
  66                 'w' => $w,
  67                 'h' => $h,
  68         };
  69         $meta->{photo}->{$id} = $m;
  70
  71         my $om = $old_meta->{photo}->{$id};
  72         if ($om &&
  73             $om->{o} eq $m->{o} &&
  74             $om->{xf} eq $m->{xf} &&
  75             $om->{w} eq $m->{w} &&
  76             $om->{h} eq $m->{h}) {
  77                 # FIXME: Remove old images?
  78                 print "... uptodate\n";
  79                 next;
  80         }
  81
  82         my $e;
  83         $e = $p->Read($orig) and die "Error reading $orig: $e";
  84         $p->Strip;
  85         $p->SetAttribute(quality=>90);
  86
  87         if ($xfrm =~ /s/) {
  88                 print "-> sharpen ";
  89                 $p->Sharpen(1);
  90         }
  91         if ($xfrm =~ /h/) {
  92                 print "-> equalize ";
  93                 $p->Equalize();
  94         }
  95         if ($xfrm =~ /n/) {
  96                 print "-> normalize ";
  97                 $p->Normalize();
  98         }
  99
 100         my $rot = 0;
 101         if ($rotate eq "l") { $rot = 270; }
 102         elsif ($rotate eq "r") { $rot = 90; }
 103         elsif ($rotate eq "u") { $rot = 180; }
 104         if ($rot) {
 105                 print "-> rotate $rot ";
 106                 $p->Rotate(degrees=>$rot);
 107         }
 108
 109         if ($w != $w0 || $h != $h0) {
 110                 print "-> ${w}x${h} ";
 111                 $p->Resize(width=>$w, height=>$h);
 112         }
 113
 114         my $photo = File::Spec->catfile($photo_dir, $id . ".jpg");
 115         my $tmp = "$photo.new";
 116         $e = $p->Write($tmp) and die "Unable to write $tmp: $e";
 117         rename $tmp, $photo or die "Cannot rename $tmp to $photo: $!\n";
 118
 119         print "... OK\n";
 120 }
 121
 122 print "Cleaning up stale files\n";
 123 for my $f (<$photo_dir/*.jpg>) {
 124         my ($vv, $dd, $id) = File::Spec->splitpath($f);
 125         $id =~ s{\..*$}{};
 126         unless (defined $meta->{photo}->{$id}) {
 127                 print "$id: removing\n";
 128                 unlink $f;
 129         }
 130 }
 131
 132 print "Writing meta-data\n";
 133 $gal->write_meta($photo_meta, $meta);