Mercurial > eagle-eye
view Ikariam.pm @ 22:552528bb4917
refined the cache timeout is 12 hours.
author | "Rex Tsai <chihchun@kalug.linux.org.tw>" |
---|---|
date | Wed, 08 Oct 2008 19:27:54 +0800 |
parents | 9c52ae71c1cb |
children | 54ab0becd730 |
line wrap: on
line source
#!/usr/bin/env perl use Class::DBI::AutoLoader ( dsn => 'dbi:SQLite:dbname=ikariam.sqlite', options => { RaiseError => 1 }, tables => ['cities', 'island', 'user'], use_base => 'Class::DBI::SQLite', namespace => 'Ikariam', ); package Ikariam; use Data::Dumper; use LWP; # use LWP::Debug qw(+ -conns -trace -debug); use LWP::Debug qw(+trace); use HTTP::Cookies; use WWW::Mechanize; use HTML::TagParser; use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ; sub new { my ($class, $server, $user, $pass) = @_; my $self = { mech => WWW::Mechanize->new( agent => "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.9.0.3) Gecko/2008092816 Iceweasel/3.0.1 (Debian-3.0.1-1)", timeout => 10, ), server => $server, user => $user, pass => $pass, }; $self->{mech}->cookie_jar(HTTP::Cookies->new(file => "./cookies.txt", autosave => 1)); $self->{mech}->default_headers->push_header('Accept-Encoding', 'deflate'); return bless $self, $class; } sub viewScore { my $self = shift; my $type = shift || 'score'; my $user = shift || ''; my $offset = shift || 0; my $res = $self->{mech}->post(sprintf("http://%s/index.php", $self->{server}), [ highscoreType => $type, offset => $offset, searchUser => $user, view => 'highscore' ]); my $c; my $status = gunzip \$res->content => \$c or die "gunzip failed: $GunzipError\n"; my $html = HTML::TagParser->new($c); my ($table) = $html->getElementsByAttribute("class", "table01"); my @elems = getElementsByTagName($table, "tr"); my %users; foreach my $elem (@elems) { my $e; my %user; $e = getElementsByAttribute($elem, "class", "action"); $e = getElementsByTagName($e, "a"); if(defined ($e) && $e->getAttribute('href') =~ /index\.php\?view=sendMessage&with=(\d+)&oldView=highscore/) { $user{'id'} = $1; $e = getElementsByAttribute($elem, "class", "name"); $user{'name'} = $e->innerText(); $e = getElementsByAttribute($elem, "class", "allytag"); $user{'ally'} = $e->innerText(); $e = getElementsByTagName($e, "a"); if($e->getAttribute('href') =~ /\?view=allyPage&allyId=(\d+)/) { $user{'allyId'} = $1; } $e = getElementsByAttribute($elem, "class", "score"); $user{$type} = $e->innerText(); $user{$type} =~ s/,//g; $users{$user{'id'}} = \%user; } else { next; } } return \%users; } sub viewWorldMap { my $self = shift; my $x = shift; my $y = shift; if(!defined($x) && !defined($y)) { die('location required'); } my $res = $self->{mech}->post(sprintf("http://%s/index.php?view=worldmap_iso", $self->{server}), [ xajax => 'getMapData', 'xajaxargs[]' => $x, 'xajaxargs[]' => $y, xajaxr => time, ]); my $c; my $status = gunzip \$res->content => \$c or die "gunzip failed: $GunzipError\n"; my @islands; # parsing xjxobj while($c =~ /<cmd n="jc" t="addToMap"><xjxobj><e><k>0<\/k><v><!\[CDATA\[(\d+)\]\]><\/v><\/e><e><k>1<\/k><v><!\[CDATA\[(\d+)\]\]><\/v><\/e><e><k>2<\/k><v><!\[CDATA\[(\d+)\]\]><\/v><\/e><e><k>3<\/k><v><!\[CDATA\[(\d+)\]\]><\/v><\/e><e><k>4<\/k><v><!\[CDATA\[(\d+)\]\]><\/v><\/e><e><k>5<\/k><v><!\[CDATA\[(\w+)\]\]><\/v><\/e><e><k>6<\/k><v><!\[CDATA\[(\d+)\]\]><\/v><\/e><e><k>7<\/k><v><!\[CDATA\[(\d+)\]\]><\/v><\/e><\/xjxobj><\/cmd>/g) { my %island; $island{id} = $3; $island{x} = $1; $island{y} = $2; $island{name} = $6; $island{tradegood} = $4; $island{wonder} = $5; # $7 ? $island{people} = $8; push @islands, \%island; } return @islands; } sub viewHomeMap { my $self = shift; my $res = $self->{mech}->get(sprintf("http://%s/index.php?view=worldmap_iso", $self->{server})); my $c; my $status = gunzip \$res->content => \$c or die "gunzip failed: $GunzipError\n"; # m[50][36]=new Array(564,1,5,'Risietia', '5', 13); # x = 43-57 = 6 # y = 27-41 = 6 my @islands; while($c =~ /m\[(\d+)\]\[(\d+)\]=new Array\((\d+),(\d+),(\d+),'(\w+)', '(\d+)', (\d+)\);/g) { my %island; $island{id} = $3; $island{x} = $1; $island{y} = $2; $island{name} = $6; $island{tradegood} = $4; $island{wonder} = $5; # $7 ? $island{people} = $8; #foreach my $i (sort(keys(%island))) #{ # printf ("%s %s\n", $i, $island{$i}); #} #print("\n"); push @islands, \%island; } return @islands; } sub viewIsland { my $self = shift; my $island = shift; my $res = $self->{mech}->get(sprintf("http://%s/index.php?view=island&id=%s", $self->{server}, $island)); my $c; my $status = gunzip \$res->content => \$c or die "gunzip failed: $GunzipError\n"; my $html = HTML::TagParser->new($c); # find inactivity and vacation my %status; foreach my $class (qw/inactivity vacation/) { @elems = $html->getElementsByAttribute("class", $class); foreach my $elem (@elems) { if($elem->innerText() =~ /^(.*?) \((\w)\)/) { $status{$1} = $2; # printf("%s\n", $elem->innerText()); } } } # find content my @elems = $html->getElementsByClassName( "cityinfo" ); my @cities; foreach my $elem (@elems) { my %info; my @e = getElementsByTagName($elem, "li"); $info{'cityname'} = substr($e[0]->innerText(), 8); $info{'citylevel'} = substr($e[1]->innerText(), 14); $info{'owner'} = substr($e[2]->innerText(), 8); $info{'ally'} = substr($e[3]->innerText(), 8); delete($info{'ally'}) if($info{'ally'} eq '-'); @e = getElementsByAttribute($elem, "class", "messageSend"); if ( $e[0]->getAttribute("href") =~ /with=(\d+)&destinationCityId=(\d+)/) { $info{'user'} = $1; $info{'cityId'} = $2; } # update status; if(defined($status{$info{'cityname'}})) { $info{'status'} = $status{$info{'cityname'}}; } else { $info{'status'} = undef; } # print(Dumper(\%info)); push @cities, \%info; } return @cities; } sub logout { my $self = shift; $self->{mech}->get(sprintf('http://%s/index.php?action=loginAvatar&function=logout', $self->{server})); } sub login { my $self = shift; my $res = $self->{mech}->post(sprintf("http://%s/index.php?action=loginAvatar&function=login", $self->{server}), [ name => $self->{user}, password => $self->{pass}, ]); my $c; my $status = gunzip \$res->content => \$c or die "gunzip failed: $GunzipError\n"; if($c =~ /錯誤!/) { die ("password error\n"); } } sub getElementsByTagName { my $element = shift; my $tagname = lc(shift); my ( $flat, $cur ) = @$element; my $out = []; for( ; $cur <= $#$flat ; $cur++ ) { next if ( $flat->[$cur]->[001] ne $tagname ); next if $flat->[$cur]->[000]; # close my $elem = HTML::TagParser::Element->new( $flat, $cur ); return $elem unless wantarray; push( @$out, $elem ); } return unless wantarray; @$out; } sub getElementsByAttribute { my $element = shift; my $key = lc(shift); my $val = shift; my ( $flat, $cur ) = @$element; my $out = []; for ( ; $cur <= $#$flat ; $cur++ ) { next if $flat->[$cur]->[000]; # close my $elem = HTML::TagParser::Element->new( $flat, $cur ); my $attr = $elem->attributes(); next unless exists $attr->{$key}; next if ( $attr->{$key} ne $val ); return $elem unless wantarray; push( @$out, $elem ); } return unless wantarray; @$out; } 1;