All pastes #980252 Raw Edit

Miscellany

public text v1 · immutable
·published 2008-04-10 21:42 UTC
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;