Return to foursquare.pl CVS log

Up to [Local Repository] / foursquare

Initial revision

#!/usr/bin/perl -wT

=begin comment info
+------------------------------------------------------------------------------
|
| See end of script for comments and 'pod2man foursquare.pl | nroff -man' to
| view man page or pod2text foursquare.pl for plain text.
|
| The core submit to FourScore and some concepts such as randomzing some 
| items to avoid looking automated were taken from Mayank Lahiri's code 
| found on his web site here:
| 	http://compbio.cs.uic.edu/~mayank/4sq.html
|
|   Nicholas DeClario <nick@demandred.dyndns.org>
|   August 2010
|	$Id: foursquare.pl,v 1.1 2010/08/31 15:34:03 nick Exp $
|
+------------------------------------------------------------------------------
=end comment
=cut
BEGIN {
        delete @ENV{ qw(IFS CDPATH ENV BASH_ENV PATH) };
        $ENV{'PATH'} = "/bin:/usr/bin";
	$|++;
      }

use strict;
use Getopt::Long;
use Pod::Usage;
use Data::Dumper;
use IO::Socket;
use MIME::Base64;

my %opts  = &fetchOptions( );
my $vb    = $opts{'verbose'} || 0;
my $dbf   = $opts{'db'} || &findDBLocation( ) || exit;
my $locs  = &readLocations( $dbf ) || exit;
my $email = "nick\@declario.com";
my $up    = "bmlja0BkZWNsYXJpby5jb206MzIxd2FmZmxlMQ==";

srand;

##
## Generate a new username/email and password
## in base64 encoding and exit.
##
if ( $opts{'genup'} )
{
	print "Base64 encoded username/pass: " . &genup( ) . "\n";
	exit( 0 );
}

##
## Confirm we were handed a valid location
##
if ( ! defined $locs->{$opts{'location'}} ) 
{
	print STDERR "ERROR: Invalid Location: " . $opts{'location'} . "\n";
	exit( 1 );
}

&displayStatus( $vb );

my $results = &postToFourSquare( );
print "Result: $results\n" if ( $opts{'verbose'} );

exit( 0 );

###############################################################################
##
##  &postToFourSquare( );
##
###############################################################################
sub postToFourSquare
{
	my $result = 0;

	##
	## Put a delay of up to 10 minutes so we don't look like
	## like an automated bot.
	##
	print STDOUT "Sleeping...\n" if (   $opts{'verbose'} &&
					! $opts{'nosleep'} );
	sleep( rand( ) * 400 ) if ( ! $opts{'nosleep'} );
	
	##
	## Set up our post to the FourSquare server
	##
	my $sock = IO::Socket::INET->new( PeerAddr => 'api.foursquare.com', 
					  PeerPort => 80, 
					  Proto    => 'tcp', 
					  Type	   => SOCK_STREAM
					) or die;

	my $str = "vid=" . $locs->{$opts{'location'}}{'vid'} . 
		  "&private=0&geolat=" . $locs->{$opts{'location'}}{'lat'} .
		  "&geolong=" . $locs->{$opts{'location'}}{'long'};

	print $sock "POST /v1/checkin HTTP/1.1\r\n"
            . "Host: api.foursquare.com\r\nUser-Agent: "
            . "Mozilla/5.0 (Linux; U; Android 2.2; en-us; Droid Build/FRG01B) "
	    . "AppleWebKit/533.1 (KHTML, like Gecko)"
            . "Version/4.0 Mobile Safari/533.1\r\nContent-Type: "
            . "application/x-www-form-urlencoded\r\nAuthorization: Basic "
            . "$up\r\nContent-length: ", length( $str ) + 2, "\r\n\r\n$str\r\n";

	$result = <$sock>;
	
	chomp $result;

	return $result;
}

