foursquare.pm
package foursquare;
use strict;
use warnings;
use LWP::UserAgent;
use MIME::Base64;
our $VERSION = 0.1;
my $mozilla_osx_user_agent = 'Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10.6; en-US; rv:1.9.2.3) Gecko/20100401 Firefox/3.6.3';
my $iphone_user_agent = 'Mozilla/5.0 (iPhone; U; CPU like Mac OS X; en) AppleWebKit/420+ (KHTML, like Gecko) Version/3.0 Mobile/1C25 Safari/419.3';
my $four_square_host = 'api.foursquare.com';
my %PATHS;
$PATHS{'checkin'} = '/v1/checkin';
$PATHS{'friend-request'} = '/v1/friend/sendrequest';
$PATHS{'venue-details'} = '/v1/venue';
sub new() {
my $self = {};
my $class = shift @_;
$self->{USERNAME} = @_ ? shift @_ : undef;
$self->{PASSWORD} = @_ ? shift @_ : undef;
$self->{LWP} = new LWP::UserAgent();
$self->{LASTRESPONSE} = undef;
$self->{DELAY} = undef;
$self->{DEBUG} = 1;
# allow cookies and spoof the user-agent
$self->{LWP}->cookie_jar({});
$self->{LWP}->agent($iphone_user_agent);
bless($self, $class);
return $self;
} # constructor
sub authToken() {
my $self = shift;
return encode_base64($self->{USERNAME} . ":" . $self->{PASSWORD});
} # authToken property
sub username {
my $self = shift;
if (@_) { $self->{USERNAME} = shift }
return $self->{USERNAME};
} # username property
sub password {
my $self = shift;
if (@_) { $self->{PASSWORD} = shift }
return $self->{PASSWORD};
} # password property
sub lastResponse {
my $self = shift;
if (@_) { $self->{LASTRESPONSE} = shift }
return $self->{LASTRESPONSE};
} # lastResponse
sub delay {
my $self = shift;
if (@_) { $self->{DELAY} = shift; $self->log("Bulk delay set to " . $self->{DELAY} . "\n"); }
return $self->{DELAY};
} # delay
sub debug {
my $self = shift;
my $val = shift;
if (@_) { $self->{DEBUG} = $val ? 1 : 0; }
return $self->{DEBUG};
} # debug
sub checkIn {
my $self = shift;
my $location = shift;
my $url = 'http://' . $four_square_host . $PATHS{'checkin'};
my $response = $self->{LWP}->post($url, ['vid' => $location], 'Authorization' => "Basic " . $self->authToken);
$self->{LASTRESPONSE} = $response;
$self->log("Trying $location\n");
if ($response->is_success) {
if ($self->authValid($response->content) && $self->apiSuccess($response->content)) {
$self->log("Checked into $location\n");
return 1;
} else {
$self->log("Failed checkin for $location\n");
return 0;
}
} else {
$self->log("Failed checkin for $location\n");
return 0;
}
} # checkIn()
sub friendRequest {
my $self = shift;
my $userid = shift;
my $url = 'http://' . $four_square_host . $PATHS{'friend-request'};
my $response = $self->{LWP}->post($url, ['uid' => $userid], 'Authorization' => "Basic " . $self->authToken);
$self->{LASTRESPONSE} = $response;
if ($response->is_success) {
return ($self->authValid($response->content) && $self->apiSuccess($response->content));
} else {
return 0;
}
} # friendRequest()
sub bulkCheckin {
my $self = shift;
my @locations = @{shift @_};
my @retvals;
foreach my $loc_id (@locations) {
push @retvals, $self->checkIn($loc_id);
if ($self->{DELAY}) {
sleep $self->{DELAY} + rand($self->{DELAY} * 0.25);
}
}
return @retvals;
} # bulkCheckin()
sub authValid {
my $self = shift;
my $response = shift;
if ($response =~ m/<unauthorized>/gi) {
return 0;
} else {
return 1;
}
} # authValid()
sub apiSuccess {
my $self = shift;
my $response = shift;
if ($response =~ m/<error>/gi) {
return 0;
} else {
return 1;
}
} # apiSuccess
sub venueDetails {
my $self = shift;
my $venueid = shift;
my %details;
$details{'id'} = $venueid;
$details{'success'} = 0;
my $url = 'http://' . $four_square_host . $PATHS{'venue-details'};
my $response = $self->{LWP}->get("$url?vid=$venueid", 'Authorization' => "Basic " . $self->authToken);
$self->{LASTRESPONSE} = $response;
my @fields = ('id','name','address','city','state','zip','geolat','geolong','checkins');
if ($response->is_success) {
$details{'success'} = 1;
foreach my $node (@fields) {
$details{$node} = getNodeText($response->content, $node);
}
} else {
$self->log("Failed lookup: " . $response->status_line);
}
return %details;
} # venueDetails()
sub log {
my $self = shift;
my $msg = shift;
if ($self->{DEBUG}) {
print STDERR $msg;
}
} # log()
sub getNodeText {
my $content = shift;
my $node = shift;
if ($content =~ m/<$node>([^<]+)<\/$node>/gi) {
return $1;
} else {
return '';
}
} # getNodeText()
1;