Net::Dopplr - interface with Dopplr.com's web service

Net-Dopplr documentation Contained in the Net-Dopplr distribution.

Index

Code Index:

NAME

Top

Net::Dopplr - interface with Dopplr.com's web service

SYNOPSIS

Top

    my $dopplr = Net::Dopplr->new($token);

    my $fellows = $dopplr->fellows('muttley');

    print "I share my trips with ".scalar(@{$fellows->{show_trips_to}})." people\n"; 
    print "I can see ".scalar(@{$fellows->{can_see_trips_of}})." people's trips\n";

GETTING A DEVELOPER TOKEN

Top

This is a bit involved because Dopplr is still in beta.

First visit this URL

    https://www.dopplr.com/api/AuthSubRequest?next=http%3A%2F%2Fwww.example.com%2Fdopplrapi&scope=http%3A%2F%2Fwww.dopplr.com%2F&session=1

(Or you can replace next with you own web app). That will give you a developer token.

You can then upgrade this to a permanent session token using the dopplr utility shipped with this module or code similar to this

    use strict;
    use Net::Google::AuthSub;

    my $token = shift;
    my $auth = Net::Google::AuthSub->new( url => 'https://www.dopplr.com/api');

    $auth->auth('null', $token);
    my $sess    = $auth->session_token() || die "Couldn't get token: $@";
    print "Session token = $sess\n";

and then later

    my $dopplr = Net::Dopplr->new($sess);

You can then use the session token from that point forward.

METHODS

Top

More information here

    http://dopplr.pbwiki.com/API+Resource+URLs

new <token>

Requires a developer token or a session token.

TRAVELLER METHODS

Top

fellows [traveller]

Get people traveller shares information with.

If traveller is not provided then defaults to the logged-in user.

traveller_info [traveller]

Get information about a traveller.

If traveller is not provided then defaults to the logged-in user.

trips_info [traveller]

Get info about the trips of a traveller.

If traveller is not provided then defaults to the logged-in user.

future_trips_info [traveller]

Returns a list of all trips entered by the selected user that have yet to finish.

If traveller is not provided then defaults to the logged-in user.

fellows_travellingtoday [traveller]

Get which of traveller's fellows are travelling today.

If traveller is not provided then defaults to the logged-in user.

tag <tag> [traveller].

Returns data about all trips with a specific tag.

For more information about tags see

    http://dopplr.pbwiki.com/Tags

If traveller is not provided then defaults to the logged-in user.

location_on_date <date> [traveller]

Returns the location of a traveller on a particular date.

Date should be in ISO date format e.g

    2007-04-01

If traveller is not provided then defaults to the logged-in user.

TRIP METHODS

Top

trip_info <trip id>

Get info about a specific trip.

trip_coincidences <trip id>

Get coincidences for a given trip.

add_trip_tags <trip id> <tag[s]>

Add tags to a trip.

add_trip_note <trip id> <note>

Add a note to a trip.

delete_trip <trip_id>

Delete a trip

CITY METHODS

Top

city_info <geoname id>

Get info about a City.

Use search to get the geoname id.

Alternatively pass in a woeid using

    $dopplr->city_info( woeid => $woeid );

add_trip <geoname id> <start> <finish>

Add a trip for the currently logged in user.

Use search to get the geoname id.

Alternatively pass in a woeid using

    $dopplr->add_trip( woeid => $woeid, $start, $finish );

Dates should be in ISO date format e.g

    2007-04-01

trips_to_city <geoname id>

Get all your fellow travellers trips to a given city.

SEARCH METHODS

Top

search <term>

Searches for travellers or cities.

city_search <term>

Searches for cities.

traveller_search <term>

Searches for travellers.

TIP METHODS

Top

tips <geoname_id>

Get tips for a city. The returned tips will be tips that can be seen by the currently authenticated user, so may include private tips that only this user can see, as well as public tips on the city.

Alternatively pass in a woeid using

    $dopplr->tips( woeid => $woeid );

add_tip <geoname_id> <title> <review> [opt[s]]

Add a tip for a city. The response is the tip you just added.

Opts is a hash where the keys can be 

    public 
    url
    address
    tags

Alternatively pass in a woeid using

    $dopplr->add_tip( woeid => $woeid, $title, $review, %opts );

See http://dopplr.pbwiki.com/method%3Aadd_tip for more details.

OTHER METHODS

Top

update_traveller <opt[s]>

Update a traveller's details.

Takes a hash with the new values. Possible keys are

    email
    forename
    surname
    password

GENERIC, FUTURE PROOF METHOD CALLING

Top

call <name> <opts> [post]

This is the future proofing method.

If there's any method I haven't implemented yet then you can simply provide the name of the method, the options as a hash ref and, optionally, whether it should be a POST request or not. So, for a theoretical new method called throw_penguin which throws a penguin at a traveller and is called as a POST

    $dopplr->call('throw_penguin', { traveller_id => $id }, 1);

and for get_penguins which finds how many penguins have been thrown at a traveller and is called as a GET

    use Data::Dumper;
    my $data = $dopplr->call('get_penguins', { traveller_id => $id });
    print Dumper($data);

AUTHOR

Top

Simon Wistow <simon@thegestalt.org>

COPYRIGHT

Top

Copyright 2008, Simon Wistow

Distributed under the same terms as Perl itself.

Net-Dopplr documentation Contained in the Net-Dopplr distribution. 
package Net::Dopplr;

use strict;
use Carp;
use Net::Google::AuthSub;
use JSON::Any;
use URI;
use LWP::UserAgent;
use HTTP::Request::Common;

our $VERSION = '0.7';
our $AUTOLOAD;


