-
Notifications
You must be signed in to change notification settings - Fork 0
/
flickr_upld.pl
executable file
·270 lines (216 loc) · 10.1 KB
/
flickr_upld.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
#!/usr/bin/perl
# Flickr upload preprocessor with simpler syntax. This script runs flickr_xload.pl via system
# command to do actual upload. Useful in combination w Emacs to speed-up photo(s) description.
#
# (c) T.Przechlewski 12/2007 ([email protected])
# One can distribute/modify the file under the terms of the GNU General Public License.
#
# cf. http://gnu.univ.gda.pl/~tomasz/prog/perl/scripts/flickr/scripts/
#
use Text::Iconv;
use Image::ExifTool;
use Geo::Coordinates::DecimalDegrees;
use Getopt::Long;
use bytes;
my $locs_base = "$ENV{HOME}/.flickr/knows/where.flk";
my $perl_site_dir = '/usr/local/lib/perl5/site_perl';
## http://www.flickr.com/services/api/flickr.photos.geo.setLocation.html
my $default_accuracy = 11; # my default accuracy
my $accuracy = 16 ; # flickr default if not changed
##
## my $verbose = 1;
my $USAGE = 'flupload [-title tytul] [-keys kw1,kw2...] [-geo loc ] [-lrot|rrot] [-sets sets] [-file filespec]
gdzie -title title = photo title
-kw kw1,kw2... = keywords
-geo location = location
-lrot | -rrot = rotation (left and right)
-sets sets = sets
-pool pools = groups
-file filespec = filespec ' .
"\n";
GetOptions(
"script=s" => \$Script, ## read descriptions from the file $Script
"descr=s" => \$description, ## description
"file=s" => \$file2proc,
"geo=s" => \$location,
"help|?" => \$showhelp,
"keys=s" => \$tags,
"lrot" => \$rotateleft,
"matched" => \$matchedtags,
"rrot" => \$rotateright,
"sets=s" => \$insets,
"pool=s" => \$inpools,
"title=s" => \$title,
);
if ( $showhelp ) { die $USAGE ; }
if ( ! $file2proc ) { $file2proc = "*.jpg" }; ##
my ($LAT, $LON, $ACC) = (0, 1, 2);
## latitude/longitude, ie. 54.43894/18.54995 (for Sopot, nearby my house)
my ($latitude, $longitude );
## include utility subroutines/authentication:
require 'flickr_utils.rc';
require 'login2flickr.rc';
$conv = Text::Iconv->new("iso-8859-2", "UTF-8");
$vnoc = Text::Iconv->new("UTF-8", "iso-8859-2");
## reading photo(s) descriptions from file:
if ($Script) {
print STDERR "** Fetched photo(s) descriptons from: $Script\n";
## Read from stdin:
open (SF, "<$Script") or die "** Problems reading $Script **";
#open SF, "<$Script" || die "** Problems reading $Script **"; ## wrong : open () || die ...
while (<SF>) {
my ($file2proc, $location, $tags, $insets, $inpools, $title, $rotateleft);
my ($rotateright, $description, $arguments );
chomp($_);
## Stop mark
if ($_ =~ /^#+[ \t]*STOP[ \t]*#+[ \t]*$/) { die "Stop!\n" }
# skip empty lines and the ones starting with `#':
if ( ($_ =~ /^[ \t]*$/) || ($_ =~ /^#/)) { next }
$_ =~ s/^([^ \t]+)[ \t]+\>\>[ \t]*//; $file2proc = $1 ;
my @photodscr = split /\@/, $_ ; # each field starts with @ sign
for $f (@photodscr ) {
if ($f =~ /^g/) { $location = field($f) } # @g g-location
if ($f =~ /^k/) { $tags = field($f) } # @k keywords
if ($f =~ /^lrot/) { $rotateleft = 90 } # @lrot
if ($f =~ /^rrot/) { $rotateright = 270 } # @rrot
if ($f =~ /^s/) { $insets = field($f) } # @s sets
if ($f =~ /^p/) { $inpools = field($f) } # @p pools
if ($f =~ /^t/) { $title = field($f) } # @t title
if ($f =~ /^d/) { $description = field($f) } # @d description
if ($f =~ /^c/) { $credentials = field($f) } # @d credentials (creator name)
if ($f =~ /^a/) { $arguments = field($f) } # @a arguments passed verbatim
}
my $rot = $rotateleft || $rotateright ; # giving both is a non-sense
process_file ($file2proc, $location, $tags, $insets, $inpools, $title, $rot,
$description, $arguments, $credentials );
#print "** $file2proc#$location=$tags=$insets=$inpools=$title=$rot\n";
print "** ==========================================================\n\n";
}
}
##
## reading photo(s) descriptions from the command line:
else {
# Geocorrdinates
if ($rotateleft) { $rot = $rotateleft }
elsif ( $rotateright) { $rot = $rotateright } ; # giving both is a non-sense
process_file ($file2proc, $location, $tags, $insets, $inpools, $title, $rot, $description, $arguments );
}
# /////////////
sub process_file {
my ( $file2proc, $location, $tags, $insets, $inpools, $title, $rot, $descr, $xargs, $creds ) = @_ ;
my ($ori_location, $geotagged, $auto_geotagged );
my $exifTool = new Image::ExifTool;
my $photo_info = $exifTool->ImageInfo($file2proc);
my $gcrds = $exifTool->GetValue('GPSLatitude'); # is already geotagged
if ( $location && $location !~ /^(#|=)/) {
$ori_location = $location; # $location encoded with iso-8859-2
$location = $conv->convert($location);
if ($verbose) { print STDERR "** Search [$location]\n"; }
my %gc = get_mylocation_base($locs_base);
# 0 + keys %gc returns # of locations
print STDERR "** Fetched ", 0 + keys %gc, " locations from: $locs_base\n";
for $loc (keys %gc ) {
if ($loc eq $location ) {
$geotagged = 1;
$latitude = $gc{$loc}[$LAT];
$longitude = $gc{$loc}[$LON];
if ( $gc{$loc}[$ACC] = -1) { $accuracy = $default_accuracy; }
else { $accuracy = $gc{$loc}[$ACC] }
last;
}
}
if ($geotagged > 0) {
print STDERR "** Photo location [$location: $latitude/$longitude/$accuracy]\n"; }
else { die "** Error: [$location] not found\n"; }
}
### GPS coordinates explicity given as #lat:lon
elsif ( $location && $location =~ /^#/ ) { $location =~ s/^#[ \t]*//; # remove leading hash
print STDERR "** Coordinates for [$file2proc] given explicitly... \n";
## $latitude:$longitude ie. 54.43894/18.54995 (for Sopot, nearby my house)
($latitude, $longitude) = split (/:/, $location);
#$accuracy ## assume max accuracy if coordinates explicity given
$location = ''; ## location is empty to avoid assigning geo:loc (see below)
$geotagged = 1;
}
### GPS coordinates explicity given as other file name after `='
elsif ( $location && $location =~ /^=/ ) { $location =~ s/^=[ \t]*//; # nazwa pliku
my $exifTool2 = new Image::ExifTool;
my $other_photo_info = $exifTool2->ImageInfo($location);
my $gcrds2 = $exifTool2->GetValue('GPSLatitude'); # is already geotagged
$location = ''; ## location is empty to avoid assigning geo:loc (see below)
if (defined($gcrds2)) {
$latitude = dms_str2dec ($exifTool2->GetValue('GPSLatitude') );
$longitude = dms_str2dec ($exifTool2->GetValue('GPSLongitude'));
$geotagged = 1;
$auto_geotagged = 0;
}
else { die " *** File $gcrds2 does not contains GEO coordinates!\n ***"; }
}
elsif ( defined($gcrds) ) {
print STDERR "** Photo [$file2proc] contains location coordinates...\n";
## conversion is needed:
## $decimal_degrees = dms2decimal($degrees, $minutes, $seconds);
$latitude = dms_str2dec ($exifTool->GetValue('GPSLatitude') );
$longitude = dms_str2dec ($exifTool->GetValue('GPSLongitude'));
$geotagged = 1;
$auto_geotagged = 1;
}
if ($geotagged == 0) { print STDERR "** No geocoordinates for [$file2proc]...\n";}
else { $geo_lon_str = sprintf "geo:lon=%.6f", $longitude;
$geo_lat_str = sprintf "geo:lat=%.6f", $latitude }
if ( $tags ) {
my @tags=(); @tags = split /,/, $tags;
for $t (@tags) { $t =~ s/^[ \t]+|[ \t]$//; $t=~ s/_/ /g; $t="\"$t\""; }
# add geo:tags, geotags are oneword
if ( $geotagged) { push @tags, ($geo_lon_str, $geo_lat_str);
if ($location) { push (@tags, "geo:loc=$ori_location") } }
$tags = $conv->convert("@tags");
if ($verbose) { print STDERR "** Photo tags: [$tags]\n"; }
} elsif ($geotagged > 0 ) {# No tags but valid location was passed
$tags = "$geo_lon_str " . "$geo_lat_str" ;
if ($location) { $tags .= " geo:loc=$ori_location" }
$tags = $conv->convert("$tags");
}
# If auto geotagged add appriopriate tags:
if ($verbose) { print "$file2proc :: gcrds: $gcrds $auto_geotagged\n"; }
if ( $title ) { print STDERR "** Photo title: $title\n"; }
my @args = ("perl", "$perl_site_dir/flickr_xload.pl");
if ($title) { push @args, ("--title", "$title") }
if ($descr) { push @args, ("--description", $conv->convert($descr)) }
if ($creds) { push @args, ("--credentials", $conv->convert($creds)) }
if ($xargs) { push ( @args, (split (/[ "]+/, $conv->($xargs))) ) }
if ($rot) { push @args, ("--rot", "$rot") }
if ($insets) { push @args, ("--set", "$insets") }
if ($inpools) { push @args, ("--pool", "$inpools") }
if ($tags) { push @args, ("--tag", "$tags") } ## no need for "'$tags'"
if ($geotagged) { push @args, ("--gt", "$latitude:$longitude:$location:$accuracy") }
## do not update GPSLatitude GPSLongitude, etc:
if ($auto_geotagged) {push @args, ("--preserve-geo") }
push @args, "$file2proc";
if ($verbose) { print STDERR ">> @args <<\n"; } ### print "@args\n";
#print STDERR "** Uploading Photo...\n";
system(@args) == 0 or die "** system command [ @args ] failed: $? **";
} ## process_file
sub dms_str2dec {# the argument is something like: 18 deg 32' 49.06
my $str = shift @_;
my $sign ;
## Poprawka na biegun/półkulę (N/E dodatnie; S/W ujemne)
##my ($d, $m, $s) = $str =~ m/([-+]?[0-9]+)[^0-9]+([0-9]+)[^0-9]+([0-9\.]+)/;
##41 deg 8' 49.93" N 8 deg 36' 56.27" W
my ($d, $m, $s, $sign) = $str =~ m/([-+]?[0-9]+)[^0-9]+([0-9]+)[^0-9]+([0-9\.]+)[^0-9EWSN,]+([EWSN])/;
if ($verbose) { print "dms: $str = $d, $m, $s\n"; }
if (defined($d)) {
if ($sign eq 'W' || $sign eq 'S') { $sign = -1 }
elsif ( $sign eq 'E' || $sign eq 'N' ) { $sign = 1 }
else { die "*** Wrong geocoordinate format: $d, $m, $s, $sign"; }
##return (dms2decimal($d, $m, $s));
return ( $sign * dms2decimal($d, $m, $s));
}
else { die "*** Strange coordinated [$str] cannot convert *** " }
}
sub field {# process field, field starts with single letter
my $f = shift @_;
$f =~ s/^[ \t]+|[ \t]+$//g; ## remove leading/trailing spaces
$f =~ s/^[^ \t]+[ \t]*//g; ## remove field descriptor + possible following spaces
return $f;
}