# $Id.pm,v 1.11 2007/06/07 06:55:36 asc Exp $

package Net::Flickr::Geo;
use base qw (Net::Flickr::API);

$Net::Flickr::Geo::VERSION = '0.4';

=head1 NAME 

Net::Flickr::Geo - tools for working with geotagged Flickr photos

=head1 SYNOPSIS

 use Config::Simple;
 use Net::Flickr::Geo;

 my $cfg = Config::Simple->new("/path/to/config");
 my $fl  = Net::Flickr::Geo->new($cfg);

 mt $id     = '99999999';
 my $upload = 1;

 my @res = $fl->mk_pinwin_map($id, $upload);

 # returns :
 # ['/tmp/GGsf4552h.jpg', '99999992'];


=head1 DESCRIPTION

Tools for working with geotagged Flickr photos.

=head1 OPTIONS

Options are passed to Net::Flickr::Backup using a Config::Simple object or
a valid Config::Simple config file. Options are grouped by "block".

=head2 flick

=over 4

=item * B<api_key>

String. I<required>

A valid Flickr API key.

=item * B<api_secret>

String. I<required>

A valid Flickr Auth API secret key.

=item * B<auth_token>

String. I<required>

A valid Flickr Auth API token.

The B<api_handler> defines which XML/XPath handler to use to process API responses.

=over 4 

=item * B<LibXML>

Use XML::LibXML.

=item * B<XPath>

Use XML::XPath.

=back

=back

=head2 pinwin

=over 4

=item * B<map_source>

Valid options are :

=over 4

=item * B<yahoo>

Fetch images using the Yahoo! Map Image API

=item * B<modestmaps>

Fetch images using the ModestMaps map tile composer.

ModestMaps is Python based and You will need to have a current version of the
ModestMaps libraries, and all its dependencies, installed whatever machine is
using Net::Flickr::Geo.

=back

Default is I<yahoo>.

=item * B<map_mode>

Convert the background map image to use a different colour scale.
Valid options are :

=over 4

=item * B<grey>

You know, black and white and all that grey in between.

=back

Default is none (or colour).

=item * B<map_height>

The height of the background map on which the pinwin/thumbnail will be
placed.

Default is 1024.

=item * B<map_width>

The width of the background map on which the pinwin/thumbnail will be
placed.

Default is 1024.

=item * B<map_radius>

Set the Yahoo! Map Image API 'radius' property. From the docs :

"How far (in miles) from the specified location to display on the map."

Default is none, and to use a zoom level that maps to the I<accuracy> property
of a photo.

=item * B<upload_public>

Mark pinwin uploads to Flickr as viewable by anyone.

Default is false.

=item * B<upload_friend>

Mark pinwin uploads to Flickr as viewable only by friends.

Default is false.

=item * B<upload_family>

Mark pinwin uploads to Flickr as viewable only by family.

Default is false.

=back 

=head2 yahoo

=over 4

=item * B<appid>

A valid Yahoo! developers API key.

=back

=head2 modestmaps

=over 4

=item * B<server>

The URL to a server running the ws-compose.py HTTP interface to the 
ModestMaps tile-creation service.

This requires Modest Maps revision 339 or higher.

=item * B<provider>

A map provider and tile format for generating map images.

As of this writing, current providers are :

=over 4

=item * B<MICROSOFT_ROAD>

=item * B<MICROSOFT_AERIAL>

=item * B<MICROSOFT_HYBRID>

=item * B<GOOGLE_ROAD>

=item * B<GOOGLE_AERIAL>

=item * B<GOOGLE_HYBRID>

=item * B<YAHOO_ROAD>

=item * B<YAHOO_AERIAL>

=item * B<YAHOO_HYBRID>

=back 

=back

=cut

use File::Temp qw (tempfile);

use LWP::UserAgent;
use LWP::Simple;
use HTTP::Request;
use Geo::Coordinates::DecimalDegrees;
use Flickr::Upload;
use MIME::Base64;

=head1 PACKAGE METHODS

=cut

=head2 __PACKAGE__->new($cfg)

