#!/usr/bin/perl
###############################################################################
# Getting Laid in Perl
# by Thothicus
#
# Abstract: using perl to get laid
# History: 
# Version 0.5: I don't really consider this to be a complete work yet and 
# to be honest, until I get laid from this code I prolly won't promote it to
# 1.0. :)
# #############################################################################
# So here's the premise, I was bored ($bored++) and decided to cruise around 
# on the local electronic s/meat/meet/; market called Matchmaker.com
# Now what I wanted to do was ease my pleading for sex among the 400 or so 
# live females that inhabited this site.  This is not an easy thing, one can
# only copy paste so many times before wondering, wtf did I learn code for if
# I can't apply it to everyday life.  
# 
# I decided to automate a um... greeting to all the ladies on the board.
# This script grew from there, I added some different twists (mainly to cover
# my own ass and will continue to expirament with this script as it is quite amusing.
# 
# Just as an updatae a few women have actually expressed intrest in my solications
# which is actually quite amazing when you see who damn blunt I am about this 
# whole thing.
###############################################################################

# LIBRARY INITIALIZATION
#
# This is the only set of libraries i use, it's perl's web proccessing
# libraries which contains an assload of sub libraries.  For the record i'm
# on a pIII 500 laptop running win2k and ActiveState ActivePerl (5.6 i think)

use LWP;

# VARIABLE INITIALIZATION
#
# This isn't really needed by perl but I'm trying to get to the point where I 
# can use 'use strict' which means being a way better programmer :)
@profileNames = ();
%seen = ();

# obviously you will need to fill in your own account here, should work for
# any account though and really should be fine on all platforms.
# NOTE: if it's not I probobly won't have time to help you fix it, lot of shit
# to do these days (aside from this distraction).. I would suggest masterbation
$userName = '31337guy';
$passWord = 'hax0r.yer.panties.off';

# General Banner message I include with this series of scripts 
print "MatchMaker Fun using libwww-perl-$LWP::VERSION\n";

# Basically we are faking a browser here, later when I start analyzing the HTML
# they are sending back (ie reading table structures) this will be more relevant
# however for now it's just for fun.  You can put whatever in the Agent field
  $ua = LWP::UserAgent->new;
  $ua->agent("Mozilla/8.0");

###############################################################################
# Main Page access 
###############################################################################

# I generally do this just as a test to make sure everything is running fine
# eventually i want to include an indentity generation program here incase
# the current one expires or what not
  $reqMainPage = HTTP::Request->new(GET => 'http://austin.matchmaker.com/whats-hot');
  $reqMainPage->authorization_basic($userName, $passWord);
  $reqMainPage->header('Accept' => 'text/html');
# send request
  $res = $ua->request($reqMainPage);
# check the outcome
  if ($res->is_success) {
     print "Access To MM Granted!\n";
  } else {
     print "Init Level Error: " . $res->status_line . "\n";
  }

###############################################################################
# Retrieve all matches   
###############################################################################

# Not real sure this is neccessary anymore, I was incrementally moving through
# the site at first and used this to play with the form submission
  $reqBeginMatch = HTTP::Request->new(GET => 'http://austin.matchmaker.com/match');
  $reqBeginMatch->authorization_basic($userName, $passWord);
  $reqBeginMatch->header('Accept' => 'text/html');
# send request
  $resMatches = $ua->request($reqBeginMatch);
# check the outcome
  if ($resMatches->is_success) 
  {print "Reached Matches Submission page\n";} 
  else 
  {print "Match Level Error: " . $resMatches->status_line . "\n";}

###############################################################################
# Finding matches  
###############################################################################

# Max results is 300 and the most per page is like 35 or so.  I got lazy here
# and just made the logic go 9 times (300/35 = almost 9)
  print "Retrieving matched pages [.";

  foreach $pageCount (1..9)
  {
  	my $reqGetProfiles = HTTP::Request->new(POST => 'http://austin.matchmaker.com/match');
  	$reqGetProfiles->content_type('application/x-www-form-urlencoded');
  	$reqGetProfiles->authorization_basic('LADIDADAHE895', 'aliens');
	my $postParameters = 'page=' . $pageCount . '&key=P&sequence=D&system=&max-miles=0&zipcode=78731&filter=R&show-only=F&min-age=C&max-age=G&first-call=0&last-call=0&at-most=300';
	$reqGetProfiles->content("$postParameters");
	my $resGetProfiles = $ua->request($reqGetProfiles);

	if ($resGetProfiles->is_success) 
	{print ".";} 
       	else 
       	{$errorCount++;}
  
  	my @tmpMatches = split(/>/,$resGetProfiles->as_string);
  	foreach $bit (@tmpMatches) {push(@matches,$bit);}
  }

  print "]\n";
  if ($errorCount>=1) {print "There were some errors retrieving pages, $errorCount to be exact.\n";}
  
  print "Profile parsing sequence initiated\n";
 

