gal/bin/gal-scan

   1 #!/usr/bin/perl
   2 # UCW Gallery: Scan images and generate image list
   3 # (c) 2004--2015 Martin Mares <mj@ucw.cz>
   4
   5 use strict;
   6 use warnings;
   7
   8 use UCW::Gallery;
   9 use UCW::Gallery::Hashes;
  10 use File::Spec;
  11 use Image::EXIF;
  12 use Getopt::Long;
  13
  14 if (@ARGV && $ARGV[0] eq '--help') {
  15         die <<AMEN ;
  16 Usage:  cat list | gal scan
  17    or:  gal scan <files and directories>
  18    or:  gal scan --update
  19 AMEN
  20 }
  21
  22 my $update;
  23 GetOptions(
  24         'update!' => \$update,
  25 ) or die "Try gal scan --help\n";
  26
  27 STDOUT->autoflush(1);
  28 my $gal = UCW::Gallery->load_config;
  29 my $orig_prefix = $gal->get('OrigDir');
  30 $orig_prefix =~ m{/$} or $orig_prefix .= '/';
  31
  32 my @source = ();
  33 if ($update) {
  34         print "Loading previous gallery.list\n";
  35         my $pg = $gal->read_list('gallery.list') or die "Unable to load gallery.list\n";
  36         @source = @{$pg};
  37 } elsif (@ARGV) {
  38         for my $in (@ARGV) {
  39                 if (-f $in) {
  40                         push @source, { file => $in };
  41                 } elsif (-d $in) {
  42                         opendir D, $in or die "Cannot scan directory $in: $!\n";
  43                         my @p = ();
  44                         while (my $e = readdir D) {
  45                                 my $f = File::Spec->canonpath(File::Spec->catfile($in, $e));
  46                                 if ($f =~ m{\.(jpe?g|png)$}i) {
  47                                         push @p, $f;
  48                                 }
  49                         }
  50                         closedir D;
  51                         push @source, map { { file => $_ } } sort @p;
  52                 } else {
  53                         die "$in is neither file nor directory\n";
  54                 }
  55         }
  56 } else {
  57         while (<STDIN>) {
  58                 chomp;
  59                 push @source, { file => $_ };
  60         }
  61 }
  62
  63 my $hashes = UCW::Gallery::Hashes->new($gal);
  64
  65 print "Scanning photos\n";
  66 my @images = ();
  67 foreach my $src (@source) {
  68         my $name = $src->{file};
  69         if ($name =~ m{^/}) {
  70                 # Try to relativize to OrigDir
  71                 if (substr($name, 0, length $orig_prefix) eq $orig_prefix) {
  72                         $src->{file} = $name = substr($name, length $orig_prefix);
  73                 }
  74         }
  75         print "\t$name:";
  76
  77         my $path = File::Spec->rel2abs($name, $gal->get('OrigDir'));
  78         -f $path or die "Cannot find $path\n";
  79
  80         $src->{id} = $hashes->hash_image($path);
  81         print " id=", $src->{id};
  82
  83         if (!defined $src->{orientation} || $src->{orientation} eq '-') {
  84                 my $e = new Image::EXIF($path);
  85                 my $i = $e->get_all_info();
  86                 if ($e->error) {
  87                         print "EXIF error: ", $e->error, "\n";
  88                         $src->{orientation} = '.';
  89                 } else {
  90                         # print STDERR Dumper($i), "\n";
  91                         my $o = $i->{'image'}->{'Image Orientation'} || "Top, Left-Hand";
  92                         if ($o eq "Top, Left-Hand") { $o = "."; }
  93                         elsif ($o eq "Right-Hand, Top") { $o = "r"; }
  94                         elsif ($o eq "Left-Hand, Bottom") { $o = "l"; }
  95                         elsif ($o eq "Bottom, Right-Hand") { $o = "u"; }
  96                         else {
  97                                 print "Unrecognized orientation: $o\n";
  98                                 $o = ".";
  99                         }
 100                         $src->{orientation} = $o;
 101                 }
 102         }
 103         print " ori=", $src->{orientation};
 104
 105         defined $src->{xfrm} or $src->{xfrm} = $gal->get('ScanDefaultTransform');
 106         print " xfrm=", $src->{xfrm};
 107
 108         $src->{title} //= '';
 109         push @images, $src;
 110         print "\n";
 111 }
 112
 113 if (!$update) {
 114         my $old = $gal->read_list('gallery.list');
 115         if ($old) {
 116                 print "Updating gallery.list\n";
 117                 my %new_by_id = map { $_->{id} => $_ } @images;
 118                 my @result = ();
 119                 for my $o (@$old) {
 120                         my $id = $o->{id};
 121                         my $i = $new_by_id{$id};
 122                         if (!$i) {
 123                                 print "\t$id: removed\n";
 124                                 next;
 125                         }
 126                         print "\t$id: updated\n";
 127                         push @result, $o;
 128                         delete $new_by_id{$id};
 129                 }
 130                 for my $i (@images) {
 131                         my $id = $i->{id};
 132                         $new_by_id{$id} or next;
 133                         print "\t$id: new\n";
 134                         push @result, $i;
 135                 }
 136                 @images = @result;
 137         }
 138 }
 139
 140 $gal->write_list('gallery.list', \@images);
 141 print "Written gallery.list (", (scalar @images), " items)\n";
 142 $hashes->write;