Returns a I<Net::Flickr::Geo> object.

=cut

# Defined in Net::Flickr::API

sub init {
        my $self = shift;
        my $args = shift;

        if (! $self->SUPER::init($args)){
                return undef;
        }

        my $b64 = '';

        {
                local $/;
                undef $/;
                $b64 = <DATA>;
        }

        my ($fh, $pinwin) = tempfile(UNLINK => 0, SUFFIX => ".png");

        $fh->print(MIME::Base64::decode_base64($b64));
        $fh->close();

        if (! -s $pinwin){
                $self->log()->error("failed to create pinwin ($pinwin)");
                return 0;
        }

        $self->log()->info("created temporary pinwin : $pinwin");
        $self->{'__pinwin'} = $pinwin;
        return 1;
}

=head1 OBJECT METHODS YOU SHOULD CARE ABOUT

=cut

=head2 $obj->mk_pinwin_map($photo_id, $upload=0, $out='')

Fetch a map using the Yahoo! Map Image API for a geotagged Flickr photo
and place a "pinwin" style thumbnail of the photo over the map's marker.

Returns a list.

The first element of the list will be the path to the newly created map
image. If uploads are enabled the newly created Flickr photo ID will be
passed as the second element.

=cut

sub mk_pinwin_map {
        my $self     = shift;
        my $photo_id = shift;
        my $upload   = shift;
        my $out      = shift;

        my $res = $self->api_call({'method' => 'flickr.photos.getInfo',
                                   'args'   => {'photo_id' => $photo_id}});

        if (! $res){
                return undef;
        }

        my $ph  = ($res->findnodes("/rsp/photo"))[0];
        my $map = $self->plot_photo($ph, $out);

        if (! $map){
                return undef;
        }

        my @res = ($map);

        if ($upload){
                my $id = $self->upload_map($ph, $map);
                push @res, $id;
        }

        return (\@res);
}

=head2 $obj->mk_pinwin_maps_for_set($set_id, $upload=0)

For each geotagged photo in a set, Ffetch a map using the Yahoo! Map
Image API for a geotagged Flickr photo and place a "pinwin" style
thumbnail of the photo over the map's marker.

If uploads are enabled then each map for a given photo will be
added such that it appears before the photo it references.

Returns a list of array references.

The first element of each array reference will be the path to the newly
created map image. If uploads are enabled the newly created Flickr photo
ID will be passed as the second element.

=cut

sub mk_pinwin_maps_for_set {
        my $self   = shift;
        my $set_id = shift;
        my $upload = shift;

        my $res = $self->api_call({'method' => 'flickr.photosets.getPhotos',
                                   'args' => {'photoset_id' => $set_id,
                                              'extras'      => 'geo, machine_tags'}});

        if (! $res){
                return undef;
        }

        my @maps = ();
        my @set  = ();

        my %ihasamapz = ();

        foreach my $ph ($res->findnodes("/rsp/photoset/photo")){

                my $id = $ph->getAttribute("id");
                my $mt = $ph->getAttribute("machine_tags");

                if ($mt =~ /\bflickr\:map\=pinwin\b/){

                        if ($mt =~ /\bflickr\:photo\=(\d+)\b/){
                                $ihasamapz{$1} = $id;
                        }
                       
                        $self->log()->info("photo id $id tagged pinwin, skipping");
                        next;
                }

                if (my $mapid = $ihasamapz{$id}){
                        $self->log()->info("photo id $id already has a map $mapid, skipping");
                        next;
                }

                if (! $ph->getAttribute("latitude")){
                        $self->log()->info("photo id $id has no geo information, skipping");
                        next;
                }

                # 

                my $map = $self->plot_photo($ph);

                if (! $map){
                        next;
                }

                my @local_res = ($map);

                if ($upload){
                        my $id = $self->upload_map($ph, $map);

                        push @local_res, $id;
                        push @set, $id;
                        push @set, $ph->getAttribute("id");
                }

                push @maps, \@local_res;
        }

        if (($upload) && (scalar(@set))) {
                $self->api_call({'method' => 'flickr.photosets.editPhotos',
                                 'args' => {'photoset_id'      => $set_id,
                                            'primary_photo_id' => $set[0],
                                            'photo_ids'        => join(",", @set)}});
        }

        return @maps;
}

