Annotation of foursquare/foursquare.pl, revision 1.2

1.1       nick        1: #!/usr/bin/perl -wT
                      2: 
                      3: =begin comment info
                      4: +------------------------------------------------------------------------------
                      5: |
                      6: | See end of script for comments and 'pod2man foursquare.pl | nroff -man' to
                      7: | view man page or pod2text foursquare.pl for plain text.
                      8: |
                      9: | The core submit to FourScore and some concepts such as randomzing some 
                     10: | items to avoid looking automated were taken from Mayank Lahiri's code 
                     11: | found on his web site here:
                     12: |      http://compbio.cs.uic.edu/~mayank/4sq.html
                     13: |
                     14: |   Nicholas DeClario <nick@demandred.dyndns.org>
                     15: |   August 2010
1.2     ! nick       16: |      $Id: foursquare.pl,v 1.1.1.1 2010-08-31 15:34:03 nick Exp $
1.1       nick       17: |
                     18: +------------------------------------------------------------------------------
                     19: =end comment
                     20: =cut
                     21: BEGIN {
                     22:         delete @ENV{ qw(IFS CDPATH ENV BASH_ENV PATH) };
                     23:         $ENV{'PATH'} = "/bin:/usr/bin";
                     24:        $|++;
                     25:       }
                     26: 
                     27: use strict;
                     28: use Getopt::Long;
                     29: use Pod::Usage;
                     30: use Data::Dumper;
                     31: use IO::Socket;
                     32: use MIME::Base64;
                     33: 
                     34: my %opts  = &fetchOptions( );
                     35: my $vb    = $opts{'verbose'} || 0;
                     36: my $dbf   = $opts{'db'} || &findDBLocation( ) || exit;
                     37: my $locs  = &readLocations( $dbf ) || exit;
                     38: my $email = "nick\@declario.com";
                     39: my $up    = "bmlja0BkZWNsYXJpby5jb206MzIxd2FmZmxlMQ==";
                     40: 
                     41: srand;
                     42: 
                     43: ##
                     44: ## Generate a new username/email and password
                     45: ## in base64 encoding and exit.
                     46: ##
                     47: if ( $opts{'genup'} )
                     48: {
                     49:        print "Base64 encoded username/pass: " . &genup( ) . "\n";
                     50:        exit( 0 );
                     51: }
                     52: 
                     53: ##
                     54: ## Confirm we were handed a valid location
                     55: ##
                     56: if ( ! defined $locs->{$opts{'location'}} ) 
                     57: {
                     58:        print STDERR "ERROR: Invalid Location: " . $opts{'location'} . "\n";
                     59:        exit( 1 );
                     60: }
                     61: 
