#!/usr/bin/perl -- # -*- Perl -*-
#
# flickrpub extracts metadata from RDF or EXIF and publishes to Flickr
#
# It's a total hack of flickr_upload by Christophe Beauregard, part 
# of the Perl Flickr::Upload package.
#
# 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 warnings;
use Flickr::Upload;
use Getopt::Long;
use Pod::Usage;
use Image::ExifTool;
use English;

# You have to put yours in the ~/.flickrrc file
my $api_key = undef;
my $not_so_secret = undef;

my %args;
my @tags = ();
my $help = 0;
my $man = 0;
my $auth = 0;
my $debug = 0;
my $rdf = 0;

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

if( open CONFIG, "< $ENV{HOME}/.flickrrc" ) {
	while( <CONFIG> ) {
		chomp;
		s/#.*$//;	# strip comments
		$args{$1} = $2 if m/^\s*([a-z_]+)=(.+)\s*$/io;
	}
	close CONFIG;
}

$api_key = $args{'api_key'};
$not_so_secret = $args{'not_so_secret'};

delete $args{'api_key'};
delete $args{'not_so_secret'};

GetOptions(
	'help|?' => \$help,
	'man' => \$man,
	'debug' => \$debug,
	'rdf' => \$rdf,
	'tag=s' => \@tags,
	'uri=s' => sub { $args{$_[0]} = $_[1] },
	'auth_token=s' => sub { $args{$_[0]} = $_[1] },
	'public=i' => sub { $args{is_public} = $_[1] },
	'friend=i' => sub { $args{is_friend} = $_[1] },
	'family=i' => sub { $args{is_family} = $_[1] },
	'title=s' => sub { $args{$_[0]} = $_[1] },
	'description=s' => sub { $args{$_[0]} = $_[1] },
	'key=s' => \$api_key,
	'secret=s' => \$not_so_secret,
	'auth' => \$auth,
) or pod2usage(2);
pod2usage(1) if $help;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;

my $version = qw($Revision: 1.7 $)[1];

my $ua = Flickr::Upload->new( {'key' => $api_key, 'secret' => $not_so_secret} );
$ua->agent( "flickr_upload/$version" );

if( $auth ) {
	# The user wants to authenticate. There's really no nice way to handle this.
	# So we have to spit out a URL, then hang around or something until
	# the user hits enter, then exchange the frob for a token, then tell the user what
	# the token is and hope they care enough to stick it into .flickrrc so they
	# only have to go through this crap once.

	# 1. get a frob
	my $frob = getFrob( $ua );

	# 2. get a url for the frob
	my $url = $ua->request_auth_url('write', $frob);

	# 3. tell the user what to do with it
	print "1. Enter the following URL into your browser\n\n",
	      "$url\n\n",
	      "2. Follow the instructions on the web page\n",
			"3. Hit <Enter> when finished.\n\n";

	# 4. wait for enter.
	<STDIN>;

	# 5. Get the token from the frob
	my $auth_token = getToken( $ua, $frob );
	die "Failed to get authentication token!" unless defined $auth_token;

	# 6. Tell the user what they won.
	print "You authentication token for this application is\n\t\t", $auth_token, "\n";

	exit 0;
}

pod2usage(1) unless exists $args{'auth_token'};
pod2usage(1) unless @ARGV;

$args{'tags'} = join( " ", @tags ) if @tags;

# pipeline things by uploading first, waiting for photo ids second.
#$args{'async'} = 1;
my %tickets;

