File Coverage

blib/lib/Net/Flickr/Geo.pm

Criterion	Covered	Total	%
statement	6	6	100.0
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	8	8	100.0

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

use strict;

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

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

=head1 NAME

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

=head1 SYNOPSIS

There is no synopsis. There is only documentation for provider specific
packages. Okay, I lied. There's a little bit below. But really, please
consult provider specific packaged for details.

=head1 DESCRIPTION

Tools for working with geotagged Flickr photos.

=head1 PROVIDERS

=head2 ModestMaps

Fetch maps using the Modest Maps ws-pinwin HTTP interface :

 #
 # Simple
 #

 my %opts = ();
 getopts('c:i:', \%opts);

 my $cfg = Config::Simple->new($opts{'c'});

 $cfg->param("pinwin.photo_size", "Medium");
 $cfg->param("modestmaps.filter", "atkinson");
 $cfg->param("pinwin.upload", 1);

 my $fl = Net::Flickr::Geo::ModestMaps->new($cfg);
 $fl->log()->add(Log::Dispatch::Screen->new('name' => 'scr', min_level => 'debug'));

 my $map = $fl->mk_pinwin_map_for_photo($opts{'i'});
 $fl->log()->info("wrote map to $map->[0]->[0]");

 #
 # Fancy
 #

 my %opts = ();
 getopts('c:s:', \%opts);

 my $cfg = Config::Simple->new($opts{'c'});

 my $fl = Net::Flickr::Geo::ModestMaps->new($cfg);
 $fl->log()->add(Log::Dispatch::Screen->new('name' => 'scr', min_level => 'info'));

 my $data = $fl->mk_poster_map_for_photoset($opts{'s'});
 $fl->log()->info(Dumper($data));

 my $tiles = $fl->upload_poster_map($data->{'path'});
 $fl->log()->info(Dumper($tiles));

=head2 YahooMaps

Fetch maps using the Yahoo! Maps Image API :

 #
 # Simple
 #

 my %opts = ();
 getopts('c:i:', \%opts);

 my $cfg = Config::Simple->new($opts{'c'});

 my $fl = Net::Flickr::Geo::YahooMaps->new($cfg);
 $fl->log()->add(Log::Dispatch::Screen->new('name' => 'scr', min_level => 'debug'));

 my $map = $fl->mk_pinwin_map_for_photo($opts{'i'});
 $fl->log()->info("wrote map to $map->[0]->[0]");

 #
 # Handy
 #

 my %opts = ();
 getopts('c:s:', \%opts);

 my $cfg = Config::Simple->new($opts{'c'});

 my $fl = Net::Flickr::Geo::YahooMaps->new($cfg);
 $fl->log()->add(Log::Dispatch::Screen->new('name' => 'scr', min_level => 'debug'));

 my $map = $fl->mk_pinwin_maps_for_photoset($opts{'s'});

 foreach my $data (@$map){
        $fl->log()->info("wrote image/map to $data->[0]");
 }

=head2 Google Maps

Fetch maps using the Google Maps Static Maps API :

 #
 # Simple
 #

 my %opts = ();
 getopts('c:i:', \%opts);

 my $cfg = Config::Simple->new($opts{'c'});

 my $fl = Net::Flickr::Geo::GoogleMaps->new($cfg);
 $fl->log()->add(Log::Dispatch::Screen->new('name' => 'scr', min_level => 'debug'));

 $cfg->param("google.map_type", "mobile");

 my $map = $fl->mk_pinwin_map_for_photo($opts{'i'});
 $fl->log()->info("wrote map to $map->[0]->[0]");

=head2 MultiMaps

Fetch maps using the MultiMap Static Maps API :

 #
 # Simple
 #

 my %opts = ();
 getopts('c:i:', \%opts);

 my $cfg = Config::Simple->new($opts{'c'});

 my $fl = Net::Flickr::Geo::MultiMaps->new($cfg);
 $fl->log()->add(Log::Dispatch::Screen->new('name' => 'scr', min_level => 'debug'));

 my $map = $fl->mk_pinwin_map_for_photo($opts{'i'});
 $fl->log()->info("wrote map to $map->[0]->[0]");

=head1 IMPORTANT

B
compatible.>

Please adjust your code and expectations accordingly. It shouldn't
happen again...

=cut

use File::Temp qw (tempfile);

use LWP::UserAgent;
use LWP::Simple;
use HTTP::Request;
use Geo::Coordinates::DecimalDegrees;
use Flickr::Upload;
use Image::Size;
use FileHandle;

#
# shared, and public
#

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

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

        $self->{'__cache'} = {'geo_perms' => {}};

        return 1;
}

sub mk_pinwin_map_for_photo {
        my $self     = shift;
        my $photo_id = shift;

        my $upload = $self->divine_option('pinwin.upload', 0);

        #

        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->mk_pinwin_map($ph);

        if (! $map){
                return undef;
        }

        my @res = ($map);

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

        return [ \@res ];
}

