All pastes #514759 Raw Edit

Mine

public text v1 · immutable
#514759 ·published 2007-05-27 22:00 UTC
rendered paste body

 
#!/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;
}