sub new {
    my $class = shift;
    my $token = shift;
    my %opts  = @_;
    my $url   = $opts{url} || 'https://www.dopplr.com/api';
    my $ua    = LWP::UserAgent->new;
    my $json  = JSON::Any->new;
    my $auth  = Net::Google::AuthSub->new(url => $url);
    $auth->auth('null', $token);

    return bless { _auth => $auth, _ua => $ua, _json => $json, _url => $url }, $class;
}

my %methods = (
    fellows                 => 'traveller', 
    traveller_info          => 'traveller',
    trips_info              => 'traveller',
    future_trips_info       => 'traveller',
    fellows_travellingtoday => 'traveller',
    tag                     => 'traveller',
    location_on_date        => 'traveller',
 
    trip_info               => 'trip',
    add_trip_tags           => 'trip',
    add_trip_note           => 'trip',
    delete_trip             => 'trip',
    trip_coincidences       => 'trip',

    city_info               => 'city',
    add_trip                => 'city',
    trips_to_city           => 'city',

    search                  => 'search',
    city_search             => 'search',
    traveller_search        => 'search',

    tips                    => 'tip',
);

my %key_names = (
    traveller => 'traveller',
    trip      => 'trip_id',
    city      => 'geoname_id',
    search    => 'q',
    tip       => 'geoname_id',
);


my %post = map { $_ => 1 } qw(add_trip_tags 
                              add_trip_note 
                              delete_trip
                              add_trip
                              update_traveller
                              add_tip);
sub AUTOLOAD {
    my $self = shift;

    ref($self) or die "$self is not an object";

    my $name = $AUTOLOAD;
    $name =~ s/.*://;   # strip fully-qualified portion

    my $type = $methods{$name};
    die "Method $name not found\n" unless $type;

    if ($type eq 'traveller') {
        $self->_traveller($name, @_);
    } else {
        my $key  = $key_names{$type};
        my $val  = shift @_;
        if ('woeid' eq $val) {
            $key = $val;
            $val = shift @_;
        }
        croak "You must pass a $key to this method" unless defined $val;
        my %opts = @_;
        $self->call($name, { $key => $val, %opts });
    }
}

sub _traveller {
    my $self = shift;
    my $name = shift;
    my $val  = shift;
    my %opts = (defined $val)? ( traveller => $val ) : ();
    $self->call($name, { %opts });     
}





sub tag {
    my $self      = shift;
    my $tag       = shift || croak "You must pass a tag to this method";
    my $traveller = shift;
    my %opts      = ( tag => $tag );
    $opts{traveller} = $traveller if defined $traveller;
    $self->call('tag', { %opts });
}


sub location_on_date {
    my $self      = shift;
    my $date      = shift || croak "You must pass a date to this method";
    my $traveller = shift;
    my %opts      = ( date => $date );
    $opts{traveller} = $traveller if defined $traveller;
    $self->call('location_on_date', { %opts });
}


sub add_trip_tags {
    my $self    = shift;
    my $trip_id = shift || croak "You must pass a trip id to this method";
    my $tags    = join(" ", @_); 
    croak "You must pass at least one tag" unless length $tags;
    my %opts    = ( trip_id => $trip_id, tags => $tags );
    $self->call('add_trip_tags', { %opts });
}


sub add_trip_note {
    my $self    = shift;
    my $trip_id = shift || croak "You must pass a trip id to this method";
    my $note    = shift || croak "You must pass a note body to this method";
    my %opts    = ( trip_id => $trip_id, body => $note );
    $self->call('add_trip_note', { %opts });
}


sub add_trip {
    my $self     = shift;
    my $use_woe  = 0;
    my $id       = shift || croak "You must pass a geoname id to this method";
    if ( 'woeid' eq $id ) { 
        $use_woe = 1;
        $id      = shift || croak "You must pass in a woe id to this method";
    } 
    my $start    = shift || croak "You must pass a start date to this method";
    my $finish   = shift || croak "You must pass a finish date to this method";
    my %opts     = ( start => $start, finish => $finish );
    $opts{($use_woe)? 'woeid' : 'geoname_id'} = $id; 
    $self->call('add_trip', { %opts }); 
}


sub add_tip {
    my $self     = shift;
    my $use_woe  = 0;
    my $id       = shift || croak "You must pass a geoname id to this method";
    if ( 'woeid' eq $id ) { 
        $use_woe = 1;
        $id      = shift || croak "You must pass in a woe id to this method";
    } 
    my $title   = shift || croak "You must pass a start date to this method";
    my $review  = shift || croak "You must pass a finish date to this method";
    my %opts    = ( @_, title => $title, review => $review );
    $opts{($use_woe)? 'woeid' : 'geoname_id'} = $id; 
    $self->call('add_tip', { %opts });
}


sub update_traveller {
    my $self = shift;
    my %opts = @_;
    $self->call('update_traveller', { %opts });
}


sub call {
    my $self = shift;
    my $name = shift;
    my $opts = shift;
    my $post = shift;
    my $type;
    if (defined $post) {
        $type =  ($post)? "POST" : "GET";
    } else {
        $type =  ($post{$name})? "POST" : "GET";
    }

    $opts->{format} = 'js';

    my $uri = URI->new($self->{_url});
    $uri->path($uri->path."/$name");
    my %params = $self->{_auth}->auth_params();
    my $req;
    if ("POST" eq $type) {
        $req = POST "$uri", [%$opts], %params;
    } else { 
        $uri->query_form(%$opts);
        $req = GET "$uri", %params;
    }
    
    my $res    = $self->{_ua}->request($req);
    die "Couldn't call $name : ".$res->status_line unless $res->is_success;

    return    $self->{_json}->decode($res->content);
}

sub DESTROY { }




1;