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//gi) { return 0; } else { return 1; } } # authValid() sub apiSuccess { my $self = shift; my $response = shift; if ($response =~ m//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: " . STDERR $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;