#!/usr/bin/perl -- # -*- Perl -*-
#
# toxmp merges RDF data, including GPS track information, into EXIF.
#
# Copyright (C) 2007 Norman Walsh. Do with it as you please.
#
# NO WARRANTY. It works for me. It's not going to work for you without
# a little editing, so don't blame me if it messes things up. Backup
# early, backup often.
#

use strict;
use Cwd;
use English;
use Getopt::Std;
use Image::ExifTool;
use Time::Local;
use Math::Trig qw(great_circle_distance deg2rad);
use vars qw($opt_a $opt_r $opt_j $opt_d $opt_s);

my $DEBUG = 0;
my $WRITE = 1;
my $usage = "Usage: $0 [-a gpsadj] [-d] [-j|-r rdf] [-s] file [kw=value]+\n";
my $TRACKDIR = "/Users/ndw/.gpstracks";

my %places = ();
open (F, "/Users/ndw/hiptop/rdf/places.txt");
while (<F>) {
    chop;
    next if !/(\S+)\s+(.*?)$/;
    my $place = $1;
    my @data = split(/\|/,$2);
    $places{$place} = \@data;
}
close (F);

my %tagMap = (
    'cc:license' => 'License',
    'comment' => 'Comment',
    'copyright' => 'Copyright',
    'terms' => 'UsageTerms',
    'dc:coverage' => 'Coverage',
    'dc:creator' => 'Creator',
    'dc:description' => 'Description',
    'dc:publisher' => 'Publisher',
    'dc:rights' => 'Rights',
    'dc:subject' => 'Subject',
    'dc:title' => 'Title',
    'geo:altitude' => 'GPSAltitude',
    'geo:lat' => 'GPSLatitude',
    'geo:long' => 'GPSLongitude',
    );

die $usage if ! getopts('a:djr:s');

die $usage if defined($opt_j) && defined($opt_r);

$DEBUG = 1 if defined($opt_d);
$WRITE = 0 if defined($opt_d);

my $gpsoffset = undef;
if (defined($opt_a)) {
    my $adjust = $opt_a;
    if ($adjust =~ /^[-+]?(\d+):(\d+):(\d+)$/) {
	$gpsoffset = $1*3600 + $2*60 + $3;
    } elsif ($adjust =~ /^[-+]?(\d+):(\d+)$/) {
	$gpsoffset = $1*60 + $2;
    } else {
	die "Don't understand adjustment: $adjust\n";
    }

    print STDERR "GPS is $gpsoffset seconds ";
    print STDERR $adjust =~ /^\-/ ? "behind " : "ahead of ";
    print STDERR "camera.\n";

    $gpsoffset = -$gpsoffset if $adjust =~ /^\-/;
}

my $image = shift @ARGV || die $usage;
die "File doesn't exist: $image\n" if ! -f $image;

standardMeta() if $opt_s;

my @metakey = ();
my @metaval = ();

if (defined($opt_r)) {
    die "File doesn't exist: $opt_r\n" if ! -f $opt_r;
    open (F, $opt_r);
    read (F, $_, -s $opt_r);
    close (F);
    initWithRDF($_);
} elsif (defined($opt_j)) {
    initWithJpegRDF($image);
}

while ($ARGV[0] =~ /^(\S+)=(.*)$/) {
    addTag($1, $2);
    shift @ARGV;
}

die $usage if @ARGV;

my $exif = new Image::ExifTool;
$exif->Options(IgnoreMinorErrors => '1');
$exif->ExtractInfo($image);
gpsData($exif, $gpsoffset) if defined($gpsoffset);

my %reset = ();
for (my $count = 0; $count <= $#metakey; $count++) {
    my $key = $metakey[$count];
    my $val = $metaval[$count];
    my $field = fieldMap($key);
    die "Invalid meta field: $key\n" if ! defined($field);
    $exif->SetNewValue($field) unless exists $reset{$field};
    $reset{$field} = 1;
    my $func = "set$field";
    {
	no strict 'refs';
	\&$func($exif,$val);
    }
}

