Flickr-Upload-FireEagle
view release on metacpan or search on metacpan
lib/Flickr/Upload/FireEagle.pm view on Meta::CPAN
if (my $hier = $self->fetch_fireeagle_hierarchy()){
my $best = str2time($hier->findvalue("/rsp/user/location-hierarchy/location[\@best-guess='true']/located-at"));
# Make sure FireEagle doesn't already have
# a more recent update.
# To do, maybe : try to figure out which of the two
# locations is more precise....
# print "[GPS] BEST : $best\n";
# print "[GPS] date : $ph_date\n";
if ($ph_date > $best){
my ($lat, $lon) = $self->gps_exif_to_latlon($info);
my %update = ('lat' => $lat, 'lon' => $lon);
if ($self->{'__fireeagle'}->update_location(\%update)){
$fresh_loc = 1;
}
else {
warn "Failed to update location in FireEagle, chugging along anyway";
}
}
}
}
}
#
# Now ask FireEagle where we are and do some sanity checking on
# the date of the last update also trying to sync it up with any
# date information that comes out of the EXIF stored above in $ph_date
#
if (! exists($args{'tags'})){
$args{'tags'} = '';
}
my $hier = $self->fetch_fireeagle_hierarchy();
my $ctx = undef;
if ($hier){
$ctx = $self->get_fireeagle_context_node($hier, $ph_date, \%args);
if (! $ctx){
warn "Too much time has passed between your photo and FireEagle to feel comfortable saying";
}
# Do some final sanity checking if we know what our lat, lon is
elsif ($has_gps){
# please cache me...
my ($lat, $lon) = $self->gps_exif_to_latlon($info);
try {
my $res = $self->flickr_api_call('flickr.places.findByLatLon', {'lat' => $lat, 'lon' => $lon});
my $xml = XML::XPath->new('xml' => $res->decoded_content());
my $fe_placeid = $ctx->findvalue("place-id");
my $fl_placeid = $xml->findvalue("/rsp/places/place/\@place_id")->string_value();;
if ($fe_placeid ne $fl_placeid){
warn "Mismatch between Flickr and FireEagle place IDs ($fl_placeid, $fe_placeid) based on lat/lon, deferring to Flickr";
my $fe_id = $ctx->findvalue("id")->string_value();
$ctx = undef;
my $placetype = $xml->findvalue("/rsp/places/place/\@place_type");
my $woeid = $xml->findvalue("/rsp/places/place/\@woeid");
my @tags = (
"fireeagle:id=$fe_id",
"places:$placetype=$fl_placeid",
"woe:id=$woeid",
);
if (my $name = $self->fetch_places_name($fl_placeid)){
my $model = $self->{'__fireeagle_args'}->{'tagify'} || "flickr";
push @tags, $self->tagify(lc($name), $model);
}
$args{'tags'} .= ' ';
$args{'tags'} .= join(' ', @tags);
}
}
catch Error with {
# pass
};
}
}
#
# Okay - now add tags
#
if ($ctx){
$args{'tags'} .= ' ';
$args{'tags'} .= $self->generate_location_tags($hier, $ctx);
}
#
# If we don't have EXIF data and we have something useful from
# FireEagle try to use that to update the geo information for
# the photo
#
my %extra = ();
if ((! $has_gps) && ($ctx)){
my ($lat, $lon) = split(" ", $ctx->findvalue("georss:point"));
# FireEagle doesn't always return a centroid....grrr!
lib/Flickr/Upload/FireEagle.pm view on Meta::CPAN
if ($test <= $offset){
return 1;
}
return 0;
}
sub generate_location_tags {
my $self = shift;
my $hier = shift;
my $ctx = shift;
my $id = $ctx->findvalue("id");
my $ctx_level = $ctx->findvalue("level")->string_value();
my @tags = ("fireeagle:id=$id");
foreach my $node ($hier->findnodes("/rsp/user/location-hierarchy/location")){
my $placeid = $node->findvalue("place-id");
my $node_level = $node->findvalue("level")->string_value();
if ($node_level < $ctx_level){
next;
}
if ($node_level == 2){
if (my $name = $self->fetch_places_name($placeid)){
my $model = $self->{'__fireeagle_args'}->{'tagify'} || "flickr";
push @tags, $self->tagify(lc($name), $model);
}
next;
}
if ($node_level == 3){
my $woeid = $node->findvalue("woeid");
push @tags, "places:locality=$placeid";
push @tags, "woe:id=$woeid";
if (my $name = $self->fetch_places_name($placeid)){
my $model = $self->{'__fireeagle_args'}->{'tagify'} || "flickr";
push @tags, $self->tagify(lc($name), $model);
}
last;
}
}
return join(" ", @tags);
}
sub fetch_places_name {
my $self = shift;
my $placeid = shift;
try {
my $res = $self->flickr_api_call('flickr.places.resolvePlaceId', {'place_id' => $placeid});
my $xml = XML::XPath->new('xml' => $res->decoded_content());
return $xml->findvalue("/rsp/location/\@name");
}
catch Error with {
# pass
};
}
#
# All of the code to follow needs to be moved into
# Flickr::Upload::Localitify and merged with Flickr::Upload::Dopplr
#
sub gps_exif_to_latlon {
my $self = shift;
my $info = shift;
my $parts_lat = $info->{'GPSLatitude'};
my $parts_lon = $info->{'GPSLongitude'};
my $ref_lat = uc($info->{'GPSLatitudeRef'});
my $ref_lon = uc($info->{'GPSLongitudeRef'});
my $lat = dms2decimal($parts_lat->[0], $parts_lat->[2], ($parts_lat->[4] / 100));
my $lon = dms2decimal($parts_lon->[0], $parts_lon->[2], ($parts_lon->[4] / 100));
if ($ref_lat eq 'S'){
$lat = - $lat;
}
if ($ref_lon eq 'W'){
$lon = - $lon;
}
return ($lat, $lon);
}
sub please_to_upload_for_real_now(){
my $self = shift;
my $args = shift;
my $extra = shift;
my $id = 0;
try {
$id = $self->SUPER::upload(%$args);
}
catch Error with {
throw FlickrUploadException("Failed to upload photo to Flickr", shift);
};
if (! $id){
throw FlickrUploadException("Flickr::Upload did not return a photo ID");
}
#
# set lat/lon
#
lib/Flickr/Upload/FireEagle.pm view on Meta::CPAN
my $meth = shift;
my $args = shift;
my $res;
try {
$res = $self->execute_method($meth, $args);
}
catch Error with {
my $e = shift;
throw FlickrAPIException("API call $meth failed", 999, "Unknown API error");
};
if (! $res->{success}){
my $e = shift;
throw FlickrAPIException("API call $meth failed", $e, $res->{error_code}, $res->{error_message});
}
return $res;
}
#
# Please for someone to write Text::Tagify...
#
sub tagify {
my $self = shift;
my $tag = shift;
my $model = shift;
if (($model) && ($model eq "delicious")){
return $self->tagify_like_delicious($tag);
}
return $self->tagify_like_flickr($tag);
}
sub tagify_like_flickr {
my $self = shift;
my $tag = shift;
if ($tag =~ /\s/){
$tag = "\"$tag\"";
}
return $tag;
}
sub tagify_like_delicious {
my $self = shift;
my $tag = shift;
$tag =~ s/\s//g;
return lc($tag);
}
#
# Just so so so wrong...but necessary until Flickr::Upload
# is updated to call $res->decoded_content()
#
sub upload_request($$) {
my $self = shift;
die "$self is not a LWP::UserAgent" unless $self->isa('LWP::UserAgent');
my $req = shift;
die "expecting a HTTP::Request" unless $req->isa('HTTP::Request');
my $res = $self->request( $req );
my $tree = XML::Parser::Lite::Tree::instance()->parse($res->decoded_content());
return () unless defined $tree;
my $photoid = response_tag($tree, 'rsp', 'photoid');
my $ticketid = response_tag($tree, 'rsp', 'ticketid');
unless( defined $photoid or defined $ticketid ) {
print STDERR "upload failed:\n", $res->content(), "\n";
return undef;
}
return (defined $photoid) ? $photoid : $ticketid;
}
sub response_tag {
my $t = shift;
my $node = shift;
my $tag = shift;
return undef unless defined $t and exists $t->{'children'};
for my $n ( @{$t->{'children'}} ) {
next unless defined $n and exists $n->{'name'} and exists $n->{'children'};
next unless $n->{'name'} eq $node;
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;
}
=head1 VERSION
0.1
=head1 DATE
$Date: 2008/04/22 07:01:19 $
=head1 AUTHOR
Aaron Straup Cope <ascope@cpan.org>
=head1 NOTES
Aside from requiring your own Flickr API key, secret and authentication token
you will also need similar FireEagle (OAuth) credentials. Since Flickr::Upload::FireEagle
already requires that you install the excellent I<Net::FireEagle> you should just
use the command line I<fireeagle> client for authorizing yourself with FireEagle.
=head1 SEE ALSO
L<Net::FireEagle>
L<Flickr::Upload>
L<Flickr::Upload::Dopplr>
( run in 0.552 second using v1.01-cache-2.11-cpan-99c4e6809bf )