###############################################################################
## 
## &readLOcations( $file );
##
##   Read in the locations database.  The format of the database is as 
##  as follows: 
##
##	id, venue id, description, longitutde, latitude
##
##  The venue ID is required and found vie FourSquares website.  
##
##  Everything will be pushed in to an hash with 'id' as the key.
##
###############################################################################
sub readLocations 
{
	my $file    = shift || 0;
	my %loc     = ( );
	my @deletes = ( );

	if ( ! $file ) 
	{
		print STDERR "ERROR: Filename of location database missing!\n";
		return 0;
	}	

	open( DB, "<$file" ) or die( "ERROR: Failed to open $file: $!\n" );
		while( <DB> ) 
		{
			chomp;

			##
			## Ignore Comments and invalid fields
			##
			next if ( m/^#/ );	
			next if ( ! m/(?:.*,){4}/ );

			##
			## Read in fields
			##
			my ( $key, @fields ) = split( /,/, $_ );
			$loc{$key}{'vid'}  = $fields[0] || 0;
			$loc{$key}{'desc'} = $fields[1] || "N/A";
			$loc{$key}{'long'} = $fields[2] || 0;
			$loc{$key}{'lat'}  = $fields[3] || 0;

			##
			## We don't want to look like a bot, so we'll
			## fudge our long and lat a tick
			##
			$loc{$key}{'lat'}  += rand() * 0.0001 - 0.00005;
			$loc{$key}{'long'} += rand() * 0.0001 - 0.00005;
	
			##
			##  Search for missing fields
			##
			foreach my $k ( keys %{ $loc{ $key } } )
			{
				if ( ! $loc{$key}{$k} )
				{	
					print STDERR "WARNING: " . $key .
					     " has an invalid field: $k\n" .
					     "This location will be removed.\n";
					push @deletes, $key;
				}
			}
		}
	close( DB );

	map { delete $loc{$_}; } @deletes;

	print STDERR "ERROR: No valid locatons found in DB!\n"
		if ( ! %loc );

	return \%loc;
}

###############################################################################
##
## my $database_file_path = &findDBLocation( );
##
##  If no file path for the GPS locations is given, try and figure out 
##  where it could be.  
##
###############################################################################
sub findDBLocation 
{
	my @locations = qw| /etc /etc/foursquare /opt/foursquare . ~ |;
	my @filenames = qw| fs_locations fs_locations.txt fs_locations.db |;

	foreach my $loc ( @locations ) 
	{
		map { return $loc . "/" . $_ if ( -f $loc . "/" . $_ ) } 
			@filenames;
	}

	print STDERR "ERROR: Failed to locate foursquare locations database.\n";

	return 0;
}

###############################################################################
#
# &displayStatus( $verbose )
#
###############################################################################
sub displayStatus
{
	my $verbose = shift || 0;

	print "Using database: $dbf\n";
	             
	map 
	{ 
		print sprintf( "%-10s: %s\n", $_, 
                               $locs->{$opts{'location'}}{$_} );
	} keys %{ $locs->{$opts{'location'}} };
}

###############################################################################
##
## &sendmail( %mail );
##
###############################################################################
sub sendmail
{
	my $mail = shift || return 0;

}

###############################################################################
###############################################################################
sub genup
{
	##
	## Prompt user for email/username and password
	##
	print "Enter e-mail or username: ";
	my $u = <STDIN>;
	chomp $u;
	
	print "Enter password: ";
	## 
	## Turn echo off
	##
	my $p = <STDIN>;
	chomp $p;
	
	##
	## Display the results
	##
	return ${\encode_base64($u . ":" . $p)};
}

###############################################################################
##
## &fetchOptions( );
##
##      Grab our command line arguments and toss them in to a hash
##
###############################################################################
sub fetchOptions {
        my %opts;

        &GetOptions(
			"database=s"	=> \$opts{'db'},
			"email"		=> \$opts{'email'},
			"genup"		=> \$opts{'genup'},
                        "help|?"        => \$opts{'help'},
			"location=s"	=> \$opts{'location'},
                        "man"           => \$opts{'man'},
			"sleep"		=> \$opts{'nosleep'},
			"verbose"	=> \$opts{'verbose'},
                   ) || &pod2usage( );
	&pod2usage( ) if ( ! defined $opts{'location'} &&
                           ! defined $opts{'genup'} );
        &pod2usage( ) if defined $opts{'help'};
        &pod2usage( { -verbose => 2, -input => \*DATA } ) if defined $opts{'man'};

        return %opts;
}

__END__

=head1 NAME

masterbuild.pl - blurb

=head1 SYNOPSIS

masterbuild.pl [options]

 Options:
        --help,?        Display the basic help menu
	--email,e	Enable sending results via e-mail
	--genup		Generate base64 encoded username password
	--location,l	Path to foursquare locations database
        --man,m         Display the detailed man page
	--sleep,s	Disable sleep delay
	--verbose,v	Increase verbosity

=head1 DESCRIPTION

=head1 HISTORY

=head1 AUTHOR

Nicholas DeClario <nick@declario.com>

=head1 BUGS

This is a work in progress.  Please report all bugs to the author.

=head1 SEE ALSO

=head1 COPYRIGHT

=cut