File Coverage

blib/lib/Net/Dopplr.pm
Criterion Covered Total %
statement 21 120 17.5
branch 0 36 0.0
condition 0 41 0.0
subroutine 7 19 36.8
pod 9 9 100.0
total 37 225 16.4


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 <review> [opt[s]] </td> </tr> <tr> <td class="h" > <a name="398">398</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="399">399</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Add a tip for a city. The response is the tip you just added. </td> </tr> <tr> <td class="h" > <a name="400">400</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="401">401</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Opts is a hash where the keys can be </td> </tr> <tr> <td class="h" > <a name="402">402</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="403">403</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> public </td> </tr> <tr> <td class="h" > <a name="404">404</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> url </td> </tr> <tr> <td class="h" > <a name="405">405</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> address </td> </tr> <tr> <td class="h" > <a name="406">406</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> tags </td> </tr> <tr> <td class="h" > <a name="407">407</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="408">408</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Alternatively pass in a woeid using </td> </tr> <tr> <td class="h" > <a name="409">409</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="410">410</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $dopplr->add_tip( woeid => $woeid, $title, $review, %opts ); </td> </tr> <tr> <td class="h" > <a name="411">411</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="412">412</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> See http://dopplr.pbwiki.com/method%3Aadd_tip for more details. </td> </tr> <tr> <td class="h" > <a name="413">413</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="414">414</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="415">415</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="416">416</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub add_tip { </td> </tr> <tr> <td class="h" > <a name="417">417</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-Net-Dopplr-pm--subroutine.html#417-1"> 0 </a> </td> <td class="c3" > <a href="blib-lib-Net-Dopplr-pm--subroutine.html#417-1"> 1 </a> </td> <td >   </td> <td class="s"> my $self = shift; </td> </tr> <tr> <td class="h" > <a name="418">418</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $use_woe = 0; </td> </tr> <tr> <td class="h" > <a name="419">419</a> </td> <td class="c0" > 0 </td> <td >   </td> <td class="c0" > <a href="blib-lib-Net-Dopplr-pm--condition.html#419-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $id = shift || croak "You must pass a geoname id to this method"; </td> </tr> <tr> <td class="h" > <a name="420">420</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Net-Dopplr-pm--branch.html#420-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ( 'woeid' eq $id ) { </td> </tr> <tr> <td class="h" > <a name="421">421</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $use_woe = 1; </td> </tr> <tr> <td class="h" > <a name="422">422</a> </td> <td class="c0" > 0 </td> <td >   </td> <td class="c0" > <a href="blib-lib-Net-Dopplr-pm--condition.html#422-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $id = shift || croak "You must pass in a woe id to this method"; </td> </tr> <tr> <td class="h" > <a name="423">423</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="424">424</a> </td> <td class="c0" > 0 </td> <td >   </td> <td class="c0" > <a href="blib-lib-Net-Dopplr-pm--condition.html#424-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $title = shift || croak "You must pass a start date to this method"; </td> </tr> <tr> <td class="h" > <a name="425">425</a> </td> <td class="c0" > 0 </td> <td >   </td> <td class="c0" > <a href="blib-lib-Net-Dopplr-pm--condition.html#425-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $review = shift || croak "You must pass a finish date to this method"; </td> </tr> <tr> <td class="h" > <a name="426">426</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my %opts = ( @_, title => $title, review => $review ); </td> </tr> <tr> <td class="h" > <a name="427">427</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Net-Dopplr-pm--branch.html#427-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $opts{($use_woe)? 'woeid' : 'geoname_id'} = $id; </td> </tr> <tr> <td class="h" > <a name="428">428</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->call('add_tip', { %opts }); </td> </tr> <tr> <td class="h" > <a name="429">429</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="430">430</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="431">431</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head1 OTHER METHODS </td> </tr> <tr> <td class="h" > <a name="432">432</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="433">433</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head2 update_traveller <opt[s]> </td> </tr> <tr> <td class="h" > <a name="434">434</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="435">435</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Update a traveller's details. </td> </tr> <tr> <td class="h" > <a name="436">436</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="437">437</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Takes a hash with the new values. Possible keys are </td> </tr> <tr> <td class="h" > <a name="438">438</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="439">439</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> email </td> </tr> <tr> <td class="h" > <a name="440">440</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> forename </td> </tr> <tr> <td class="h" > <a name="441">441</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> surname </td> </tr> <tr> <td class="h" > <a name="442">442</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> password </td> </tr> <tr> <td class="h" > <a name="443">443</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="444">444</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="445">445</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="446">446</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub update_traveller { </td> </tr> <tr> <td class="h" > <a name="447">447</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-Net-Dopplr-pm--subroutine.html#447-1"> 0 </a> </td> <td class="c3" > <a href="blib-lib-Net-Dopplr-pm--subroutine.html#447-1"> 1 </a> </td> <td >   </td> <td class="s"> my $self = shift; </td> </tr> <tr> <td class="h" > <a name="448">448</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my %opts = @_; </td> </tr> <tr> <td class="h" > <a name="449">449</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->call('update_traveller', { %opts }); </td> </tr> <tr> <td class="h" > <a name="450">450</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="451">451</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="452">452</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head1 GENERIC, FUTURE PROOF METHOD CALLING </td> </tr> <tr> <td class="h" > <a name="453">453</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="454">454</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head2 call <name> <opts> [post] </td> </tr> <tr> <td class="h" > <a name="455">455</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="456">456</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> This is the future proofing method. </td> </tr> <tr> <td class="h" > <a name="457">457</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="458">458</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> If there's any method I haven't implemented yet then </td> </tr> <tr> <td class="h" > <a name="459">459</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> you can simply provide the name of the method, the </td> </tr> <tr> <td class="h" > <a name="460">460</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> options as a hash ref and, optionally, whether it </td> </tr> <tr> <td class="h" > <a name="461">461</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> should be a POST request or not. So, for a theoretical </td> </tr> <tr> <td class="h" > <a name="462">462</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> new method called C<throw_penguin> which throws a </td> </tr> <tr> <td class="h" > <a name="463">463</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> penguin at a traveller and is called as a POST </td> </tr> <tr> <td class="h" > <a name="464">464</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="465">465</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $dopplr->call('throw_penguin', { traveller_id => $id }, 1); </td> </tr> <tr> <td class="h" > <a name="466">466</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="467">467</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> and for C<get_penguins> which finds how many penguins have been </td> </tr> <tr> <td class="h" > <a name="468">468</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> thrown at a traveller and is called as a GET </td> </tr> <tr> <td class="h" > <a name="469">469</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="470">470</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> use Data::Dumper; </td> </tr> <tr> <td class="h" > <a name="471">471</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $data = $dopplr->call('get_penguins', { traveller_id => $id }); </td> </tr> <tr> <td class="h" > <a name="472">472</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> print Dumper($data); </td> </tr> <tr> <td class="h" > <a name="473">473</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="474">474</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="475">475</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="476">476</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> sub call { </td> </tr> <tr> <td class="h" > <a name="477">477</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-Net-Dopplr-pm--subroutine.html#477-1"> 0 </a> </td> <td class="c3" > <a href="blib-lib-Net-Dopplr-pm--subroutine.html#477-1"> 1 </a> </td> <td >   </td> <td class="s"> my $self = shift; </td> </tr> <tr> <td class="h" > <a name="478">478</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $name = shift; </td> </tr> <tr> <td class="h" > <a name="479">479</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $opts = shift; </td> </tr> <tr> <td class="h" > <a name="480">480</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $post = shift; </td> </tr> <tr> <td class="h" > <a name="481">481</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $type; </td> </tr> <tr> <td class="h" > <a name="482">482</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Net-Dopplr-pm--branch.html#482-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if (defined $post) { </td> </tr> <tr> <td class="h" > <a name="483">483</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Net-Dopplr-pm--branch.html#483-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $type = ($post)? "POST" : "GET"; </td> </tr> <tr> <td class="h" > <a name="484">484</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="485">485</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Net-Dopplr-pm--branch.html#485-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $type = ($post{$name})? "POST" : "GET"; </td> </tr> <tr> <td class="h" > <a name="486">486</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="487">487</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="488">488</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $opts->{format} = 'js'; </td> </tr> <tr> <td class="h" > <a name="489">489</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="490">490</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $uri = URI->new($self->{_url}); </td> </tr> <tr> <td class="h" > <a name="491">491</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $uri->path($uri->path."/$name"); </td> </tr> <tr> <td class="h" > <a name="492">492</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my %params = $self->{_auth}->auth_params(); </td> </tr> <tr> <td class="h" > <a name="493">493</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $req; </td> </tr> <tr> <td class="h" > <a name="494">494</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Net-Dopplr-pm--branch.html#494-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ("POST" eq $type) { </td> </tr> <tr> <td class="h" > <a name="495">495</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $req = POST "$uri", [%$opts], %params; </td> </tr> <tr> <td class="h" > <a name="496">496</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } else { </td> </tr> <tr> <td class="h" > <a name="497">497</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $uri->query_form(%$opts); </td> </tr> <tr> <td class="h" > <a name="498">498</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $req = GET "$uri", %params; </td> </tr> <tr> <td class="h" > <a name="499">499</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="500">500</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="501">501</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my $res = $self->{_ua}->request($req); </td> </tr> <tr> <td class="h" > <a name="502">502</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Net-Dopplr-pm--branch.html#502-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> die "Couldn't call $name : ".$res->status_line unless $res->is_success; </td> </tr> <tr> <td class="h" > <a name="503">503</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="504">504</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> return $self->{_json}->decode($res->content); </td> </tr> <tr> <td class="h" > <a name="505">505</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="506">506</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="507">507</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td class="c0" > <a href="blib-lib-Net-Dopplr-pm--subroutine.html#507-1"> 0 </a> </td> <td >   </td> <td >   </td> <td class="s"> sub DESTROY { } </td> </tr> <tr> <td class="h" > <a name="508">508</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="509">509</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="510">510</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="511">511</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head1 AUTHOR </td> </tr> <tr> <td class="h" > <a name="512">512</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="513">513</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Simon Wistow <simon@thegestalt.org> </td> </tr> <tr> <td class="h" > <a name="514">514</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="515">515</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =head1 COPYRIGHT </td> </tr> <tr> <td class="h" > <a name="516">516</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="517">517</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Copyright 2008, Simon Wistow </td> </tr> <tr> <td class="h" > <a name="518">518</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="519">519</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> Distributed under the same terms as Perl itself. </td> </tr> <tr> <td class="h" > <a name="520">520</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="521">521</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> =cut </td> </tr> <tr> <td class="h" > <a name="522">522</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="523">523</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> 1; </td> </tr> </table> </body> </html>