line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::Dopplr; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
1898
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
39
|
|
4
|
1
|
|
|
1
|
|
6
|
use Carp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
83
|
|
5
|
1
|
|
|
1
|
|
915
|
use Net::Google::AuthSub; |
|
1
|
|
|
|
|
77095
|
|
|
1
|
|
|
|
|
30
|
|
6
|
1
|
|
|
1
|
|
967
|
use JSON::Any; |
|
1
|
|
|
|
|
36519
|
|
|
1
|
|
|
|
|
9
|
|
7
|
1
|
|
|
1
|
|
6814
|
use URI; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
29
|
|
8
|
1
|
|
|
1
|
|
6
|
use LWP::UserAgent; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
27
|
|
9
|
1
|
|
|
1
|
|
7
|
use HTTP::Request::Common; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1644
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '0.7'; |
12
|
|
|
|
|
|
|
our $AUTOLOAD; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 NAME |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Net::Dopplr - interface with Dopplr.com's web service |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 SYNOPSIS |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
my $dopplr = Net::Dopplr->new($token); |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my $fellows = $dopplr->fellows('muttley'); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
print "I share my trips with ".scalar(@{$fellows->{show_trips_to}})." people\n"; |
25
|
|
|
|
|
|
|
print "I can see ".scalar(@{$fellows->{can_see_trips_of}})." people's trips\n"; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 GETTING A DEVELOPER TOKEN |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
This is a bit involved because Dopplr is still in beta. |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
First visit this URL |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
https://www.dopplr.com/api/AuthSubRequest?next=http%3A%2F%2Fwww.example.com%2Fdopplrapi&scope=http%3A%2F%2Fwww.dopplr.com%2F&session=1 |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
(Or you can replace next with you own web app). That will give you a developer token. |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
You can then upgrade this to a permanent session token using the C |
39
|
|
|
|
|
|
|
utility shipped with this module or code similar to this |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
use strict; |
42
|
|
|
|
|
|
|
use Net::Google::AuthSub; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
my $token = shift; |
45
|
|
|
|
|
|
|
my $auth = Net::Google::AuthSub->new( url => 'https://www.dopplr.com/api'); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
$auth->auth('null', $token); |
48
|
|
|
|
|
|
|
my $sess = $auth->session_token() || die "Couldn't get token: $@"; |
49
|
|
|
|
|
|
|
print "Session token = $sess\n"; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
and then later |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
my $dopplr = Net::Dopplr->new($sess); |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
You can then use the session token from that point forward. |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=head1 METHODS |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
More information here |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
http://dopplr.pbwiki.com/API+Resource+URLs |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=cut |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head2 new |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Requires a developer token or a session token. |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=cut |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub new { |
72
|
0
|
|
|
0
|
1
|
|
my $class = shift; |
73
|
0
|
|
|
|
|
|
my $token = shift; |
74
|
0
|
|
|
|
|
|
my %opts = @_; |
75
|
0
|
|
0
|
|
|
|
my $url = $opts{url} || 'https://www.dopplr.com/api'; |
76
|
0
|
|
|
|
|
|
my $ua = LWP::UserAgent->new; |
77
|
0
|
|
|
|
|
|
my $json = JSON::Any->new; |
78
|
0
|
|
|
|
|
|
my $auth = Net::Google::AuthSub->new(url => $url); |
79
|
0
|
|
|
|
|
|
$auth->auth('null', $token); |
80
|
|
|
|
|
|
|
|
81
|
0
|
|
|
|
|
|
return bless { _auth => $auth, _ua => $ua, _json => $json, _url => $url }, $class; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
my %methods = ( |
85
|
|
|
|
|
|
|
fellows => 'traveller', |
86
|
|
|
|
|
|
|
traveller_info => 'traveller', |
87
|
|
|
|
|
|
|
trips_info => 'traveller', |
88
|
|
|
|
|
|
|
future_trips_info => 'traveller', |
89
|
|
|
|
|
|
|
fellows_travellingtoday => 'traveller', |
90
|
|
|
|
|
|
|
tag => 'traveller', |
91
|
|
|
|
|
|
|
location_on_date => 'traveller', |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
trip_info => 'trip', |
94
|
|
|
|
|
|
|
add_trip_tags => 'trip', |
95
|
|
|
|
|
|
|
add_trip_note => 'trip', |
96
|
|
|
|
|
|
|
delete_trip => 'trip', |
97
|
|
|
|
|
|
|
trip_coincidences => 'trip', |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
city_info => 'city', |
100
|
|
|
|
|
|
|
add_trip => 'city', |
101
|
|
|
|
|
|
|
trips_to_city => 'city', |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
search => 'search', |
104
|
|
|
|
|
|
|
city_search => 'search', |
105
|
|
|
|
|
|
|
traveller_search => 'search', |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
tips => 'tip', |
108
|
|
|
|
|
|
|
); |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
my %key_names = ( |
111
|
|
|
|
|
|
|
traveller => 'traveller', |
112
|
|
|
|
|
|
|
trip => 'trip_id', |
113
|
|
|
|
|
|
|
city => 'geoname_id', |
114
|
|
|
|
|
|
|
search => 'q', |
115
|
|
|
|
|
|
|
tip => 'geoname_id', |
116
|
|
|
|
|
|
|
); |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
my %post = map { $_ => 1 } qw(add_trip_tags |
120
|
|
|
|
|
|
|
add_trip_note |
121
|
|
|
|
|
|
|
delete_trip |
122
|
|
|
|
|
|
|
add_trip |
123
|
|
|
|
|
|
|
update_traveller |
124
|
|
|
|
|
|
|
add_tip); |
125
|
|
|
|
|
|
|
sub AUTOLOAD { |
126
|
0
|
|
|
0
|
|
|
my $self = shift; |
127
|
|
|
|
|
|
|
|
128
|
0
|
0
|
|
|
|
|
ref($self) or die "$self is not an object"; |
129
|
|
|
|
|
|
|
|
130
|
0
|
|
|
|
|
|
my $name = $AUTOLOAD; |
131
|
0
|
|
|
|
|
|
$name =~ s/.*://; # strip fully-qualified portion |
132
|
|
|
|
|
|
|
|
133
|
0
|
|
|
|
|
|
my $type = $methods{$name}; |
134
|
0
|
0
|
|
|
|
|
die "Method $name not found\n" unless $type; |
135
|
|
|
|
|
|
|
|
136
|
0
|
0
|
|
|
|
|
if ($type eq 'traveller') { |
137
|
0
|
|
|
|
|
|
$self->_traveller($name, @_); |
138
|
|
|
|
|
|
|
} else { |
139
|
0
|
|
|
|
|
|
my $key = $key_names{$type}; |
140
|
0
|
|
|
|
|
|
my $val = shift @_; |
141
|
0
|
0
|
|
|
|
|
if ('woeid' eq $val) { |
142
|
0
|
|
|
|
|
|
$key = $val; |
143
|
0
|
|
|
|
|
|
$val = shift @_; |
144
|
|
|
|
|
|
|
} |
145
|
0
|
0
|
|
|
|
|
croak "You must pass a $key to this method" unless defined $val; |
146
|
0
|
|
|
|
|
|
my %opts = @_; |
147
|
0
|
|
|
|
|
|
$self->call($name, { $key => $val, %opts }); |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub _traveller { |
152
|
0
|
|
|
0
|
|
|
my $self = shift; |
153
|
0
|
|
|
|
|
|
my $name = shift; |
154
|
0
|
|
|
|
|
|
my $val = shift; |
155
|
0
|
0
|
|
|
|
|
my %opts = (defined $val)? ( traveller => $val ) : (); |
156
|
0
|
|
|
|
|
|
$self->call($name, { %opts }); |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=head1 TRAVELLER METHODS |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=cut |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=head2 fellows [traveller] |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
Get people C shares information with. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
If C is not provided then defaults to |
170
|
|
|
|
|
|
|
the logged-in user. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=cut |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=head2 traveller_info [traveller] |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
Get information about a traveller. |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
If C is not provided then defaults to |
179
|
|
|
|
|
|
|
the logged-in user. |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=cut |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head2 trips_info [traveller] |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
Get info about the trips of a traveller. |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
If C is not provided then defaults to |
188
|
|
|
|
|
|
|
the logged-in user. |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=cut |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=head2 future_trips_info [traveller] |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
Returns a list of all trips entered by the |
195
|
|
|
|
|
|
|
selected user that have yet to finish. |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
If C is not provided then defaults to |
198
|
|
|
|
|
|
|
the logged-in user. |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=head2 fellows_travellingtoday [traveller] |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
Get which of C's fellows are travelling today. |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
If C is not provided then defaults to |
205
|
|
|
|
|
|
|
the logged-in user. |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=cut |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=head2 |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=head2 tag [traveller]. |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
Returns data about all trips with a specific tag. |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
For more information about tags see |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
http://dopplr.pbwiki.com/Tags |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
If C is not provided then defaults to |
220
|
|
|
|
|
|
|
the logged-in user. |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=cut |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub tag { |
226
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
227
|
0
|
|
0
|
|
|
|
my $tag = shift || croak "You must pass a tag to this method"; |
228
|
0
|
|
|
|
|
|
my $traveller = shift; |
229
|
0
|
|
|
|
|
|
my %opts = ( tag => $tag ); |
230
|
0
|
0
|
|
|
|
|
$opts{traveller} = $traveller if defined $traveller; |
231
|
0
|
|
|
|
|
|
$self->call('tag', { %opts }); |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=head2 location_on_date [traveller] |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
Returns the location of a traveller on a particular date. |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
Date should be in ISO date format e.g |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
2007-04-01 |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
If C is not provided then defaults to |
243
|
|
|
|
|
|
|
the logged-in user. |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=cut |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
sub location_on_date { |
248
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
249
|
0
|
|
0
|
|
|
|
my $date = shift || croak "You must pass a date to this method"; |
250
|
0
|
|
|
|
|
|
my $traveller = shift; |
251
|
0
|
|
|
|
|
|
my %opts = ( date => $date ); |
252
|
0
|
0
|
|
|
|
|
$opts{traveller} = $traveller if defined $traveller; |
253
|
0
|
|
|
|
|
|
$self->call('location_on_date', { %opts }); |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=head1 TRIP METHODS |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=cut |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=head2 trip_info |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
Get info about a specific trip. |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=cut |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=head2 trip_coincidences |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
Get coincidences for a given trip. |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
=cut |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=head2 add_trip_tags |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
Add tags to a trip. |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=cut |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
sub add_trip_tags { |
280
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
281
|
0
|
|
0
|
|
|
|
my $trip_id = shift || croak "You must pass a trip id to this method"; |
282
|
0
|
|
|
|
|
|
my $tags = join(" ", @_); |
283
|
0
|
0
|
|
|
|
|
croak "You must pass at least one tag" unless length $tags; |
284
|
0
|
|
|
|
|
|
my %opts = ( trip_id => $trip_id, tags => $tags ); |
285
|
0
|
|
|
|
|
|
$self->call('add_trip_tags', { %opts }); |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=head2 add_trip_note |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
Add a note to a trip. |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=cut |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
sub add_trip_note { |
295
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
296
|
0
|
|
0
|
|
|
|
my $trip_id = shift || croak "You must pass a trip id to this method"; |
297
|
0
|
|
0
|
|
|
|
my $note = shift || croak "You must pass a note body to this method"; |
298
|
0
|
|
|
|
|
|
my %opts = ( trip_id => $trip_id, body => $note ); |
299
|
0
|
|
|
|
|
|
$self->call('add_trip_note', { %opts }); |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=head2 delete_trip |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
Delete a trip |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
=cut |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
=head1 CITY METHODS |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=cut |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
=head2 city_info |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
Get info about a City. |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
Use search to get the geoname id. |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
Alternatively pass in a woeid using |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
$dopplr->city_info( woeid => $woeid ); |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=cut |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
=head2 add_trip |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
Add a trip for the currently logged in user. |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
Use search to get the geoname id. |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
Alternatively pass in a woeid using |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
$dopplr->add_trip( woeid => $woeid, $start, $finish ); |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
Dates should be in ISO date format e.g |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
2007-04-01 |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
=cut |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
sub add_trip { |
342
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
343
|
0
|
|
|
|
|
|
my $use_woe = 0; |
344
|
0
|
|
0
|
|
|
|
my $id = shift || croak "You must pass a geoname id to this method"; |
345
|
0
|
0
|
|
|
|
|
if ( 'woeid' eq $id ) { |
346
|
0
|
|
|
|
|
|
$use_woe = 1; |
347
|
0
|
|
0
|
|
|
|
$id = shift || croak "You must pass in a woe id to this method"; |
348
|
|
|
|
|
|
|
} |
349
|
0
|
|
0
|
|
|
|
my $start = shift || croak "You must pass a start date to this method"; |
350
|
0
|
|
0
|
|
|
|
my $finish = shift || croak "You must pass a finish date to this method"; |
351
|
0
|
|
|
|
|
|
my %opts = ( start => $start, finish => $finish ); |
352
|
0
|
0
|
|
|
|
|
$opts{($use_woe)? 'woeid' : 'geoname_id'} = $id; |
353
|
0
|
|
|
|
|
|
$self->call('add_trip', { %opts }); |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
=head2 trips_to_city |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
Get all your fellow travellers trips to a given city. |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
=cut |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
=head1 SEARCH METHODS |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=head2 search |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
Searches for travellers or cities. |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
=cut |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=head2 city_search |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
Searches for cities. |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
=cut |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
=head2 traveller_search |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
Searches for travellers. |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
=cut |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
=head1 TIP METHODS |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
=head2 tips |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
Get tips for a city. The returned tips will be tips that can be |
388
|
|
|
|
|
|
|
seen by the currently authenticated user, so may include private |
389
|
|
|
|
|
|
|
tips that only this user can see, as well as public tips on the city. |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
Alternatively pass in a woeid using |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
$dopplr->tips( woeid => $woeid ); |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=cut |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
=head2 add_tip [opt[s]] |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
Add a tip for a city. The response is the tip you just added. |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
Opts is a hash where the keys can be |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
public |
404
|
|
|
|
|
|
|
url |
405
|
|
|
|
|
|
|
address |
406
|
|
|
|
|
|
|
tags |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
Alternatively pass in a woeid using |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
$dopplr->add_tip( woeid => $woeid, $title, $review, %opts ); |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
See http://dopplr.pbwiki.com/method%3Aadd_tip for more details. |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=cut |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
sub add_tip { |
417
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
418
|
0
|
|
|
|
|
|
my $use_woe = 0; |
419
|
0
|
|
0
|
|
|
|
my $id = shift || croak "You must pass a geoname id to this method"; |
420
|
0
|
0
|
|
|
|
|
if ( 'woeid' eq $id ) { |
421
|
0
|
|
|
|
|
|
$use_woe = 1; |
422
|
0
|
|
0
|
|
|
|
$id = shift || croak "You must pass in a woe id to this method"; |
423
|
|
|
|
|
|
|
} |
424
|
0
|
|
0
|
|
|
|
my $title = shift || croak "You must pass a start date to this method"; |
425
|
0
|
|
0
|
|
|
|
my $review = shift || croak "You must pass a finish date to this method"; |
426
|
0
|
|
|
|
|
|
my %opts = ( @_, title => $title, review => $review ); |
427
|
0
|
0
|
|
|
|
|
$opts{($use_woe)? 'woeid' : 'geoname_id'} = $id; |
428
|
0
|
|
|
|
|
|
$self->call('add_tip', { %opts }); |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=head1 OTHER METHODS |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
=head2 update_traveller |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
Update a traveller's details. |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
Takes a hash with the new values. Possible keys are |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
email |
440
|
|
|
|
|
|
|
forename |
441
|
|
|
|
|
|
|
surname |
442
|
|
|
|
|
|
|
password |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=cut |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
sub update_traveller { |
447
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
448
|
0
|
|
|
|
|
|
my %opts = @_; |
449
|
0
|
|
|
|
|
|
$self->call('update_traveller', { %opts }); |
450
|
|
|
|
|
|
|
} |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=head1 GENERIC, FUTURE PROOF METHOD CALLING |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
=head2 call [post] |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
This is the future proofing method. |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
If there's any method I haven't implemented yet then |
459
|
|
|
|
|
|
|
you can simply provide the name of the method, the |
460
|
|
|
|
|
|
|
options as a hash ref and, optionally, whether it |
461
|
|
|
|
|
|
|
should be a POST request or not. So, for a theoretical |
462
|
|
|
|
|
|
|
new method called C which throws a |
463
|
|
|
|
|
|
|
penguin at a traveller and is called as a POST |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
$dopplr->call('throw_penguin', { traveller_id => $id }, 1); |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
and for C which finds how many penguins have been |
468
|
|
|
|
|
|
|
thrown at a traveller and is called as a GET |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
use Data::Dumper; |
471
|
|
|
|
|
|
|
my $data = $dopplr->call('get_penguins', { traveller_id => $id }); |
472
|
|
|
|
|
|
|
print Dumper($data); |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
=cut |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
sub call { |
477
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
478
|
0
|
|
|
|
|
|
my $name = shift; |
479
|
0
|
|
|
|
|
|
my $opts = shift; |
480
|
0
|
|
|
|
|
|
my $post = shift; |
481
|
0
|
|
|
|
|
|
my $type; |
482
|
0
|
0
|
|
|
|
|
if (defined $post) { |
483
|
0
|
0
|
|
|
|
|
$type = ($post)? "POST" : "GET"; |
484
|
|
|
|
|
|
|
} else { |
485
|
0
|
0
|
|
|
|
|
$type = ($post{$name})? "POST" : "GET"; |
486
|
|
|
|
|
|
|
} |
487
|
|
|
|
|
|
|
|
488
|
0
|
|
|
|
|
|
$opts->{format} = 'js'; |
489
|
|
|
|
|
|
|
|
490
|
0
|
|
|
|
|
|
my $uri = URI->new($self->{_url}); |
491
|
0
|
|
|
|
|
|
$uri->path($uri->path."/$name"); |
492
|
0
|
|
|
|
|
|
my %params = $self->{_auth}->auth_params(); |
493
|
0
|
|
|
|
|
|
my $req; |
494
|
0
|
0
|
|
|
|
|
if ("POST" eq $type) { |
495
|
0
|
|
|
|
|
|
$req = POST "$uri", [%$opts], %params; |
496
|
|
|
|
|
|
|
} else { |
497
|
0
|
|
|
|
|
|
$uri->query_form(%$opts); |
498
|
0
|
|
|
|
|
|
$req = GET "$uri", %params; |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
|
501
|
0
|
|
|
|
|
|
my $res = $self->{_ua}->request($req); |
502
|
0
|
0
|
|
|
|
|
die "Couldn't call $name : ".$res->status_line unless $res->is_success; |
503
|
|
|
|
|
|
|
|
504
|
0
|
|
|
|
|
|
return $self->{_json}->decode($res->content); |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
0
|
|
|
0
|
|
|
sub DESTROY { } |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
=head1 AUTHOR |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
Simon Wistow |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
=head1 COPYRIGHT |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
Copyright 2008, Simon Wistow |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
Distributed under the same terms as Perl itself. |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
=cut |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
1; |