my $rc = 0;

if ($WRITE) {
    print "Writing $image\n";
    $rc = $exif->WriteInfo($image);
} else {
    print "NOT Writing $image\n";
    $rc = 1;
}

if ($rc == 0) {
    my $errorMessage = $exif->GetValue('Error');
    my $warningMessage = $exif->GetValue('Warning');
    print STDERR "$image: $errorMessage\n";
    print STDERR "\t$warningMessage\n";
    exit 1;
} else {
    exit 0;
}

# ============================================================

sub addTag {
    my $key = shift;
    my $val = shift;

    #if ($DEBUG) {
    #    print "Add $key=$val\n";
    #}

    die "Unexpected tag: $key\n" if !exists $tagMap{$key};

    push (@metakey, $key);
    push (@metaval, $val);
}

sub fieldMap {
    my $key = shift;
    return $tagMap{$key} if exists $tagMap{$key};
    return undef;
}

sub setValue {
    my $exif = shift;
    my $field = shift;
    my $val = shift;

    if ($DEBUG) {
	print STDERR "Set $field=$val\n";
    }

    $exif->SetNewValue($field, $val);
}

sub setSubject {
    my $exif = shift;
    my $val = shift;
    setValue($exif,'Keywords',$val);
    setValue($exif,'Subject',$val);
}

sub setTitle {
    my $exif = shift;
    my $val = shift;
    setValue($exif,'ObjectName',$val);
    setValue($exif,'Title',$val);
}

sub setDescription {
    my $exif = shift;
    my $val = shift;
    setValue($exif,'ImageDescription',$val);
    setValue($exif,'Caption-Abstract',$val);
    setValue($exif,'Description',$val);
}

sub setComment {
    my $exif = shift;
    my $val = shift;

    $val =~ s/\\n/\n/sg;

    setValue($exif,'Comment',$val);
}


sub setCopyright {
    my $exif = shift;
    my $val = shift;

    $val =~ s/\\n/\n/sg;

    setValue($exif,'Copyright',$val);
    setValue($exif,'CopyrightNotice',$val);
    setValue($exif,'Rights',$val);
}

sub setUsageTerms {
    my $exif = shift;
    my $val = shift;

    $val =~ s/\\n/\n/sg;

    setValue($exif,'UsageTerms',$val);
}

sub setPublisher {
    my $exif = shift;
    my $val = shift;
    setValue($exif,'Publisher',$val);
}

sub setRights {
    my $exif = shift;
    my $val = shift;

    $val =~ s/\&\#169;/©/sg;

    setValue($exif,'Rights',$val);
}

sub setLicense {
    my $exif = shift;
    my $val = shift;
    setValue($exif,'License',$val);
    setValue($exif,'WebStatement',$val);
}

sub setCreator {
    my $exif = shift;
    my $val = shift;
    setValue($exif,'Creator',$val);
}

sub setCoverage {
    my $exif = shift;
    my $val = shift;

    $val = $1 if $val =~ /^.*\#(.*)$/;
    $val = $1 if $val =~ /http:\/\/norman.walsh.name.*\/([^\/]+)$/;

    die "Not found in places: $val\n" if ! exists $places{$val};
    
    setLocation($exif,@{$places{$val}});

    return;

    if ($val eq '#us-ma-belchertown') {
	setLocation($exif, 'US', 'MA', 'Belchertown');
	setValue($exif,'Coverage',$val);
    } elsif ($val eq '#us-ma-cambridge') {
	setLocation($exif, 'US', 'MA', 'Cambridge');
	setValue($exif,'Coverage',$val);
    } elsif ($val eq '#us-ma-amherst') {
	setLocation($exif, 'US', 'MA', 'Amherst');
	setValue($exif,'Coverage',$val);
    } else {
	setValue($exif,'Sub-Location',$val);
	setValue($exif,'Location',$val);
	setValue($exif,'Coverage',$val);
    }
}

