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;