$| = 1;
while( my $photo = shift @ARGV ) {
    print "Extracting metadata for $photo...\n";

    # Can we find the metadata?
    foreach my $key ('title', 'description', 'tags') {
	delete $args{$key} if exists $args{$key};
    }

    my $title = undef;
    my $desc = undef;
    my $tags = undef;
    my $lat = undef;
    my $long = undef;

    # Default title
    $title = $photo;
    $title =~ s/\.jpe?g//i;
    $title =~ s/.*\/([^\/]+)$/$1/ if $title =~ /\//;

    my $width = "???";
    my $height = "???";

    if ($rdf) {
	$_ = `jpegrdf -s $photo`;

	$title = $1 if /<dc:title>(.*?)<\/dc:title>/s;
	$desc = $1 if /<dc:description>(.*?)<\/dc:description>/s;
	@tags = m/<dc:subject>.*?<\/dc:subject>/sg;

	$width = $1 if /<exifi:width>(\d+)/s;
	$height = $1 if /<exifi:height>(\d+)/s;

	# We used to try to be clever here, looking for lat/long inside
	# dcterms:spatial, but rdf:nodeID made this messy so ...
	if (/<geo:lat>/s && /<geo:long>/s) {
	    $lat = $1 if /<geo:lat>(.*?)</s;
	    $long = $1 if /<geo:long>(.*?)</s;
	    
	    if (defined $lat && defined $long) {
		push (@tags,
		      sprintf("<dc:subject>geo:lat=%1.4f</dc:subject>", $lat));
		push (@tags,
		      sprintf("<dc:subject>geo:long=%1.4f</dc:subject>", $long));
		push (@tags, "<dc:subject>geotagged</dc:subject>");
	    }
	}

	if (/<dc:coverage/s) {
	    foreach my $cover (m/<dc:coverage.*?>/g) {
		push (@tags, sprintf("<dc:subject>%s</dc:subject>", $2))
		    if $cover =~ /rdf:resource=([\'\"])http:\/\/norman\.walsh\.name\/knows\/where[\#\/](.*?)\1/;
	    }
	}

	if (/<foaf:depicts/s) {
	    foreach my $depicts (m/<foaf:depicts.*?>/g) {
		push (@tags, sprintf("<dc:subject>%s</dc:subject>", $2))
		    if $depicts =~ /rdf:resource=([\'\"])http:\/\/norman\.walsh\.name\/knows\/who[\#\/](.*?)\1/;
	    }
	}

	foreach $_ (@tags) {
	    $tags .= " " if defined $tags;
	    $tags .= $1 if /<dc:subject>(\S+)<\/dc:subject>/;
	}

	$args{'title'} = $title;
	$args{'description'} = $desc if defined $desc;
	$args{'tags'} = $tags if defined $tags;
    } else {
	my $exif = new Image::ExifTool;
	$exif->Options(IgnoreMinorErrors => '1');
	$exif->ExtractInfo($photo);

	$width = $exif->GetValue('ImageWidth');
	$height = $exif->GetValue('ImageHeight');

	my $value = $exif->GetValue('Title');

	$args{'title'} = $value if defined($value);

	$value  = $exif->GetValue('Description');

	$args{'description'} = $value if defined($value);

	$value = $exif->GetValue('Keywords');

	my $tags = defined($value) ? $value : "";
	$tags =~ s/,\s+/ /g;

	my $gps = $exif->GetValue('GPSLatitude');
	if (defined($gps)) {
	    $tags .= " geotagged";

	    if ($gps =~ /(\d+) deg (\d+)\' (\d+\.\d+)\" ([NS])/) {
		$gps = $1 + ($2/60.0) + ($3/3600.0);
		$gps = -$gps if $4 eq 'S';
		$tags .= " geo:lat=$gps";
	    } else {
		warn "Unparseable latitude: $gps\n";
	    }

	    $gps = $exif->GetValue('GPSLongitude');
	    if ($gps =~ /(\d+) deg (\d+)\' (\d+\.\d+)\" ([EW])/) {
		$gps = $1 + ($2/60.0) + ($3/3600.0);
		$gps = -$gps if $4 eq 'W';
		$tags .= " geo:long=$gps";
	    } else {
		warn "Unparseable latitude: $gps\n";
	    }

	    $gps = $exif->GetValue('GPSAltitude');
	    if ($gps =~ /^(\d+(\.\d+)?) m/) {
		# ignore altitude for now
		#$tags .= " geo:altitude=$1m";
	    } else {
		warn "Unparseable latitude: $gps\n";
	    }
	}

	my $country = $exif->GetValue('Country');
	my $state = $exif->GetValue('State');
	my $city = $exif->GetValue('City');
	# FIXME: what about street address/location?
	if (defined($country)) {
	    my $place = "$country|$state|$city";
	    if (exists($placeuris{$place})) {
		$tags .= " " . $placeuris{$place};
	    } else {
		warn "No URI for $place\n";
	    }
	}

	$args{'tags'} = $tags;
    }

    $args{'tags'} = cleanupTags($args{'tags'});

    print "$photo: (", $width, "x", $height, ")\n";
    foreach my $key ('title', 'description', 'tags') {
	printf ("  %-11s: %s\n", $key, $args{$key}) if exists $args{$key};
    }

    #foreach my $key (keys %args) {
    #    printf ("arg: %s=%s\n", $key, $args{$key});
    #}

    if (!$debug) {
	print 'Uploading ', $photo, '...';

	my $rc = $ua->upload( 'photo' => $photo, %args );

	# let the caller know how many images weren't uploaded
	exit (1+@ARGV) unless defined $rc;

	# check those later
	$tickets{$rc} = $photo;

	print "\n";
    }
}

exit 0 if $debug;

exit 0;

# FIXME: Why did this stop working!?
print "Waiting for upload results (ctrl-C if you don't care)...\n";
do {
	sleep 1;
	my @checked = $ua->check_upload( keys %tickets );
	for( @checked ) {
		if( $_->{complete} == 0 ) {
			# not done yet, don't do anythig
		} elsif( $_->{complete} == 1 ) {
			# uploaded, got photoid
			print "$tickets{$_->{id}} is at " .
				"http://www.flickr.com/tools/uploader_edit.gne?ids=$_->{photoid}\n";
			delete $tickets{$_->{id}};
		} else {
			print "$tickets{$_->{id}} failed to get photoid\n";
			delete $tickets{$_->{id}};
		}
	}
} while( %tickets );

exit 0;

sub cleanupTags {
    my $tags = shift;
    my @tags = ();
    foreach my $tag (split(/\s+/, $tags)) {
	if ($tag =~ /^wn-/ || $tag =~ /^wn:/) {
	    push(@tags, "$POSTMATCH");
	} elsif ($tag =~ /^wiki-/ || $tag =~ /^wiki:/) {
	    push(@tags, "$POSTMATCH");
	} else {
	    push(@tags, $tag);
	}
    }

    return join(" ", @tags);
}

sub response_tag {
	my $t = shift;
	my $name = shift;
	my $tag = shift;

	return undef unless defined $t and exists $t->{'children'};

	for my $n ( @{$t->{'children'}} ) {
		next unless $n->{'name'} eq $name;
		next unless exists $n->{'children'};

		for my $m (@{$n->{'children'}} ) {
			next unless exists $m->{'name'}
				and $m->{'name'} eq $tag
				and exists $m->{'children'};

			return $m->{'children'}->[0]->{'content'};
		}
	}
	return undef;
}

sub getFrob {
	my $ua = shift;

	my $res = $ua->execute_method("flickr.auth.getFrob");
	return undef unless defined $res and $res->{success};

	# FIXME: error checking, please. At least look for the node named 'frob'.
	return $res->{tree}->{children}->[1]->{children}->[0]->{content};
}

sub getToken {
	my $ua = shift;
	my $frob = shift;

	my $res = $ua->execute_method("flickr.auth.getToken",
		{ 'frob' => $frob } );
	return undef unless defined $res and $res->{success};

	# FIXME: error checking, please.
	return $res->{tree}->{children}->[1]->{children}->[1]->{children}->[0]->{content};
}