sub mk_pinwin_maps_for_photoset {
        my $self   = shift;
        my $set_id = shift;

        my $upload = $self->divine_option('pinwin.upload', 0);

        #

        my $photos = $self->collect_photos_for_set($set_id);

        if (! $photos){
                return undef;
        }

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

        foreach my $ph (@$photos){

                my $map = $self->mk_pinwin_map($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;
}

#
# shared, and not really public
#

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

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

        #

        my $thumb_data = $self->fetch_flickr_photo($ph);

        if (! $thumb_data){
                $self->log()->error("unable to retrieve photo $id");
                return undef;
        }

        #

        my $map_data  = $self->fetch_map_image($ph, $thumb_data);

        if (! $map_data) {
                $self->log()->error("unable to add photo $id to map");
                return undef;
        }

        my $new = $self->modify_map($ph, $map_data, $thumb_data);

        unlink($map_data->{'path'});
        unlink($thumb_data->{'path'});

        return $new;
}

sub collect_photos_for_set {
        my $self = shift;
        my $set_id = shift;

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

        if (! $res){
                return undef;
        }

        my %ihasamapz = ();
        my @photos = ();

        my $skip_ids = $self->divine_option("pinwin.skip_photos");
        my $ensure_tags = $self->divine_option("pinwin.ensure_tags");
        my $skip_tags = $self->divine_option("pinwin.skip_tags");

        if (($skip_ids) && (ref($skip_ids) ne 'ARRAY')){
                $skip_ids = [$skip_ids];
        }

        if (($ensure_tags) && (ref($ensure_tags) ne 'ARRAY')){
                $ensure_tags = [$ensure_tags];
        }

        if (($skip_tags) && (ref($skip_tags) ne 'ARRAY')){
                $skip_tags = [$skip_tags];
        }

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

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

                if (($skip_ids) && (grep /$id/, @$skip_ids)){
                        $self->log()->info("photo id $id excluded, skipping");
                        next;
                }

                #

                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;
                }

                if ($ensure_tags){
                        my $has_tag = 0;
                        my $tags = $ph->getAttribute("tags");

                        foreach my $t (@$ensure_tags){
                                if ($tags =~ /\b$t\b/){
                                        $has_tag = 1;
                                        last;
                                }
                        }

                        if (! $has_tag){
                                $self->log()->info("photo id $id does not contain required tags : " . join(";", @$ensure_tags));
                                next;
                        }

                }

                if ($skip_tags){

                        my $has_tag = 0;
                        my $tags = $ph->getAttribute("tags");

                        foreach my $t (@$skip_tags){
                                if ($tags =~ /\b$t\b/){
                                        $has_tag = 1;
                                        last;
                                }
                        }

                        if ($has_tag){
                                $self->log()->info("photo id $id has skippable tags : " . join(";", @$skip_tags));
                                next;
                        }
                }

                push @photos, $ph;
        }

        return \@photos;
}

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

        my $sz = $self->divine_option("pinwin.photo_size", "Small");
        my $ext = $self->flickr_photo_extension($sz);

        my $id = $ph->getAttribute("id");
        my $fid = $ph->getAttribute("farm");
        my $sid = $ph->getAttribute("server");;
        my $secret = $ph->getAttribute("secret");

        return "http://farm" . $fid . ".static.flickr.com/" . $sid . "/" . $id . "_" . $secret . $ext . ".jpg";
}

sub flickr_photo_extension {
        my $self = shift;
        my $size = shift;

        my %map = (
                   'square' => '_s',
                   'thumbnail' => '_t',
                   'small' => '_m',
                   'medium' => '',
                  );

        return $map{ lc($size) };
}

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

        my $url = $self->flickr_photo_url($ph);
        my $path =  $self->simple_get($url, $self->mk_tempfile(".jpg"));

        if (! $path){
                return undef;
        }

        my ($img_w, $img_h) = imgsize($path);

        my %data = (
                    'url' => $url,
                    'path' => $path,
                    'height' => $img_h,
                    'width' => $img_w,
                   );

        return \%data;
}

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 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 $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 %args = (
                    'photo'      => $map,
                    'title'      => $title,
                    'tags'       => "$tag flickr:map=pinwin",
                   );

        return $self->upload_image(\%args);
}

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

        $args->{'is_public'} = ($self->divine_option("pinwin.upload_public"), 0);
        $args->{'is_friend'} = ($self->divine_option("pinwin.upload_friend"), 0);
        $args->{'is_family'} = ($self->divine_option("pinwin.upload_family"), 0);
        $args->{'auth_token'} = $self->divine_option("flickr.auth_token");

        $self->log()->info("upload to flickr : $args->{photo}");

        my $id = undef;

        eval {

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

                $id = $ua->upload(%$args);
        };

        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 divine_option {
        my $self = shift;
        my $opt = shift;
        my $default = shift;

        my $v = $self->{'cfg'}->param($opt);

        if (defined($v)){
                $self->log()->info("divine by config : $opt => $v");
                return $v;
        }

        $self->log()->info("divine by default : $opt => $default");
        return $default;
}

