#!/usr/bin/perl -Tw
# drbot version 0.9
# by modulus schmodulus
# Tue Jan 10 17:19:47 PST 2006
#TODO use perl switch module to parse arguments instead of using @ARGV
use strict;
use LWP;
use HTTP::Cookies;
$0="drbot.pl";
my $verbose=undef;
&usage() if !defined $ARGV[0];
if ($ARGV[0] eq "-v"){
$verbose=1;
} else {
&usage();
}
# create new cookie_jar object
my $cookie_jar = HTTP::Cookies->new( file => 'cookies.dat', autosave => 1);
# Create new user agent object
my $ua = LWP::UserAgent->new;
# allow POST requests to be redirectable
push @{ $ua->requests_redirectable }, 'POST';
# set user agent type
$ua->agent('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1;)');
# set user agent cookies
$ua->cookie_jar($cookie_jar);
print "Logging into DR.." if defined $verbose;
my $currpage=&drlogin();
print "Acquiring list of My Neighborhood.." if defined $verbose;
&drinvestigate($currpage);
sub drinvestigate{
my $html = $_[0];
my %id_name;
my @investigate_links;
# <a class="NavItem" href="/PlayerRankings.cfm?PlayerID=2102280">My Neighborhood</a>
if ($html =~ /(<a[^>]*>My Neighborhood<\/a>)/g){
$html = $1;
};
if ($html =~ /href=\"([^\"]*)\"/g){
$html = $1;
};
my $targets = click_link($html);
sleep 1 && print "." if defined $verbose;
#<a href="/PlayerProfile.cfm?PlayerID=2125112">baggerlip</a>
#<a class="NavItem" href="/PlayerProfile.cfm?PlayerID=2102280">My Profile</a></td>
#<td class="Ledger1">Assassin</td>
$targets =~ s/
||\r||\n//g;
# regex out playerids with their perspective names
while ($targets =~ /<a href=\"\/PlayerProfile.cfm\?PlayerID=([^\"]*)\">([^<]*)<\/a>/g){
# populate associative array called %id_name (playerid to name)
$id_name{$1}=$2;
}
# regex out "investigate" links
#<a href="Investigate.cfm?TargetID=2152317&DoItNow=Y">investigate</a>
while ($targets =~ /<a href=\"(Investigate.cfm\?TargetID=[^\&]*\&DoItNow=Y)\">investigate<\/a>/g){
## populate array with url from link
push (@investigate_links,"\/$1");
}
sleep 1 && print "SUCCESS!\n" if defined $verbose;
# values for clicking on "investigate":
# <tr><td class="HeaderSmall" colspan="6" align="center"><h3>Player is already investigated!</h3></td></tr>^M
# <tr><td class="HeaderSmall" colspan="6" align="center"><h3>Investigation failed!</h3></td></tr>^M
# <tr><td class="HeaderSmall" colspan="6" align="center"><h3>Investigation was successful!</h3></td></tr>^M
print "Starting investigations:\n" if defined $verbose;
for (@investigate_links){
my $targetid = 'UNKNOWN';
if ($_ =~ /Investigate.cfm\?TargetID=([^\&]*)\&DoItNow=Y/){
$targetid = $1;
}
if (click_link($_) =~ /<tr><td class=\"HeaderSmall\" colspan=\"6\" align=\"center\"><h3>([^<]*)<\/h3><\/td><\/tr>/g)
{
logit("$1: PlayerID: $targetid PlayerName: $id_name{$targetid}");
}
}
}
sub click_link{
my $desturl = $_[0];
my $req = HTTP::Request->new(GET => "http://www.drugrunners.net$desturl");
$req->content('PlayerID=2102280');
my $res = $ua->request($req);
if ($res->is_success) {
return $res->content;
} else {
print $res->status_line, "\n";
}
}
sub drlogin{
##### Login to DR site #####
sleep 1 && print "." if defined $verbose;
sleep 1 && print "." if defined $verbose;
sleep 1 && print "." if defined $verbose;
my $req_login = HTTP::Request->new(POST => 'http://www.drugrunners.net/PlayerLogin.cfm');
$req_login->content_type('application/x-www-form-urlencoded');
# pass player login/pass info
$req_login->content('PlayerName=UserName&Password=Password&ban=Y&Submit= Log In ');
my $resdologin = $ua->request($req_login);
if ($resdologin->is_success) {
print "SUCCESS!\n" if defined $verbose;
return $resdologin->content;
} else {
return $resdologin->status_line, "\n";
}
}
sub get_date {
my @days = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
my @months = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
my ($sec,$min,$hour,$mday,$mon,$year,$wday) = (localtime(time))[0,1,2,3,4,5,6];
my $time = sprintf("%02d\:%02d\:%02d",$hour,$min,$sec);
$year += 1900;
return "$months[$mon] $mday $time";
}
sub logit{
my $text = $_[0];
my $date = get_date();
open (FH,">>dr_bot.log");
print FH "$date drbot.pl $text\n";
close (FH);
print "$date drbot.pl $text\n" if defined $verbose;
}
sub usage{
print "\n Usage: $0 -v [verbose]\n\n";
exit;
}