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