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