gal2/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 lib '/home/mj/web/gal2';
   9 use UCW::Gallery;
  10
  11 use Image::Magick;
  12 use IO::Handle;
  13 use File::Spec;
  14 use File::Path;
  15
  16 STDOUT->autoflush(1);
  17
  18 UCW::Gallery::LoadConfig;
  19
  20 my $orig_dir = $UCW::Gallery::CF{'OrigDir'};
  21 my $orig_list = UCW::Gallery::ReadList('gallery.list') or die "Cannot read gallery.list: $!\n";
  22
  23 my $photo_dir = $UCW::Gallery::CF{'PhotoDir'};
  24 if (-d $photo_dir) {
  25         print "Using existing output directory: $photo_dir\n";
  26 } else {
  27         print "Creating output directory: $photo_dir\n";
  28         File::Path::mkpath($photo_dir) or die "Unable to create $photo_dir: $!\n";
  29 }
  30
  31 my $photo_meta = $photo_dir . "/gallery.meta";
  32 my $old_meta = {};
  33 if (-f $photo_meta) {
  34         print "Reading old meta-data\n";
  35         $old_meta = UCW::Gallery::ReadMeta($photo_meta);
  36         # use Data::Dumper; print "Read old meta: ", Dumper($old_meta), "\n";
  37 }
  38 my $meta = { 'photo' => {}, 'sequence' => [] };
  39
  40 for my $f (@$orig_list) {
  41         my $id = $f->{id};
  42         my $rotate = $f->{orientation};
  43         my $xfrm = $f->{xfrm};
  44         push @{$meta->{sequence}}, $id;
  45         print "$id: ";
  46
  47         my $p = new Image::Magick;
  48         my $orig = File::Spec->rel2abs($f->{file}, $UCW::Gallery::CF{'OrigDir'});
  49         my ($orig_w, $orig_h, $orig_size, $orig_format) = $p->PingImage($orig) or die "Error reading $orig\n";
  50         print "${orig_w}x${orig_h} ";
  51
  52         my ($w0, $h0) = ($rotate eq "l" || $rotate eq "r") ? ($orig_h, $orig_w) : ($orig_w, $orig_h);
  53         my ($w, $h) = ($w0, $h0);
  54         if ($w > $UCW::Gallery::CF{'PhotoMaxWidth'}) {
  55                 my $s = $UCW::Gallery::CF{'PhotoMaxWidth'} / $w;
  56                 $w = $w * $s;
  57                 $h = $h * $s;
  58         }
  59         if ($h > $UCW::Gallery::CF{'PhotoMaxHeight'}) {
  60                 my $s = $UCW::Gallery::CF{'PhotoMaxHeight'} / $h;
  61                 $w = $w * $s;
  62                 $h = $h * $s;
  63         }
  64         $w = int($w);
  65         $h = int($h);
  66
  67         my $m = {
  68                 'o' => $rotate,
  69                 'xf' => $xfrm,
  70                 'w' => $w,
  71                 'h' => $h,
  72         };
  73
  74         my $om = $old_meta->{photo}->{$id};
  75         if ($om &&
  76             $om->{o} eq $m->{o} &&
  77             $om->{xf} eq $m->{xf} &&
  78             $om->{w} eq $m->{w} &&
  79             $om->{h} eq $m->{h}) {
  80                 # FIXME: Remove old images?
  81                 print "... uptodate\n";
  82                 $meta->{photo}->{$id} = $om;
  83                 next;
  84         }
  85
  86         my $e;
  87         $e = $p->Read($orig) and die "Error reading $orig: $e";
  88         $p->Strip;
  89         $p->SetAttribute(quality=>90);
  90
  91         if ($xfrm =~ /s/) {
  92                 print "-> sharpen ";
  93                 $p->Sharpen(1);
  94         }
  95         if ($xfrm =~ /h/) {
  96                 print "-> equalize ";
  97                 $p->Equalize();
  98         }
  99         if ($xfrm =~ /n/) {
 100                 print "-> normalize ";
 101                 $p->Normalize();
 102         }
 103
 104         my $rot = 0;
 105         if ($rotate eq "l") { $rot = 270; }
 106         elsif ($rotate eq "r") { $rot = 90; }
 107         elsif ($rotate eq "u") { $rot = 180; }
 108         if ($rot) {
 109                 print "-> rotate $rot ";
 110                 $p->Rotate(degrees=>$rot);
 111         }
 112
 113         if ($w != $w0 || $h != $h0) {
 114                 print "-> ${w}x${h} ";
 115                 $p->Resize(width=>$w, height=>$h);
 116         }
 117
 118         my $photo = File::Spec->catfile($photo_dir, $id . ".jpg");
 119         my $tmp = "$photo.new";
 120         $e = $p->Write($tmp) and die "Unable to write $tmp: $e";
 121         rename $tmp, $photo or die "Cannot rename $tmp to $photo: $!\n";
 122
 123         print "... OK\n";
 124         $meta->{photo}->{$id} = $m;
 125 }
 126
 127 print "Writing meta-data\n";
 128 UCW::Gallery::WriteMeta($photo_meta, $meta);