# Pulling out all the profile names  
# All the lines we need here contain the link /browse?userName so we are using some regEx voodoo
# btw, this is fairly unreadable till you expand it out, i just think it looks better this way :)
  foreach $line (@matches)
  {if ($line=~/HREF/ig) { $line=~s/.*HREF=\"(.*?)\"\s.*/$1/ig; push(@profileNames,$line) unless $line!~/browse\?/;}}


# reverse the list
# this can be taken out for speed, I did this really early on when i had already done the first 100 names
# and wanted to do the backside of the list.  At the time the web site only let you send 100 emails...
# lucky us they upgraded their site to allow for more now... well maybe till they read this article ;)
  @profileNames= reverse(@profileNames);

  foreach $profileName (@profileNames)
  {
     $profileName =~ s/\/browse\?(.*)/$1/;
     #print "$profileName\n"; #<- debug stuff you can take off the comment if you want really verbose
     #this ensures that only unique names are passed on 
     getProfile($profileName) unless $seen{$profileName}++;
  }

   

sub getProfile
{

    my $name = $_[0];
#let's glob all the HTML from the profiles and then clean it up later
    my $profileLink = 'http://austin.matchmaker.com/browse?' . $name;
    $reqProfiles = HTTP::Request->new(GET => "$profileLink");
    $reqProfiles->authorization_basic('$userName', '$passWord');
    $reqProfiles->header('Accept' => 'text/html');
# send request
    $resProfiles = $ua->request($reqProfiles);
# check the outcome
    if ($resProfiles->is_success) 
    {#could print some output here but it was too damn verbose} 
    else 
    {print "Error: " . $resProfiles->status_line . "\n";}
# jus tracking this statistically for an end result
    $profileCount++;
# now the next two if statements are really really lazy, i am 
# checking for two things, one if the person already has mail in their
# inbox from me (the profile page will have a link to /read? followed by a 
# numerical identifier so that's easy to find) and if they are new to the 
# system (in which case a who-newsm.gif image will appear and can be found)
# Now i can run this over and over and only new women i haven't already 
# emailed will get picked up and sent to the email function <big evil grin>
# the first time around you may want to remove the new bit (second if statement)
# TODO: update this logic, way too sloppy with 2 if statements... sheesh
    if ($resProfiles->as_string!~m/read\?\d/)
    {
     if ($resProfiles->as_string=~m/who-newsm\.gif/)
     {
         print "$name is new and needs some love [";
         $resSendingEmail = sendEmail($name);
         print "$resSendingEmail]\n";
     }
  }
}

sub sendEmail
{
# Here's the good stuff, the messagae itself is just another form submission.  the message has actually
# gotten a lot of response, good and bad.  One chick told me to "fuck off" (ironically her profile has her
# wanting to change 'how much she cusses'... her and me both.  She's blocked me from mailing again ;)
# The message gets autoEncoded to URL form so don't sweat that at all.  Just remember that the \n character
# is needed to do line breaks, those make sure it's not one long ass string.
# Just for the hell of it, here is the message I sent out:
# I'm looking for a casual lover that can be discrete.\n
# Age is not important to me at all, I find all women beautiful.\nLet me know if your interested.
#
# You'd really be amazed at the responses.
# So far I've gotten about 5-10 different women in different stages and one is actually ready to meet.
    my $name = $_[0];
    my $subject = "ADD YOUR OWN SUBJECT HERE";
    my $text = "ADD YOUR OWN MESSAGE HERE";
    my $reqSendMail = HTTP::Request->new(POST => 'http://austin.matchmaker.com/sndsub');
    $reqSendMail->content_type('application/x-www-form-urlencoded');
    $reqSendMail->authorization_basic($userName,$passWord);
    my $postParameters = 'to=' . $name . '&subject=' . $subject . '&text=' . $text;
    $reqSendMail->content("$postParameters");
    my $resSendMail = $ua->request($reqSendMail);

    if ($resSendMail->is_success) {
         return "DONE";
    } else {
         print "UH OH";
    }
    
}

# After the fact kind of statistic I'm watching for other reasons.  Thinking about adding DBI support 
# since I have sql 2000 on here anyway and just collecting some statistics and names and stuff.
print "$profileCount profiles retrieved";

# So I haven't been laid yet, yet.  I'm working on it.
# have fun with the code and be responsible with it damn it.  Don't fuck
# it up for the rest of us.  Next month I'll post my emailing routine.
# Basically it's for those hard to reach people on the service.  EG the ones who
# have full ass mailboxes (100 mail limit for non members on this site).  So the
# other script I have will keep sending a message to a user (soon multiple users)
# and has a randomized timer to keep things from being too obvious.  Once the message
# goes through the script comes back and notifies you with the time of the completed
# message submission.
# 
# peace  ~-{thothicus}-~