1#!/usr/bin/perl 2# Copyright (C) 2008 by Tim Nugent 3# timnugent@gmail.com 4# 5# This file is part of hugin. 6# 7# Hugin is free software: you can redistribute it and/or modify 8# it under the terms of the GNU General Public License as published by 9# the Free Software Foundation, either version 2 of the License, or 10# (at your option) any later version. 11# 12# Hugin is distributed in the hope that it will be useful, 13# but WITHOUT ANY WARRANTY; without even the implied warranty of 14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15# GNU General Public License for more details. 16# 17# You should have received a copy of the GNU General Public License 18# along with Hugin If not, see <http://www.gnu.org/licenses/>. 19 20# Script to retrieve images of clouds from flickR using by searching tags 21 22use strict; 23use warnings; 24use Flickr::API; 25use Data::Dumper; 26use File::stat; 27use Digest::MD5 qw(md5 md5_hex md5_base64); 28 29my $max_page = 500; 30my $max_photos = 1500; 31## Tags, comma separated 32my $tags = "clouds"; 33## Let's not hammer the flickR server too much.. they might get cross 34my $sleep_time = 2; 35## These need to be filled in: 36my $api_key = "f14cb20df0665e42649e4ddc3e69c1ff"; 37my $secret = "e83949de627c0fdc"; 38## Then get the auth token and fill it in too: 39my $auth_token = ""; 40## These can stay blank: 41my $frob = ""; 42my $nsid = ""; 43## Directories 44my $pos_local_dir = "/home/tnugent/gsoc/flickr_clouds/positive_set"; 45my $neg_local_dir = "/home/tnugent/gsoc/flickr_clouds/negative_set"; 46my %size = ('Square' => '_s', 'Thumbnail' => '_t', 'Small' => '_m', 'Medium' => '', 'Large' => '_b'); 47 48my $api = new Flickr::API({'key' => $api_key, 49 'secret' => $secret}); 50 51&get_token() unless $auth_token; 52 53for my $page (1 .. $max_page){ 54 55 print "Retrieving search page $page ...\t"; 56 57 my $response = $api->execute_method("flickr.photos.search",{'api_key' => $api_key, 58 'auth_token' => $auth_token, 59 'frob' => $frob, 60 'tags' => $tags}, 61 'per_page'=> 500, 62 'page' => $page); 63 64 print "Done.\n"; 65 #print Dumper $response; 66 &download_response($response,$pos_local_dir); 67} 68exit; 69 70sub get_token{ 71 72 my $response = $api->execute_method("flickr.auth.getFrob"); 73 74 if( ! $response->{success} ) { 75 print Dumper $response; 76 die "Unable to get frob.\n"; 77 }else{ 78 $frob = $response->{tree}->{children}->[1]->{children}->[0]->{content}; 79 } 80 81 my $url = $api->request_auth_url('write', $frob); 82 system("konqueror \"$url\""); 83 84 85 $response = $api->execute_method("flickr.auth.getToken",{'api_key' => $api_key, 86 'frob' => $frob, 87 'method' => "flickr.auth.getToken"}); 88 if( ! $response->{success} ) { 89 print Dumper $response; 90 die "Unable to get token.\n"; 91 }else{ 92 $auth_token = $response->{tree}->{children}->[1]->{children}->[1]->{children}->[0]->{content}; 93 $nsid = $response->{tree}->{children}->[1]->{children}->[5]->{attributes}->{nsid}; 94 } 95 96 print "api_key:\t$api_key\n"; 97 print "secret:\t\t$secret\n"; 98 print "frob:\t\t$frob\n"; 99 print "auth_token:\t$auth_token\n"; 100 print "nsid:\t\t$nsid\n"; 101 102} 103 104sub download_response { 105 106 my ($response,$dir) = @_; 107 my $total_photos_processed = 0; 108 my $photos = $response->{tree}->{children}[1]->{children}; 109 110 for( my $i = 0; $i < $#$photos; $i++ ) { 111 112 $total_photos_processed = 0; 113 opendir(DIR, $dir) or die "can't opendir $dir $!"; 114 while (defined(my $file = readdir(DIR))) { 115 if ($file =~ /prediction/){ 116 $total_photos_processed++; 117 } 118 } 119 close DIR; 120 121 if( $total_photos_processed < $max_photos ) { 122 123 if( $photos->[$i]->{attributes} ) { 124 125 #my $ph_title = $photos->[$i]->{'attributes'}->{'title'}; 126 my $server_id = $photos->[$i]->{'attributes'}->{'server'}; 127 my $photo_id = $photos->[$i]->{'attributes'}->{'id'}; 128 my $photo_secret = $photos->[$i]->{'attributes'}->{'secret'}; 129 my $photo_farm = $photos->[$i]->{'attributes'}->{'farm'}; 130 my $fformat = "jpg"; 131 132 ## Get available sizes - we want the largest (but not the original) 133 my @sizes = (); 134 my $get_size = $api->execute_method("flickr.photos.getSizes",{'api_key' => $api_key, 135 'photo_id' => $photo_id}); 136 137 if( ! $get_size->{success} ) { 138 #print Dumper $get_size; 139 print "Unable to get photo $photo_id sizes.\n"; 140 }else{ 141 foreach (my $i = 1; $i < scalar @{$get_size->{tree}->{children}->[1]->{children}}; $i += 2){ 142 my $available = $get_size->{tree}->{children}->[1]->{children}->[$i]->{'attributes'}->{'label'}; 143 push @sizes,$available unless $available eq 'Original'; 144 } 145 } 146 next unless scalar @sizes; 147 #print Dumper $get_size; 148 #print "@sizes"."\n"; 149 150 my $pic_url = "http://farm".$photo_farm.".static.flickr.com/".$server_id."/".$photo_id."_".$photo_secret.$size{$sizes[-1]}.".".$fformat; 151 my $fpath = $dir."/".$photo_id."_".$photo_secret.".".${fformat}; 152 153 #Check if picture exists 154 if( ! -e $fpath ){ 155 156 # Download picture 157 #http://farm{farm-id}.static.flickr.com/{server-id}/{id}_{secret}_[mstb].jpg 158 159 print "$pic_url\n"; 160 system("wget -q -O \"$fpath\" $pic_url"); 161 162 if (-e $fpath){ 163 if (stat($fpath)->size < 3000){ 164 print $sizes[-1]." not actually available. Deleting and trying $sizes[-2] ...\n"; 165 166 #my $arguments = 'api_key'.$api_key.'method'.'flickr.photos.getPerms'.'permsread'.'photo_id'.$photo_id; 167 #my $api_sig = &create_sign($arguments); 168 #my $get_perms = $api->execute_method("flickr.photos.getPerms",{'api_key' => $api_key, 169 # 'photo_id' => $photo_id, 170 # 'api_sig' => $api_sig, 171 # 'perms' => 'read'}); 172 #print Dumper $get_perms; 173 #exit; 174 175 system("rm -f \"$fpath\""); 176 $pic_url = "http://farm".$photo_farm.".static.flickr.com/".$server_id."/".$photo_id."_".$photo_secret.$size{$sizes[-2]}.".".$fformat; 177 $fpath = $dir."/".$photo_id."_".$photo_secret.".".${fformat}; 178 print "$pic_url\n"; 179 system("wget -q -O \"$fpath\" $pic_url"); 180 181 182 if (-e $fpath){ 183 if (stat($fpath)->size < 3000){ 184 print $sizes[-2]." not actually available. Deleting and giving up.\n"; 185 system("rm -f \"$fpath\""); 186 187 } 188 } 189 } 190 } 191 sleep $sleep_time; 192 } 193 } 194 } 195 196 } 197 198} 199 200sub create_sign{ 201 202 my $arguments = shift; 203 print "$arguments\n"; 204 my $signed = $secret.$arguments; 205 my $md5 = md5_hex($signed); 206 return $md5; 207 208} 209