1.2     ! nick       62: &displayStatus( ) if ( $vb );
1.1       nick       63: 
                     64: my $results = &postToFourSquare( );
                     65: print "Result: $results\n" if ( $opts{'verbose'} );
                     66: 
                     67: exit( 0 );
                     68: 
                     69: ###############################################################################
                     70: ##
                     71: ##  &postToFourSquare( );
                     72: ##
                     73: ###############################################################################
                     74: sub postToFourSquare
                     75: {
                     76:        my $result = 0;
                     77: 
                     78:        ##
                     79:        ## Put a delay of up to 10 minutes so we don't look like
                     80:        ## like an automated bot.
                     81:        ##
                     82:        print STDOUT "Sleeping...\n" if (   $opts{'verbose'} &&
                     83:                                        ! $opts{'nosleep'} );
                     84:        sleep( rand( ) * 400 ) if ( ! $opts{'nosleep'} );
                     85:        
                     86:        ##
                     87:        ## Set up our post to the FourSquare server
                     88:        ##
                     89:        my $sock = IO::Socket::INET->new( PeerAddr => 'api.foursquare.com', 
                     90:                                          PeerPort => 80, 
                     91:                                          Proto    => 'tcp', 
                     92:                                          Type     => SOCK_STREAM
                     93:                                        ) or die;
                     94: 
                     95:        my $str = "vid=" . $locs->{$opts{'location'}}{'vid'} . 
                     96:                  "&private=0&geolat=" . $locs->{$opts{'location'}}{'lat'} .
                     97:                  "&geolong=" . $locs->{$opts{'location'}}{'long'};
                     98: 
                     99:        print $sock "POST /v1/checkin HTTP/1.1\r\n"
                    100:             . "Host: api.foursquare.com\r\nUser-Agent: "
                    101:             . "Mozilla/5.0 (Linux; U; Android 2.2; en-us; Droid Build/FRG01B) "
                    102:            . "AppleWebKit/533.1 (KHTML, like Gecko)"
                    103:             . "Version/4.0 Mobile Safari/533.1\r\nContent-Type: "
                    104:             . "application/x-www-form-urlencoded\r\nAuthorization: Basic "
                    105:             . "$up\r\nContent-length: ", length( $str ) + 2, "\r\n\r\n$str\r\n";
                    106: 
                    107:        $result = <$sock>;
                    108:        
                    109:        chomp $result;
                    110: 
                    111:        return $result;
                    112: }
                    113: 
                    114: ###############################################################################
                    115: ## 
                    116: ## &readLOcations( $file );
                    117: ##
                    118: ##   Read in the locations database.  The format of the database is as 
                    119: ##  as follows: 
                    120: ##
                    121: ##     id, venue id, description, longitutde, latitude
                    122: ##
                    123: ##  The venue ID is required and found vie FourSquares website.  
                    124: ##
                    125: ##  Everything will be pushed in to an hash with 'id' as the key.
                    126: ##
                    127: ###############################################################################
                    128: sub readLocations 
                    129: {
                    130:        my $file    = shift || 0;
                    131:        my %loc     = ( );
                    132:        my @deletes = ( );
                    133: 
                    134:        if ( ! $file ) 
                    135:        {
                    136:                print STDERR "ERROR: Filename of location database missing!\n";
                    137:                return 0;
                    138:        }       
                    139: 
                    140:        open( DB, "<$file" ) or die( "ERROR: Failed to open $file: $!\n" );
                    141:                while( <DB> ) 
                    142:                {
                    143:                        chomp;
                    144: 
                    145:                        ##
                    146:                        ## Ignore Comments and invalid fields
                    147:                        ##
                    148:                        next if ( m/^#/ );      
                    149:                        next if ( ! m/(?:.*,){4}/ );
                    150: 
                    151:                        ##
                    152:                        ## Read in fields
                    153:                        ##
                    154:                        my ( $key, @fields ) = split( /,/, $_ );
                    155:                        $loc{$key}{'vid'}  = $fields[0] || 0;
                    156:                        $loc{$key}{'desc'} = $fields[1] || "N/A";
                    157:                        $loc{$key}{'long'} = $fields[2] || 0;
                    158:                        $loc{$key}{'lat'}  = $fields[3] || 0;
                    159: 
                    160:                        ##
                    161:                        ## We don't want to look like a bot, so we'll
                    162:                        ## fudge our long and lat a tick
                    163:                        ##
                    164:                        $loc{$key}{'lat'}  += rand() * 0.0001 - 0.00005;
                    165:                        $loc{$key}{'long'} += rand() * 0.0001 - 0.00005;
                    166:        
                    167:                        ##
                    168:                        ##  Search for missing fields
                    169:                        ##
                    170:                        foreach my $k ( keys %{ $loc{ $key } } )
                    171:                        {
                    172:                                if ( ! $loc{$key}{$k} )
                    173:                                {       
                    174:                                        print STDERR "WARNING: " . $key .
                    175:                                             " has an invalid field: $k\n" .
                    176:                                             "This location will be removed.\n";
                    177:                                        push @deletes, $key;
                    178:                                }
                    179:                        }
                    180:                }
                    181:        close( DB );
                    182: 
                    183:        map { delete $loc{$_}; } @deletes;
                    184: 
                    185:        print STDERR "ERROR: No valid locatons found in DB!\n"
                    186:                if ( ! %loc );
                    187: 
                    188:        return \%loc;
                    189: }
                    190: 
                    191: ###############################################################################
                    192: ##
                    193: ## my $database_file_path = &findDBLocation( );
                    194: ##
                    195: ##  If no file path for the GPS locations is given, try and figure out 
                    196: ##  where it could be.  
                    197: ##
                    198: ###############################################################################
                    199: sub findDBLocation 
                    200: {
                    201:        my @locations = qw| /etc /etc/foursquare /opt/foursquare . ~ |;
                    202:        my @filenames = qw| fs_locations fs_locations.txt fs_locations.db |;
                    203: 
                    204:        foreach my $loc ( @locations ) 
                    205:        {
                    206:                map { return $loc . "/" . $_ if ( -f $loc . "/" . $_ ) } 
                    207:                        @filenames;
                    208:        }
                    209: 
                    210:        print STDERR "ERROR: Failed to locate foursquare locations database.\n";
                    211: 
                    212:        return 0;
                    213: }
                    214: 
                    215: ###############################################################################
                    216: #
                    217: # &displayStatus( $verbose )
                    218: #
                    219: ###############################################################################
                    220: sub displayStatus
                    221: {
                    222:        my $verbose = shift || 0;
                    223: 
                    224:        print "Using database: $dbf\n";
                    225:                     
                    226:        map 
                    227:        { 
                    228:                print sprintf( "%-10s: %s\n", $_, 
                    229:                                $locs->{$opts{'location'}}{$_} );
                    230:        } keys %{ $locs->{$opts{'location'}} };
                    231: }
                    232: 
                    233: ###############################################################################
                    234: ##
                    235: ## &sendmail( %mail );
                    236: ##
                    237: ###############################################################################
                    238: sub sendmail
                    239: {
                    240:        my $mail = shift || return 0;
                    241: 
                    242: }
                    243: 
                    244: ###############################################################################
                    245: ###############################################################################
                    246: sub genup
                    247: {
                    248:        ##
                    249:        ## Prompt user for email/username and password
                    250:        ##
                    251:        print "Enter e-mail or username: ";
                    252:        my $u = <STDIN>;
                    253:        chomp $u;
                    254:        
                    255:        print "Enter password: ";
                    256:        ## 
                    257:        ## Turn echo off
                    258:        ##
                    259:        my $p = <STDIN>;
                    260:        chomp $p;
                    261:        
                    262:        ##
                    263:        ## Display the results
                    264:        ##
                    265:        return ${\encode_base64($u . ":" . $p)};
                    266: }
                    267: 
                    268: ###############################################################################
                    269: ##
                    270: ## &fetchOptions( );
                    271: ##
                    272: ##      Grab our command line arguments and toss them in to a hash
                    273: ##
                    274: ###############################################################################
                    275: sub fetchOptions {
                    276:         my %opts;
                    277: 
                    278:         &GetOptions(
                    279:                        "database=s"    => \$opts{'db'},
                    280:                        "email"         => \$opts{'email'},
                    281:                        "genup"         => \$opts{'genup'},
                    282:                         "help|?"        => \$opts{'help'},
                    283:                        "location=s"    => \$opts{'location'},
                    284:                         "man"           => \$opts{'man'},
                    285:                        "sleep"         => \$opts{'nosleep'},
                    286:                        "verbose"       => \$opts{'verbose'},
                    287:                    ) || &pod2usage( );
                    288:        &pod2usage( ) if ( ! defined $opts{'location'} &&
                    289:                            ! defined $opts{'genup'} );
                    290:         &pod2usage( ) if defined $opts{'help'};
                    291:         &pod2usage( { -verbose => 2, -input => \*DATA } ) if defined $opts{'man'};
                    292: 
                    293:         return %opts;
                    294: }
                    295: 
                    296: __END__
                    297: 
                    298: =head1 NAME
                    299: 
                    300: masterbuild.pl - blurb
                    301: 
                    302: =head1 SYNOPSIS
                    303: 
                    304: masterbuild.pl [options]
                    305: 
                    306:  Options:
                    307:         --help,?        Display the basic help menu
                    308:        --email,e       Enable sending results via e-mail
                    309:        --genup         Generate base64 encoded username password
                    310:        --location,l    Path to foursquare locations database
                    311:         --man,m         Display the detailed man page
                    312:        --sleep,s       Disable sleep delay
                    313:        --verbose,v     Increase verbosity
                    314: 
                    315: =head1 DESCRIPTION
                    316: 
                    317: =head1 HISTORY
                    318: 
                    319: =head1 AUTHOR
                    320: 
                    321: Nicholas DeClario <nick@declario.com>
                    322: 
                    323: =head1 BUGS
                    324: 
                    325: This is a work in progress.  Please report all bugs to the author.
                    326: 
                    327: =head1 SEE ALSO
                    328: 
                    329: =head1 COPYRIGHT
                    330: 
                    331: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>