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