=head2 $obj->mk_pinwin_maps_for_photoset($set_id, $upload)

This is just an alias for I<mk_pinwin_maps_for_photoset>.

=cut

sub mk_pinwin_maps_for_photoset {
        my $self = shift;
        $self->mk_pinwin_maps_for_set(@_);
}

sub plot_photo {
        my $self = shift;
        my $ph   = shift;
        my $out  = shift;

        $out ||= $self->mk_tempfile(".jpg");

        my $map  = $self->fetch_map_image($ph);

        if (! $map) {
                return undef;
        }

        my $thumb = $self->fetch_flickr_photo($ph, "thumb");

        if (! $thumb){
                return undef;
        }

        my $new = $self->modify_map($ph, $map, $thumb, $out);

        unlink($map);
        unlink($thumb);
        return $new;
}

sub fetch_flickr_photo {
        my $self = shift;
        my $ph = shift;

        my $id = $ph->getAttribute("id");
        my $fid = $ph->getAttribute("farm");
        my $sid = $ph->getAttribute("server");;
        my $secret = $ph->getAttribute("secret");
        
        my $static_url = "http://farm" . $fid . ".static.flickr.com/" . $sid . "/" . $id . "_" . $secret . "_s.jpg";
        return $self->simple_get($static_url, $self->mk_tempfile(".jpg"));
}

sub mk_tempfile {
        my $self = shift;
        my $ext  = shift;

        my ($fh, $filename) = tempfile(UNLINK => 0, SUFFIX => $ext);
        return $filename;
}

sub simple_get {
        my $self   = shift;
        my $remote = shift;       
        my $local  = shift;

        $local ||= $self->mk_tempfile();

        $self->log()->info("fetch remote file : $remote");
        $self->log()->info("store local file : $local");

        if (! getstore($remote, $local)){
                $self->log()->error("failed to retrieve remote URL ($remote)");
                return 0;
        }

        return $local;
}

sub fetch_map_image {
        my $self = shift;
        my $ph = shift;

        my $lat = $self->get_geo_property($ph, "latitude");
        my $lon = $self->get_geo_property($ph, "longitude");
        my $acc = $self->get_geo_property($ph, "accuracy");

        if ((! $lat) || (! $lon)){
                return undef;
        }

        my $src = $self->{'cfg'}->param("pinwin.map_source");

        if ($src eq "modestmaps"){
                return $self->fetch_modest_map_image($lat, $lon, $acc);
        }
        
        return $self->fetch_yahoo_map_image($lat, $lon, $acc);
}

sub fetch_modest_map_image {
        my $self = shift;
        my $lat  = shift;
        my $lon  = shift;
        my $acc  = shift;

        my $out = $self->mk_tempfile(".png");

        my $provider = $self->{'cfg'}->param("modestmaps.provider");

        $provider =~ /^([^_]+)_/;
        my $short = lc($1);

        $acc = $self->mk_flickr_accuracy($short . "_mm", $acc);

        if (my $enforced = $self->{'cfg'}->param("modestmaps.enforce_zoom")){
                if ($acc > $enforced){
                        $acc = $enforced;
                }
        }

        my $h = $self->pinwin_map_dimensions("height");
        my $w = $self->pinwin_map_dimensions("width");

        my $remote = $self->{'cfg'}->param("modestmaps.server");

        my $url = sprintf("%s?provider=%s&latitude=%s&longitude=%s&accuracy=%s&height=%s&width=%s",
                          $remote, $provider, $lat, $lon, $acc, $h, $w);

        return $self->simple_get($url, $out);
}

