rendered paste body#!/usr/bin/perl
use strict;
use warnings;
use vars qw{ %cmdLineOpts $threads $dbname $dbhost $dbuser $dbpass $threadrefs $logging $useragent};
use DBI; # Use internal SQLite DB
use HTTP::Lite; # Connect to Website for Downloads
use Data::Dumper;
use XML::TreePP;
use Devel::Size qw(size total_size);
$useragent="Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.1.1) Gecko/20061204 Firefox/2.0.0.1";
$logging=1;
$| = 1;
($threads, $dbname, $dbhost, $dbuser, $dbpass) = (1,"", "", "", "");
sub Initialize() {
# Connect Controller thread to Database and pull Account List
my ($cid, $inUS, $domain, $rname, $cname);
my $httphandle = new HTTP::Lite;
$httphandle->add_req_header("User-Agent", "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.1.1) Gecko/20061204 Firefox/2.0.0.1");
my $xtpp = XML::TreePP->new();
$xtpp->set( ignore_error => 1 );
my $dbh = DBI->connect("dbi:mysql:$dbname;$dbhost",$dbuser,$dbpass);
my $query = "SELECT c.id, r.us, r.name AS rname, c.name AS cname FROM `character` AS c LEFT JOIN realm AS r ON r.id=c.realm_id LIMIT 15";
my $sth = $dbh->prepare($query);
$sth->execute();
$sth->bind_columns(\$cid, \$inUS, \$rname, \$cname);
# Divide Accounts evenly into each thread
my @data;
while($sth->fetch()) {
if($inUS) {$domain="www.wowarmory.com"} else {$domain="eu.wowarmory.com"}
# Create Character Entry
my %character;
$character{id} = $cid;
$character{realm} = $rname;
$character{name} = $cname;
$character{url} = $domain."/character-talents.xml?r=".encode($rname)."&n=".encode($cname);
$character{xmltext} = 0;
$character{xmltree} = 0;
$character{errorcount} = 0;
print "\n\n\n--------------------------------------------------------------------------------\n";
print ("Fetching ", $character{name}, " of ",$character{realm}, " from ", $domain, " ");
$character{xmltext}=fetch($httphandle, $character{url});
print "Line 48\n";
if($character{xmltext}) {
$character{xmltree} = $xtpp->parse($character{xmltext});
print "Line 51\n";
if($character{xmltree}) {
#Handle Error Codes
print "Line 54\n";
if(defined($character{xmltree}->{page}->{characterInfo}->{'-errCode'})) {
# error Code Exists, Process
print "Line 57\n";
} else {
print "Line 59\n";
# Character's guild (guildName + realm id),
# character's arena team members (name + class id + realm id),
# character's arena team members' guilds (guild + realm id),
# character's build (value + class id) are all rows in other tables.
# Once that's taken care of, update the character's entry in the db with the guild id, class id, build id, and syncs++.
$character{lastModified} = $character{xmltree}->{page}->{characterInfo}->{character}->{'-lastModified'};
$character{guild} = $character{xmltree}->{page}->{characterInfo}->{character}->{'-guildName'};
$character{guild} = $character{xmltree}->{page}->{characterInfo}->{character}->{'-guildName'};
$character{class} = $character{xmltree}->{page}->{characterInfo}->{character}->{'-class'};
$character{classid} = $character{xmltree}->{page}->{characterInfo}->{character}->{'-classId'};
$character{talents} = $character{xmltree}->{page}->{characterInfo}->{talentTab}->{talentTree}->{-value};
}
print " ... Success\n";
} else {
print " ... Failed: ".@$."\n";
$character{xml} = "";
$character{errorcount} +=1;
unshift(@data, \%character);
}
} else {
print " ... Failed: ".@$."\n";
$character{xml} = "";
$character{errorcount} +=1;
unshift(@data, \%character);
}
print "\n\nSizes:\n";
print "\%character=>[".total_size(\%character)." bytes]\n";
print "\$httphandle=>[".total_size($httphandle)." bytes]\n";
print "\$xtpp=>[".total_size($xtpp)." bytes]\n";
undef %character;
#print Dumper(%character);
}
}
sub fetch($;$) {
my ($httphandle, $url) = @_;
my $req = $httphandle->request("http://".$url);
if($req==200) {
return $httphandle->body();
} else {
@$ = "Request failed ($req): ".$httphandle->status_message();
return 0;
}
}
sub encode($) {
my $s = shift;
$s =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
$s =~ s/%20/+/;
return $s;
}
Initialize();
1;