git.sesse.net Git - pr0n/blob - perl/update-image-info.pl

   1 #! /usr/bin/perl
   2
   3 # Warning: This is sort of outdated now. :-/ What really should be done is make
   4 #          update_image_info() includeable from outside mod_perl, so we don't have
   5 #          to duplicate the code in here.
   6
   7 use lib qw(.);
   8 use DBI;
   9 use POSIX;
  10 use Image::ExifTool;
  11 use Encode;
  12 use strict;
  13 use warnings;
  14
  15 use Sesse::pr0n::Config;
  16 eval {
  17         require Sesse::pr0n::Config_local;
  18 };
  19
  20 my $dbh = DBI->connect("dbi:Pg:dbname=pr0n;host=" . $Sesse::pr0n::Config::db_host,
  21         $Sesse::pr0n::Config::db_username, $Sesse::pr0n::Config::db_password)
  22         or die "Couldn't connect to PostgreSQL database: " . DBI->errstr;
  23 $dbh->{RaiseError} = 1;
  24
  25 my $q = $dbh->prepare('SELECT id FROM images WHERE id NOT IN ( SELECT DISTINCT image FROM exif_info ) ORDER BY id');
  26 $q->execute;
  27
  28 while (my $ref = $q->fetchrow_hashref) {
  29         my $id = $ref->{'id'};
  30
  31         # Copied almost verbatim from Sesse::pr0n::Common::update_image_info
  32         my $info = Image::ExifTool::ImageInfo(get_disk_location($id));
  33         my $width = $info->{'ImageWidth'} || -1;
  34         my $height = $info->{'ImageHeight'} || -1;
  35         my $datetime = undef;
  36
  37         if (defined($info->{'DateTimeOriginal'})) {
  38                 # Parse the date and time over to ISO format
  39                 if ($info->{'DateTimeOriginal'} =~ /^(\d{4}):(\d\d):(\d\d) (\d\d):(\d\d):(\d\d)(?:\+\d\d:\d\d)?$/ && $1 > 1990) {
  40                         $datetime = "$1-$2-$3 $4:$5:$6";
  41                 }
  42         }
  43
  44         {
  45                 local $dbh->{AutoCommit} = 0;
  46
  47                 $dbh->do('UPDATE images SET width=?, height=?, date=? WHERE id=?',
  48                          undef, $width, $height, $datetime, $id)
  49                         or die "Couldn't update width/height in SQL: $!";
  50
  51                 $dbh->do('DELETE FROM exif_info WHERE image=?',
  52                         undef, $id)
  53                         or die "Couldn't delete old EXIF information in SQL: $!";
  54
  55                 my $q = $dbh->prepare('INSERT INTO exif_info (image,tag,value) VALUES (?,?,?)')
  56                         or die "Couldn't prepare inserting EXIF information: $!";
  57
  58                 for my $key (keys %$info) {
  59                         next if ref $info->{$key};
  60                         $q->execute($id, $key, guess_charset($info->{$key}))
  61                                 or die "Couldn't insert EXIF information in database: $!";
  62                 }
  63
  64                 # update the last_picture cache as well (this should of course be done
  65                 # via a trigger, but this is less complicated :-) )
  66                 $dbh->do('UPDATE last_picture_cache SET last_picture=GREATEST(last_picture, ?) WHERE event=(SELECT event FROM images WHERE id=?)',
  67                         undef, $datetime, $id)
  68                         or die "Couldn't update last_picture in SQL: $!";
  69         }
  70
  71         print "Updated $id.\n";
  72 }
  73
  74 sub get_disk_location {
  75         my ($id) = @_;
  76         my $dir = POSIX::floor($id / 256);
  77         return "/srv/pr0n.sesse.net/images/$dir/$id.jpg";
  78 }
  79
  80 sub guess_charset {
  81         my $text = shift;
  82         my $decoded;
  83
  84         eval {
  85                 $decoded = Encode::decode("utf-8", $text, Encode::FB_CROAK);
  86         };
  87         if ($@) {
  88                 $decoded = Encode::decode("iso8859-1", $text);
  89         }
  90
  91         return $decoded;
  92 }
  93