sub fetch_yahoo_map_image {
        my $self = shift;
        my $lat = shift;
        my $lon = shift;
        my $acc = shift;

        my $appid = $self->{'cfg'}->param("yahoo.appid");

        my $h = $self->pinwin_map_dimensions("height");
        my $w = $self->pinwin_map_dimensions("width");

        my $ua  = LWP::UserAgent->new();
        my $url = "http://local.yahooapis.com/MapsService/V1/mapImage?image_width=" . $w . "&image_height=" . $h . "&appid=" . $appid . "&latitude=" . $lat . "&longitude=" . $lon;

        if (my $r = $self->{'cfg'}->param("pinwin.map_radius")){
                $url .= "&radius=$r";
        }

        else {
                my $z = $self->mk_flickr_accuracy('yahoo', $acc);
                $url .= "&zoom=$z";
        }

        $self->log()->info("fetch yahoo map : $url");

        my $req = HTTP::Request->new(GET => $url);
        my $res = $ua->request($req);

        if (! $res->is_success()){
                $self->log()->error("failed to retrieve yahoo map : " . $res->code());
                return 0;
        }

        my $xml = $self->_parse_results_xml($res);

        if (! $xml){
                $self->log()->error("failed to parse yahoo api response");
                return 0;
        }
        
        my $map = $xml->findvalue("/Result");
        return $self->simple_get($map, $self->mk_tempfile(".png"));
}

sub mk_flickr_accuracy {
        my $self     = shift;
        my $provider = shift;
        my $acc      = shift;

        # yahoo : 1 (street) - 12 (country)
        # flickr : 1 (world) - 16 (street)
        
        my %map = ('yahoo' => {1 => 12,
                               2 => 12,
                               3 => 12,
                               4 => 11,
                               5 => 10,
                               6 => 9,
                               7 => 8,
                               8 => 7,
                               9 => 6,
                               10 => 5,
                               12 => 4,
                               13 => 3,
                               14 => 2,
                               15 => 1,
                               16 => 1},
                  );

        # 

        foreach my $i (1..17) {                
                foreach my $p ('google', 'microsoft', 'yahoo'){

                        my $key = $p . "_mm";
                        $map{$key} ||= {};
                        $map{$key}->{$i} = $i + 1;
                }
        }

        # 

        if (! exists($map{$provider})){
                return 0;
        }

        if (! exists($map{$provider}->{$acc})){
                return 0;
        }

        return $map{$provider}->{$acc};
}

sub modify_map {
        my $self  = shift;
        my $ph    = shift;
        my $map   = shift;
        my $thumb = shift;
        my $out   = shift;

        #

        my $pinwin = $self->{'__pinwin'};

        # work files

        my $grmap    = $self->mk_tempfile(".png");
        my $pinthumb = $self->mk_tempfile(".png");

        # place the thumb on the pinwin

        my $th_cmd = "composite -quality 100 -geometry +11+10 $thumb $pinwin $pinthumb";        

        $self->log()->info($th_cmd);     
        system($th_cmd);

        if ($self->{'cfg'}->param("pinwin.map_mode") eq "grey") {
                # create a greyscale map
                
                my $grmap  = $self->mk_tempfile(".jpg");                
                my $gr_cmd = "convert -quality 100 -colorspace GRAY $map $grmap";

                $self->log()->info($gr_cmd);     
                system($gr_cmd);

                $map = $grmap;
        }

        # place the pinwin on the map

        my $h = $self->pinwin_map_dimensions("height");
        my $w = $self->pinwin_map_dimensions("width");

        my $geo_h = int($h / 2) - 134;
        my $geo_w = int($w / 2) - 28;

        my $map_cmd = "composite -quality 100 -geometry +" . $geo_w . "+" . $geo_h . " $pinthumb $map $out";

        $self->log()->info($map_cmd);
        system($map_cmd);

        # clean up 

        unlink($grmap);
        unlink($flmap);
        unlink($pinthumb);

        return $out;
}

sub get_geo_property {
        my $self = shift;
        my $ph = shift;
        my $prop = shift;

        my $value = $ph->getAttribute($prop);

        if (! $value){
                $value = $ph->findvalue("location/\@" . $prop);
        }

        return $value;
}