sub load_pinwin {
        my $self = shift;

        if (! $self->{'__pinwin'}){

                use Net::Flickr::Geo::Pinwin;
                my $pinwin = Net::Flickr::Geo::Pinwin->mk_flickr_pinwin();

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

        return $self->{'__pinwin'};
}

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

        my $map_data = shift;
        my $thumb_data = shift;
        my $out = shift;

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

        my $pinwin = $self->load_pinwin();

        #

        my $truecolour = 1;

        use GD;
        my $pw = GD::Image->newFromPng($pinwin, $truecolour);
        $pw->alphaBlending(0);
        $pw->saveAlpha(1);

        my $th = GD::Image->newFromJpeg($thumb_data->{'path'});
        $th->alphaBlending(0);
        $th->saveAlpha(1);

        # place the thumb on the pinwin

        $pw->copy($th, 11, 10, 0, 0, 75, 75);

        #
        # so so wrong but for the life of me I can't figure
        # out why the transparency for the pinwin is not
        # preserved below...
        #

        my $pin = $self->mk_tempfile(".png");
        my $fh = FileHandle->new(">$pin");

        binmode($fh);
        $fh->print($pw->png(0));
        $fh->close();

        my $h = $self->divine_option("pinwin.map_height", 1024);
        my $w = $self->divine_option("pinwin.map_width", 1024);

        my $x = int($w / 2) - 28;
        my $y = int($h / 2) - 134;

        my $cmd = "composite -quality 100 -geometry +" . $x . "+" . $y . " $pin $map_data->{'path'} $out";

        if (system($cmd)){
                $self->log()->error("failed to modify map ($cmd) , $!");
                return;
        }

        return $out;

        #
        # we now return you to your regular programming which doesn't work...
        #

        # place the pinwin on the map

        my $map = GD::Image->newFromPng($map_data->{'path'}, $truecolour);
        $map->alphaBlending(0);
        $map->saveAlpha(1);

        # fix me!
        # why doesn't the alpha in $pw get preserved

        $map->copy($pw, $x, $y, 0, 0, 159, 146);

        #

        $self->log()->info("save as $out");
        my $f = FileHandle->new(">$out");

        binmode($fh);
        $f->print($map->png(0));
        $f->close();

        return $out;
}

sub ensure_geo_perms {
        my $self = shift;
        my $photo_id = shift;
        my $require = shift;

        if ($require eq "all"){
                return 1;
        }

        #

        my $key = "$photo_id-$require";

        if (exists($self->{'__cache'}->{'geo_perms'}->{$key})){
                return $self->{'__cache'}->{'geo_perms'}->{$key};
        }

        #

        $self->log()->info("ensure geo permissions : $require");

        my $perms = $self->api_call({'method' => 'flickr.photos.geo.getPerms', 'args' => {'photo_id' => $photo_id}});
        my $ok = 0;

        if ($require eq "public"){
                $ok = $perms->findvalue("/rsp/perms/\@ispublic");
        }

        elsif ($require eq "contact"){
                $ok = $perms->findvalue("/rsp/perms/\@iscontact");
        }

        elsif ($require eq "friend"){
                $ok = $perms->findvalue("/rsp/perms/\@isfriend");
        }

        elsif ($require eq "family"){
                $ok = $perms->findvalue("/rsp/perms/\@isfamily");
        }

        elsif ($require eq "friend or family"){

                if ($perms->findvalue("/rsp/perms/\@isfriend")){
                        $ok = 1;
                }

                else {
                        $ok = $perms->findvalue("/rsp/perms/\@isfamily");
                }
        }

        else { }

        $self->{'__cache'}->{'geo_perms'}->{$key} = $ok;
        return $ok;
}

sub DESTROY {
        my $self = shift;

        if (-f $self->{'__pinwin'}){
                $self->log()->info("removing temporary pinwin : " . $self->{'__pinwin'});
                # unlink($self->{'__pinwin'});
        }

        $self->SUPER::DESTROY();
}

=head1 VERSION

0.72

=head1 DATE

$Date: 2008/08/03 17:08:39 $

=head1 AUTHOR

Aaron Straup Cope  [e-mail]

=head1 NOTES

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

=head1 SEE ALSO

L

L

L

L

L

L

L

L

L

L

L

=head1 BUGS

Sure, why not.

Please report all bugs via L

=head1 LICENSE

Copyright (c) 2007-2008 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;