sub setLocation {
    my $exif = shift;
    my $country = shift;
    my $state = shift;
    my $city = shift;
    my $addr = shift;

    setValue($exif,'City',$city) if $city ne '';;
    setValue($exif,'Province-State',$state) if $state ne '';
    setValue($exif,'State',$state) if $state ne '';
    setValue($exif,'Country-PrimaryLocationName',$country) if $country ne '';
    setValue($exif,'Country Code', $country) if $country ne '';
    setValue($exif,'Country', $country) if $country ne '';

    if ($addr ne '') {
	setValue($exif,'Sub-Location',$addr);
	setValue($exif,'Location',$addr);
    }
}

sub setGPSLatitude {
    my $exif = shift;
    my $val = shift;
    my $ref = 'N';
    if ($val < 0) {
	$ref = 'S';
	$val = -$val;
    }
    my $deg = int($val);
    my $frac = $val - $deg;
    my $min = int($frac * 60);
    $frac = ($frac * 60) - $min;
    my $sec = $frac * 60;

    setValue($exif, 'GPSLatitude', "$deg:$min:$sec");
    setValue($exif, 'GPSLatitudeRef', $ref);
}

sub setGPSLongitude {
    my $exif = shift;
    my $val = shift;
    my $ref = 'E';
    if ($val < 0) {
	$ref = 'W';
	$val = -$val;
    }
    my $deg = int($val);
    my $frac = $val - $deg;
    my $min = int($frac * 60);
    $frac = ($frac * 60) - $min;
    my $sec = $frac * 60;

    setValue($exif, 'GPSLongitude', "$deg:$min:$sec");
    setValue($exif, 'GPSLongitudeRef', $ref);
}

sub setGPSAltitude {
    my $exif = shift;
    my $val = shift;
    my $ref = '0';

    my $meters = ($val * 12 * 2.54) / 100.0;

    setValue($exif, 'GPSAltitude', $meters);
    setValue($exif, 'GPSAltitudeRef', $ref);
}

# ============================================================