sub pretty_print_latlong {
        my $self = shift;
        my $lat = shift;
        my $lon = shift;

        my @lat_dms = decimal2dms($lat);
        my $ns = ($lat_dms[3]) ? "N" : "S";

        my $str_lat = sprintf(qq(%d° %d' %d" $ns), @lat_dms);

        my @lon_dms = decimal2dms($lon);
        my $ew = ($lon_dms[3]) ? "E" : "W";

        my $str_lon = sprintf(qq(%d° %d' %d" $ew), @lon_dms);
        return "$str_lat, $str_lon";
}

sub upload_map {
        my $self = shift;
        my $ph   = shift;
        my $map  = shift;

        my $ua  = Flickr::Upload->new({'key'=> $self->{'cfg'}->param("flickr.api_key"),
                                       'secret' => $self->{'cfg'}->param("flickr.api_secret")});

        #

        my $lat = $self->get_geo_property($ph, "latitude");
        my $lon = $self->get_geo_property($ph, "longitude");
        my $title = $self->pretty_print_latlong($lat, $lon);

        my $tag = "flickr:photo=" . $ph->getAttribute("id");

        my $public = ($self->{'cfg'}->param("pinwin.upload_public")) ? 1 : 0;
        my $friend = ($self->{'cfg'}->param("pinwin.upload_friend")) ? 1 : 0;
        my $family = ($self->{'cfg'}->param("pinwin.upload_family")) ? 1 : 0;

        $self->log()->info("upload to flickr : $map ");
        $self->log()->info("meta : $title perms : $public; $friend; $family");

        my $id = undef;

        eval {
                $id = $ua->upload(
                            'photo'      => $map,
                                  'auth_token' => $self->{cfg}->param("flickr.auth_token"),
                                  'title'      => $title,
                                  'tags'       => "$tag flickr:map=pinwin",
                                  'is_public'  => $public,
                                  'is_friend'  => $friend,
                                  'is_family'  => $family,
                                 );
        };

        if (! $id) {
                $self->log()->error("failed to upload photo, $@");
                return;
        }

        # This is not a love song...

        $self->api_call({'method' => 'flickr.photos.setContentType',
                         'args' => {'photo_id' => $id, 'content_type' => 3}});


        $self->log()->info("photo uploaded with ID $id");
        return $id;
}

sub pinwin_map_dimensions {
        my $self = shift;
        my $prop = shift;

        my $v = $self->{'cfg'}->param("pinwin.map_" . $prop);
        $v ||= 1024;
        return $v;
}

sub DESTROY {
        my $self = shift;
        $self->log()->info("removing temporary pinwin : " . $self->{'__pinwin'});
        unlink($self->{'__pinwin'});
        $self->SUPER::DESTROY();
}

=head1 VERSION

0.4

=head1 DATE

$Date: 2007/08/26 04:26:50 $

=head1 AUTHOR

Aaron Straup Cope  E<lt>ascope@cpan.orgE<gt>

=head1 NOTES

All uploads to Flickr are marked with a content-type of "other".

=head1 IMPORTANT

B<This package requires that you have the command-line version of ImageMagick installed.>

It will be updated to use the Perl I<Image::Magick> libraries in future releases.

=head1 SEE ALSO

L<Net::Flickr::API>

L<http://developer.yahoo.com/maps/rest/V1/mapImage.html>

L<http://modestmaps.mapstraction.com/>

L<http://mike.teczno.com/notes/oakland-crime-maps/IX.html>

L<http://www.aaronland.info/weblog/2007/07/28/trees/#delmaps_pm>

L<http://www.aaronland.info/weblog/2007/06/08/pynchonite/#net-flickr-geo>

L<http://www.aaronland.info/weblog/2007/06/08/pynchonite/#nfg_mm>

L<http://flickr.com/photos/straup/sets/72157600321286227/>

L<http://www.flickr.com/help/filters/>

=head1 BUGS

Sure, why not.

Please report all bugs via L<http://rt.cpan.org>

=head1 LICENSE

Copyright (c) 2007 Aaron Straup Cope. All Rights Reserved.

This is free software. You may redistribute it and/or
modify it under the same terms as Perl itself.

=cut

return 1;

__DATA__

RU5ErkJggg==