sub initWithRDF {
    local $_ = shift;
    my $comment = "";

    $_ = patchIDs($_);

    die "Supplied RDF isn't RDF.\n" if !/<rdf:RDF.*?>\s*(.*?)\s*<\/rdf:RDF>/s;
    $_ = $1;

    $_ = $1 if /^<.*?>\s*(.*)\s*<\/.*?>/s;

    while ($_ ne '') {
	if (/^<(.*?) rdf:parseType=[\'\"]Resource[\'\"]>(.*?)<\/\1>\s*/s) {
	    $_ = $POSTMATCH;
	    my $tag = $1;
	    my $val = $2;

	    my $ok = 0;
	    if ($tag eq 'foaf:depicts') {
		if ($val =~ /<rdf:type rdf:resource=([\"\'])(.*?)\1\/>/s) {
		    depicts($2);
		    $ok = 1;
		}
	    } elsif ($tag eq 'dcterms:spatial' || $tag eq 'geo:Point') {
		addTag($1, $2) if $val =~ /<(geo:lat)>(.*?)</s;
		addTag($1, $2) if $val =~ /<(geo:long)>(.*?)</s;
		addTag($1, $2) if $val =~ /<(geo:altitude)>(.*?)</s;
		$ok = 1;
	    }

	    die "Unparseable resource: $tag\n" if !$ok && oktag($tag);
	} elsif (/^<(.*?)>(.*?)<\/\1>\s*/s) {
	    $_ = $POSTMATCH;
	    my $tag = $1;
	    my $val = $2;
	    if (oktag($tag)) {
		addTag($1,$2);
	    }
	} elsif (/^<(.*?) ([^>]*)\/>\s*/s) {
	    $_ = $POSTMATCH;
	    my $tag = $1;
	    my $val = $2;

	    if (oktag($tag)) {
		my $ok = 0;
		if ($val =~ /rdf:resource=([\"\'])(.*?)\1/s) {
		    if ($tag eq 'foaf:depicts') {
			depicts($2);
		    } else {
			addTag($tag,$2);
		    }
		    $ok = 1;
		}

		die "Unparseable: $tag\n" if !$ok;
	    }
	} else {
	    die "Unparseable RDF: $_\n";
	}
    }

    addTag('comment', "rdf:\n$comment") if $comment ne '';
}

sub depicts {
    my $uri = shift;

    if ($uri =~ /^http:\/\/norman.walsh.name\/knows\/who[\/\#]/) {
	addTag("dc:subject", $POSTMATCH);
    } elsif ($uri =~ /^http:\/\/norman.walsh.name\/knows\/what[\/\#]/) {
	addTag("dc:subject", $POSTMATCH);
    } elsif ($uri =~ /^http:\/\/xmlns.com\/wordnet\/1.6\//) {
	addTag("dc:subject", "wn:$POSTMATCH");
    } elsif ($uri =~ /^http:\/\/en.wikipedia.org\/wiki\//) {
	addTag("dc:subject", "wiki:$POSTMATCH");
    }  else {
	die "Unparseable depiction: $uri\n";
    }
}

sub patchIDs {
    local $_ = shift;

    my %ids = ();
    while (/<rdf:Description rdf:nodeID=([\"\'])(.*?)\1>(.*?)<\/rdf:Description>/s) {
	$ids{$2} = $3;
	$_ = $PREMATCH . $POSTMATCH;
    }

    while (/^(.*)<(.*?)\srdf:nodeID=([\"\'])(.*?)\3\/>(.*)$/s) {
	my $pre = $1;
	my $post = $5;
	my $tag = $2;
	my $id = $4;

	my $repl = "<$tag rdf:parseType='Resource'>" . $ids{$id} . "</$tag>";
	$_ = $pre . $repl . $post;
    }

    return $_;
}

sub oktag {
    my $tag = shift;
    return 0 if $tag =~ /^exifi?:/ || $tag =~ /^nikon.*?:/ || $tag =~ /^canon.*?:/;
    return 0 if $tag =~ /^NS\d+:/;
    return 0 if $tag =~ /^j\.\d+:/;
    return 0 if $tag eq 'dc:type' || $tag eq 'dc:format' || $tag eq 'dc:date';
    return 0 if $tag eq 'rdf:type';
    return 1;
}

sub initWithJpegRDF {
    my $image = shift;
    my $rdf = "";
    open (F, "jpegrdf -s $image |");
    while (<F>) {
	$rdf .= $_;
    }
    close (F);
    initWithRDF($rdf);
}

sub standardMeta {
    addTag('dc:creator', "http://norman.walsh.name/knows/who/norman-walsh");
    addTag('dc:publisher', "http://norman.walsh.name/knows/who/norman-walsh");
    addTag('dc:rights', "Copyright © 2007 Norman Walsh. This work is licensed under the Creative Commons Attribution-NonCommercial License.");
    addTag('cc:license', "http://creativecommons.org/licenses/by-nc/2.0/");
    addTag('terms',"This work is licensed under the Creative Commons Attribution-NonCommercial License.");
}

sub gpsData {
    my $exif = shift;
    my $offset = shift;

    my $dateTime = $exif->GetValue('DateTimeOriginal');

    if (!defined($dateTime)) {
	print STDERR "${usage}No EXIF dateTime?\n";
	return;
    }

    if ($dateTime !~ /^(\d{4}):(\d{2}):(\d{2}) (\d{2}):(\d{2}):(\d{2})$/) {
	print STDERR "${usage}Can't parse dateTime: $dateTime\n";
	return;
    }

    my ($year,$month,$day,$hour,$min,$sec) = ($1,$2,$3,$4,$5,$6);

    my $tstamp = timegm($sec,$min,$hour,$day,$month-1,$year-1900);

    $tstamp += $offset;

    ($sec,$min,$hour,$day,$month,$year) = gmtime($tstamp);
    $year += 1900;
    $month++;

    $dateTime = sprintf("%04d-%02d-%02d", $year, $month, $day);

    my @files = ();
    open (FIND, "find $TRACKDIR -type f -name \"20*.gpx\" -exec grep -l \"<time>${dateTime}T\" {} \\; |");
    while (<FIND>) {
	chop;
	push(@files,$_);
    }
    close (FIND);

    if (!@files) {
	print STDERR "No GPS data for $dateTime\n";
	return;
    }

    $dateTime .= sprintf("T%02d:%02d:%02dZ", $hour, $min, $sec);

    my %gps = ();
    foreach my $file (@files) {
	open (F, $file);
	read (F, $_, -s $file);
	close (F);

	foreach my $trkpt (m/<trkpt.*?<\/trkpt>/sg) {
	    my $lat = undef;
	    my $lon = undef;
	    my $ele = undef;
	    my $time = undef;

	    $lat = $2 if $trkpt =~ /lat=([\'\"])(.*?)\1/s;
	    $lon = $2 if $trkpt =~ /lon=([\'\"])(.*?)\1/s;
	    $ele = $1 if $trkpt =~ /<ele>(.*?)<\/ele>/s;
	    $time = $1 if $trkpt =~ /<time>(.*?)<\/time>/s;

	    $gps{$time} = {};
	    $gps{$time}->{'lat'} = $lat;
	    $gps{$time}->{'lon'} = $lon;
	    $gps{$time}->{'ele'} = $ele;
	}
    }

    my @times = sort keys %gps;
    my $time = shift @times;
    while (@times && $times[0] lt $dateTime) {
	$time = shift @times;
    }

    if ($time gt $dateTime || !@times) {
	print STDERR "Track does not contain $dateTime\n";
	return;
    }

    my $before = $time;
    $before =~ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})(\.\d+)?Z/;
    my $before_sec = timegm($6,$5,$4,$3,$2-1,$1-1900);

    my $after = $times[0];
    $after =~ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})(\.\d+)?Z/;
    my $after_sec = timegm($6,$5,$4,$3,$2-1,$1-1900);

    my $geordf = "";

    #print STDERR "Interpolating latitude/longitude for $dateTime...\n";

    my $eradius = 6378135;
    my $pradius = 6356750;

    my $latx = $gps{$before}->{'lat'};
    my $longx = $gps{$before}->{'lon'};
    my $elex = $gps{$before}->{'ele'};

    my $laty = $gps{$after}->{'lat'};
    my $longy = $gps{$after}->{'lon'};
    my $eley = $gps{$after}->{'ele'};

    my $interpolated = 1;
    my $lati = interpolate($latx, $laty, $before_sec, $after_sec, $tstamp);
    my $longi = interpolate($longx, $longy, $before_sec, $after_sec, $tstamp);
    my $elei = interpolate($elex, $eley, $before_sec, $after_sec, $tstamp);

    if ($tstamp == $before_sec) {
	$lati = $latx;
	$longi = $longx;
	$elei = $elex;
	$interpolated = 0;
    }

    if (abs($tstamp - $before_sec) > 300) {
	printf STDERR ("%s off by %4.1fs REJECTED\n",
		       secs2dt($tstamp), abs($tstamp - $before_sec));
    } else {
	if ($interpolated) {
	    # See http://en.wikipedia.org/wiki/Earth_radius
	    my $a = $eradius;
	    my $b = $pradius;
	    my $a2 = $a * $a;
	    my $b2 = $b * $b;
	    my $cos2l = cos(deg2rad(90 - $latx));
	    $cos2l = $cos2l * $cos2l;
	    my $radius = ($a*$b) / sqrt($a2 - (($a2-$b2) * $cos2l));

	    my $m = great_circle_distance(deg2rad($longx), deg2rad(90 - $latx),
					  deg2rad($longy), deg2rad(90 - $laty),
					  $radius);

	    my $d1 = great_circle_distance(deg2rad($longx), deg2rad(90 - $latx),
					   deg2rad($longi), deg2rad(90 - $lati),
					   $radius);

	    my $d2 = great_circle_distance(deg2rad($longy), deg2rad(90 - $laty),
					   deg2rad($longi), deg2rad(90 - $lati),
					   $radius);

	    my $d = $d1 < $d2 ? $d1 : $d2;

	    if ($m < 250.0) {
		printf STDERR ("%s interpolated %3.1fm over %4.1fm (%4.1fs)\n",
			       secs2dt($tstamp), $d, $m, $after_sec-$before_sec);
		addTag("geo:lat", $lati);
		addTag("geo:long", $longi);
		addTag("geo:altitude", $elei);
	    } else {
		printf STDERR ("%s interpolated over %4.1fs (%4.1fm) REJECTED\n",
			       secs2dt($tstamp), $after_sec-$before_sec, $m);
	    }
	} else {
	    printf STDERR ("%s located exactly\n", secs2dt($tstamp));
	    addTag("geo:lat", $lati);
	    addTag("geo:long", $longi);
	    addTag("geo:altitude", $elei);
	}
    }
}

sub deg2dms {
    my $decdeg = shift;
    my $pos = shift;
    my $neg = shift;

    my $magn = abs($decdeg);
    my $deg = int($magn);
    my $min = int(($magn - $deg) * 60);
    my $sec = sprintf("%4.1f", ($magn - $deg - ($min / 60)) * 3600);

    return "$deg°$min'$sec\"" . ($decdeg < 0 ? $neg : $pos);
}

sub gps_lat {
    my $decdeg = shift;
    return deg2dms($decdeg, 'N', 'S');
}

sub gps_long {
    my $decdeg = shift;
    return deg2dms($decdeg, 'E', 'W');
}

sub dt2secs {
    my ($w3cdtf) = shift;
    my $secs = timegm(gmtime());
    my ($y,$mo,$d,$h,$mi,$s,$z)=();

    # Convert w3cdtf to seconds, if possible.
    if ($w3cdtf=~/^(\d\d\d\d)-(\d\d)-(\d\d)T(\d\d):(\d\d)(:(\d\d))?(.*)$/) {
	($y,$mo,$d,$h,$mi,$s,$z)=($1,$2-1,$3,$4,$5,$7?$7:0,$8);
	$secs=timegm($s,$mi,$h,$d,$mo,$y);
	if (defined($z) && ($z ne "Z") && ($z ne "+00:00") && ($z ne "-00:00")) {
	    $secs+=($1*60+$2)*60 if ($z=~/^\-(\d\d):(\d\d)$/);
	    $secs-=($1*60+$2)*60 if ($z=~/^\+(\d\d):(\d\d)$/);
	}
    }

    return $secs;
}

sub secs2dt {
    my ($seconds) = shift;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($seconds);
    return sprintf("%04d-%02d-%02dT%02d:%02d:%02dZ",
		   $year+1900, $mon+1, $mday, $hour, $min, $sec);
}

sub interpolate {
    my $p1 = shift;
    my $p2 = shift;
    my $t1 = shift;
    my $t2 = shift;
    my $tx = shift;

    my $perc = 0;

    if ($t2 - $t1 == 0) {
	$perc = 1;
    } else {
	$perc = ($tx - $t1) / ($t2 - $t1);
    }

    my $delta = abs($p1 - $p2) * $perc;

    if ($p1 > $p2) {
	return $p1 - $delta;
    } else {
	return $p1 + $delta;
    }
}