eagle-eye: Ikariam.pm annotate

annotate Ikariam.pm @ 55:ff00d108e955

check resources for build_townHall

author	"Rex Tsai <chihchun@kalug.linux.org.tw>"
date	Mon, 20 Oct 2008 23:44:45 +0800
parents	2d3c394b7940
children	6e0d5e781949

rev	line source
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	1 #!/usr/bin/env perl
41 5849b6fdc76c removed my password from scripts. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 37 diff changeset	2 BEGIN {
48 96ee35378696 modified for searching configuration files "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 41 diff changeset	3 foreach (((getpwuid($<))[7], $ENV{HOME}, $ENV{LOGDIR}, ".")) {
96ee35378696 modified for searching configuration files "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 41 diff changeset	4 require "$_/.eagleeye.pm" if (-f "$_/.eagleeye.pm");
96ee35378696 modified for searching configuration files "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 41 diff changeset	5 }
41 5849b6fdc76c removed my password from scripts. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 37 diff changeset	6 }
2 0fb73a7a0b94 ok, we done basic island scanning functions. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 1 diff changeset	7
0fb73a7a0b94 ok, we done basic island scanning functions. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 1 diff changeset	8 use Class::DBI::AutoLoader (
0fb73a7a0b94 ok, we done basic island scanning functions. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 1 diff changeset	9 dsn => 'dbi:SQLite:dbname=ikariam.sqlite',
0fb73a7a0b94 ok, we done basic island scanning functions. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 1 diff changeset	10 options => { RaiseError => 1 },
8 e4b3168d0319 implemented sheep and enemy scripts. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 7 diff changeset	11 tables => ['cities', 'island', 'user'],
2 0fb73a7a0b94 ok, we done basic island scanning functions. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 1 diff changeset	12 use_base => 'Class::DBI::SQLite',
0fb73a7a0b94 ok, we done basic island scanning functions. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 1 diff changeset	13 namespace => 'Ikariam',
0fb73a7a0b94 ok, we done basic island scanning functions. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 1 diff changeset	14 );
0fb73a7a0b94 ok, we done basic island scanning functions. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 1 diff changeset	15
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	16 package Ikariam;
27 dd85b55eec2a implemented basic inference engine. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 26 diff changeset	17 use strict;
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	18 use Data::Dumper;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	19 use LWP;
7 2040ccc95670 implemented scores collection. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 6 diff changeset	20 # use LWP::Debug qw(+ -conns -trace -debug);
2040ccc95670 implemented scores collection. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 6 diff changeset	21 use LWP::Debug qw(+trace);
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	22 use HTTP::Cookies;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	23 use WWW::Mechanize;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	24 use HTML::TagParser;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	25 use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	26
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	27 sub new
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	28 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	29 my ($class, $server, $user, $pass) = @_;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	30
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	31 my $self =
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	32 {
16 59f2c435760c implemented cached by timing. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 10 diff changeset	33 mech => WWW::Mechanize->new(
59f2c435760c implemented cached by timing. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 10 diff changeset	34 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)",
59f2c435760c implemented cached by timing. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 10 diff changeset	35 timeout => 10,
59f2c435760c implemented cached by timing. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 10 diff changeset	36 ),
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	37 server => $server,
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	38 user => $user,
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	39 pass => $pass,
54 2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	40 buildingIDs => {
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	41 townHall => 0,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	42 townhall => 0,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	43 port => 3,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	44 academy => 4,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	45 shipyard => 5,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	46 barracks => 6,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	47 warehouse => 7,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	48 wall => 8,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	49 tavern => 9,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	50 museum => 10,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	51 palace => 11,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	52 embassy => 12,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	53 branchOffice => 13,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	54 workshop => 15,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	55 'workshop-army' => 15,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	56 'workshop-fleet' => 15,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	57 safehouse => 16,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	58 palaceColony => 17,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	59 resource => 1,
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	60 tradegood => 2
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	61 }
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	62 };
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	63
54 2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	64
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	65 $self->{mech}->cookie_jar(HTTP::Cookies->new(file => "/tmp/ikariam-cookies.txt", autosave => 1));
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	66 $self->{mech}->default_headers->push_header('Accept-Encoding', 'deflate');
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	67
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	68 return bless $self, $class;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	69 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	70
5 dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	71 sub viewScore
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	72 {
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	73 my $self = shift;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	74 my $type = shift \|\| 'score';
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	75 my $user = shift \|\| '';
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	76 my $offset = shift \|\| 0;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	77
7 2040ccc95670 implemented scores collection. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 6 diff changeset	78 my $res = $self->{mech}->post(sprintf("http://%s/index.php", $self->{server}), [
6 2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	79 highscoreType => $type,
2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	80 offset => $offset,
2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	81 searchUser => $user,
2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	82 view => 'highscore'
2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	83 ]);
5 dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	84
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	85 my $c;
6 2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	86 my $status = gunzip \$res->content => \$c
2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	87 or die "gunzip failed: $GunzipError\n";
2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	88
37 7d1e353520ca just return empty users list, when the score link table is missed. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 34 diff changeset	89 my %users;
5 dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	90 my $html = HTML::TagParser->new($c);
37 7d1e353520ca just return empty users list, when the score link table is missed. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 34 diff changeset	91 my ($table) = $html->getElementsByAttribute("class", "table01");
7d1e353520ca just return empty users list, when the score link table is missed. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 34 diff changeset	92 return %users if(!defined($table));
5 dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	93
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	94 my @elems = getElementsByTagName($table, "tr");
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	95
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	96 foreach my $elem (@elems) {
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	97 my $e;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	98 my %user;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	99
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	100 $e = getElementsByAttribute($elem, "class", "action");
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	101 $e = getElementsByTagName($e, "a");
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	102
8 e4b3168d0319 implemented sheep and enemy scripts. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 7 diff changeset	103 if(defined ($e) && $e->getAttribute('href') =~ /index\.php\?view=sendMessage&with=(\d+)&oldView=highscore/)
5 dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	104 {
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	105 $user{'id'} = $1;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	106
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	107 $e = getElementsByAttribute($elem, "class", "name");
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	108 $user{'name'} = $e->innerText();
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	109
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	110 $e = getElementsByAttribute($elem, "class", "allytag");
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	111 $user{'ally'} = $e->innerText();
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	112
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	113 $e = getElementsByTagName($e, "a");
5 dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	114 if($e->getAttribute('href') =~ /\?view=allyPage&allyId=(\d+)/)
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	115 {
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	116 $user{'allyId'} = $1;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	117 }
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	118
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	119 $e = getElementsByAttribute($elem, "class", "score");
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	120 $user{$type} = $e->innerText();
19 9c52ae71c1cb fixed , in score "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 16 diff changeset	121 $user{$type} =~ s/,//g;
5 dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	122
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	123 $users{$user{'id'}} = \%user;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	124 } else {
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	125 next;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	126 }
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	127 }
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	128
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	129 return \%users;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	130 }
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	131
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	132 sub viewWorldMap
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	133 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	134 my $self = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	135 my $x = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	136 my $y = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	137
1 f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	138 if(!defined($x) && !defined($y))
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	139 {
1 f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	140 die('location required');
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	141 }
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	142
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	143 my $res = $self->{mech}->post(sprintf("http://%s/index.php?view=worldmap_iso", $self->{server}), [
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	144 xajax => 'getMapData',
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	145 'xajaxargs[]' => $x,
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	146 'xajaxargs[]' => $y,
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	147 xajaxr => time,
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	148 ]);
1 f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	149
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	150 my $c;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	151 my $status = gunzip \$res->content => \$c
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	152 or die "gunzip failed: $GunzipError\n";
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	153
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	154 my @islands;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	155 # parsing xjxobj
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	156 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)
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	157 {
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	158 my %island;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	159 $island{id} = $3;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	160 $island{x} = $1;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	161 $island{y} = $2;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	162 $island{name} = $6;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	163 $island{tradegood} = $4;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	164 $island{wonder} = $5;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	165 # $7 ?
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	166 $island{people} = $8;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	167 push @islands, \%island;
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	168 }
1 f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	169 return @islands;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	170 }
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	171
3 b72786cdccbb fixed a typo "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 2 diff changeset	172 sub viewHomeMap
1 f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	173 {
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	174 my $self = shift;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	175
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	176 my $res = $self->{mech}->get(sprintf("http://%s/index.php?view=worldmap_iso", $self->{server}));
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	177
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	178 my $c;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	179 my $status = gunzip \$res->content => \$c
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	180 or die "gunzip failed: $GunzipError\n";
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	181
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	182 # m[50][36]=new Array(564,1,5,'Risietia', '5', 13);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	183 # x = 43-57 = 6
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	184 # y = 27-41 = 6
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	185 my @islands;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	186 while($c =~ /m\[(\d+)\]\[(\d+)\]=new Array$(\d+),(\d+),(\d+),'(\w+)', '(\d+)', (\d+)$;/g)
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	187 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	188 my %island;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	189 $island{id} = $3;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	190 $island{x} = $1;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	191 $island{y} = $2;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	192 $island{name} = $6;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	193 $island{tradegood} = $4;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	194 $island{wonder} = $5;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	195 # $7 ?
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	196 $island{people} = $8;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	197
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	198 #foreach my $i (sort(keys(%island)))
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	199 #{
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	200 # printf ("%s %s\n", $i, $island{$i});
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	201 #}
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	202 #print("\n");
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	203 push @islands, \%island;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	204 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	205 return @islands;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	206 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	207
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	208 sub viewIsland
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	209 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	210 my $self = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	211 my $island = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	212
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	213 my $res = $self->{mech}->get(sprintf("http://%s/index.php?view=island&id=%s", $self->{server}, $island));
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	214
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	215 my $c;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	216 my $status = gunzip \$res->content => \$c
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	217 or die "gunzip failed: $GunzipError\n";
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	218
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	219 my $html = HTML::TagParser->new($c);
10 f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	220
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	221 # find inactivity and vacation
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	222 my %status;
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	223 foreach my $class (qw/inactivity vacation/)
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	224 {
27 dd85b55eec2a implemented basic inference engine. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 26 diff changeset	225 my @elems = $html->getElementsByAttribute("class", $class);
10 f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	226 foreach my $elem (@elems) {
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	227 if($elem->innerText() =~ /^(.*?) $(\w)$/) {
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	228 $status{$1} = $2;
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	229 # printf("%s\n", $elem->innerText());
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	230 }
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	231 }
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	232 }
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	233
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	234 # find content
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	235 my @elems = $html->getElementsByClassName( "cityinfo" );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	236 my @cities;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	237 foreach my $elem (@elems) {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	238 my %info;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	239
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	240 my @e = getElementsByTagName($elem, "li");
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	241 $info{'cityname'} = substr($e[0]->innerText(), 8);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	242 $info{'citylevel'} = substr($e[1]->innerText(), 14);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	243 $info{'owner'} = substr($e[2]->innerText(), 8);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	244 $info{'ally'} = substr($e[3]->innerText(), 8);
5 dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	245 delete($info{'ally'}) if($info{'ally'} eq '-');
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	246
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	247 @e = getElementsByAttribute($elem, "class", "messageSend");
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	248 if ( $e[0]->getAttribute("href") =~ /with=(\d+)&destinationCityId=(\d+)/)
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	249 {
8 e4b3168d0319 implemented sheep and enemy scripts. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 7 diff changeset	250 $info{'user'} = $1;
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	251 $info{'cityId'} = $2;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	252 }
10 f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	253
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	254 # update status;
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	255 if(defined($status{$info{'cityname'}})) {
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	256 $info{'status'} = $status{$info{'cityname'}};
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	257 } else {
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	258 $info{'status'} = undef;
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	259 }
f590b5ea5e55 fixed bug of sheep.pl "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 9 diff changeset	260 # print(Dumper(\%info));
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	261 push @cities, \%info;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	262 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	263
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	264 return @cities;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	265 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	266
54 2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	267 sub increaseTransporter {
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	268 my $self = shift;
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	269 my $param = shift;
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	270 my $cityId = shift;
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	271
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	272 my @locations = @{$self->{'cities'}->{$cityId}->{locations}};
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	273 foreach (1..2) {
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	274 if($locations[$_] eq 'port') {
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	275 my $res = $self->{mech}->get(sprintf('http://%s/index.php?action=CityScreen&function=increaseTransporter&id=%s&position=%s',
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	276 $self->{server}, $cityId, $_));
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	277 }
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	278 }
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	279 }
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	280
52 d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	281 sub build {
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	282 my $self = shift;
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	283 my $type = shift;
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	284 my $cityId = shift;
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	285
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	286 die ("we don't know about this city") unless(defined($self->{'cities'}->{$cityId}));
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	287
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	288 my $position = -1;
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	289 my @locations = @{$self->{'cities'}->{$cityId}->{locations}};
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	290 foreach (0..$#locations) {
54 2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	291 $position = $_ if($locations[$_] eq $type);
52 d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	292 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	293
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	294 if($position == -1)
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	295 {
54 2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	296 foreach (0..$#locations) {
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	297 next if($_ <= 2 && ($self->{buildingIDs}->{$type} ne "workshop-fleet" &&
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	298 $self->{buildingIDs}->{$type} ne "shipyard"));
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	299 if($locations[$_] eq undef) {
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	300 my $res = $self->{mech}->get(sprintf('http://%s/index.php?action=CityScreen&function=build&id=%s&position=%s&building=%d',
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	301 $self->{server}, $cityId, $_, $self->{buildingIDs}->{$type} ));
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	302 last;
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	303 }
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	304 }
52 d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	305 } else {
54 2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	306 $self->{mech}->add_header( Referer =>
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	307 sprintf("http://%s/index.php?view=%s&id=%s&position=%d", $self->{server}, $type, $cityId, $position));
52 d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	308 my $res = $self->{mech}->post(sprintf('http://%s/index.php', $self->{server}), [
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	309 action => 'CityScreen',
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	310 'function' => 'upgradeBuilding',
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	311 id => $cityId,
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	312 position => $position,
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	313 level => $self->{'cities'}->{$cityId}->{buildings}->{$type},
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	314 oldView => $type,
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	315 ]);
54 2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	316 # my $content;
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	317 # gunzip \$res->content => \$content
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	318 # or die "gunzip failed: $GunzipError\n";
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	319 # print ($content);
52 d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	320 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	321 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	322
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	323 sub run {
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	324 my $self = shift;
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	325 # defense.
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	326 die("Not implemented");
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	327 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	328
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	329 sub research
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	330 {
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	331 my $self = shift;
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	332 my $type = shift;
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	333 my $cityId = shift;
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	334
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	335 # check if we are researching the same stuff
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	336 my $res = $self->{mech}->get(sprintf('http://%s/index.php?action=CityScreen&function=changeResearch&id=%s&researchType=%s', $self->{server}, $cityId, $type));
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	337
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	338 # my $content;
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	339 # gunzip \$res->content => \$content
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	340 # or die "gunzip failed: $GunzipError\n";
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	341 #
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	342 # print ($content);
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	343 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	344
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	345 sub checkResearch {
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	346 my $self = shift;
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	347 my $cityId = shift;
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	348
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	349 my $res = $self->{mech}->get(sprintf('http://%s/index.php?view=researchOverview&id=%s', $self->{server}, $cityId));
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	350
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	351 my $content;
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	352 gunzip \$res->content => \$content
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	353 or die "gunzip failed: $GunzipError\n";
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	354 my $html = HTML::TagParser->new($content);
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	355
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	356 my @elems = $html->getElementsByAttribute('class', 'explored');
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	357
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	358 my $out = {};
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	359 foreach my $elem (@elems) {
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	360 my @items = getElementsByTagName($elem, "a");
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	361 foreach my $item (@items) {
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	362 if($item->getAttribute('href') =~ /view=researchDetail&id=\d+&position=\d+&researchId=(\d+)$/) {
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	363 @$out{$1} = $item->innerText();
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	364 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	365 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	366 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	367 return $out;
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	368 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	369
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	370 sub check
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	371 {
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	372 my $self = shift;
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	373
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	374 # looking for cities
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	375 foreach my $cityId (keys(%{$self->{'cities'}}))
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	376 {
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	377 # search for goods
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	378 my $res = $self->{mech}->post(sprintf('http://%s/index.php', $self->{server}), [
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	379 action => 'header',
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	380 cityId => $cityId,
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	381 function => 'changeCurrentCity',
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	382 id => $cityId,
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	383 oldView => 'city',
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	384 ]);
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	385
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	386 my $content;
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	387 gunzip \$res->content => \$content
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	388 or die "gunzip failed: $GunzipError\n";
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	389
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	390 my $html = HTML::TagParser->new($content);
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	391 my @elems;
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	392
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	393 my ($elem) = $html->getElementsByAttribute("id", "value_gold");
34 91e387b51aa0 added more rules checking "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 30 diff changeset	394 $self->{'cities'}->{$cityId}->{resources}->{gold} = $elem->innerText();
91e387b51aa0 added more rules checking "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 30 diff changeset	395 $self->{'cities'}->{$cityId}->{resources}->{gold} =~ s/,//g;
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	396
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	397 my ($elem) = $html->getElementsByAttribute("class", "city");
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	398 $self->{'cities'}->{$cityId}->{name} = $elem->innerText();
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	399
30 de5de6d472f9 added space checking "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 29 diff changeset	400 my ($elem) = $html->getElementsByAttribute("class", 'constructionSite');
de5de6d472f9 added space checking "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 29 diff changeset	401 $self->{'cities'}->{$cityId}->{construction} = 0;
de5de6d472f9 added space checking "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 29 diff changeset	402 $self->{'cities'}->{$cityId}->{construction} = 1 if(defined($elem));
de5de6d472f9 added space checking "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 29 diff changeset	403
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	404 # check goods
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	405 foreach my $good (qw/wood wine marble crystal sulfur/) {
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	406 my ($elem) = $html->getElementsByAttribute("id", "value_" . $good);
34 91e387b51aa0 added more rules checking "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 30 diff changeset	407 $self->{'cities'}->{$cityId}->{resources}->{$good} = $elem->innerText();
91e387b51aa0 added more rules checking "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 30 diff changeset	408 $self->{'cities'}->{$cityId}->{resources}->{$good} =~ s/,//g;
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	409 }
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	410
29 dbec53e754e3 added rule_building "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 28 diff changeset	411 # search locations
dbec53e754e3 added rule_building "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 28 diff changeset	412 foreach my $i (0..14) {
dbec53e754e3 added rule_building "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 28 diff changeset	413 my ($elem) = $html->getElementsByAttribute("id", "position" . $i);
dbec53e754e3 added rule_building "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 28 diff changeset	414 my $building = $elem->getAttribute('class');
52 d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	415 if (!($building =~ /buildingGround/)) {
29 dbec53e754e3 added rule_building "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 28 diff changeset	416 $self->{'cities'}->{$cityId}->{locations}[$i] = $building;
dbec53e754e3 added rule_building "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 28 diff changeset	417 my $span = getElementsByAttribute($elem, "class", "textLabel");
dbec53e754e3 added rule_building "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 28 diff changeset	418 my (undef, undef, $level) = split(/ /, $span->innerText());
dbec53e754e3 added rule_building "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 28 diff changeset	419 $self->{'cities'}->{$cityId}->{buildings}->{$building} = $level;
dbec53e754e3 added rule_building "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 28 diff changeset	420 }
dbec53e754e3 added rule_building "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 28 diff changeset	421 }
dbec53e754e3 added rule_building "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 28 diff changeset	422
54 2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	423 # transporters
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	424 my ($elem) = $html->getElementsByAttribute("class", 'transAvail');
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	425 $self->{'cities'}->{$cityId}->{transporters}->{avail} = $elem->innerText();
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	426 my ($elem) = $html->getElementsByAttribute("class", 'transSum');
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	427 $self->{'cities'}->{$cityId}->{transporters}->{sum} = $elem->innerText();
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	428 $self->{'cities'}->{$cityId}->{transporters}->{sum} =~ s/\(//;
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	429 $self->{'cities'}->{$cityId}->{transporters}->{sum} =~ s/\)//;
2d3c394b7940 rules for build new building and buy transporters "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 52 diff changeset	430
34 91e387b51aa0 added more rules checking "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 30 diff changeset	431 $res = $self->{mech}->get(sprintf('http://%s/index.php?view=militaryAdvisorMilitaryMovements', $self->{server}, $cityId));
91e387b51aa0 added more rules checking "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 30 diff changeset	432 gunzip \$res->content => \$content
91e387b51aa0 added more rules checking "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 30 diff changeset	433 or die "gunzip failed: $GunzipError\n";
29 dbec53e754e3 added rule_building "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 28 diff changeset	434
34 91e387b51aa0 added more rules checking "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 30 diff changeset	435 $self->{'cities'}->{$cityId}->{force}->{attacks} = $1 if($content =~ /敵人攻擊: (\d+)/);
91e387b51aa0 added more rules checking "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 30 diff changeset	436 $self->{'cities'}->{$cityId}->{force}->{wars} = $1 if($content =~ /我方軍隊行程: (\d+)/);
91e387b51aa0 added more rules checking "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 30 diff changeset	437 # if($content =~ /更新戰鬥報告: (\d+)/);
91e387b51aa0 added more rules checking "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 30 diff changeset	438 # if($content =~ /新的戰鬥報告: (\d+)/);
29 dbec53e754e3 added rule_building "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 28 diff changeset	439
52 d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	440 # sub checkTownHall {
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	441 $res = $self->{mech}->get(sprintf('http://%s/index.php?view=townHall&id=%d', $self->{server}, $cityId));
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	442 gunzip \$res->content => \$content
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	443 or die "gunzip failed: $GunzipError\n";
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	444
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	445 # check happiness
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	446 # Happiness = Basic bonuses (196 + Capital Bonus + Holiday Bonus(25)) +
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	447 # Wine (Tavern Base(12*level) +
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	448 # Tavern Bonus(80*step)) +
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	449 # Culture (Museum Base(20*level) +
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	450 # Cultural Goods Bonus(50*Cultural Goods)) -
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	451 # Population (population) -
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	452 # Corruption (Corruption rate * population)
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	453 #
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	454 # Growth Rate = Happiness * 0.02
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	455 $html = HTML::TagParser->new($content);
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	456
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	457 my @happiness = ("ecstatic", "happy", "neutral", "sad", "outraged");
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	458 foreach my $j (0..$#happiness) {
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	459 my ($elem) = $html->getElementsByAttribute("class", sprintf("happiness happiness_%s", $happiness[$j]));
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	460 if(defined($elem)) {
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	461 $self->{'cities'}->{$cityId}->{happiness} = $j;
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	462 $self->{'cities'}->{$cityId}->{happiness_text} = $happiness[$j];
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	463 }
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	464 }
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	465
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	466 # Space, 房屋數
28 99723b8f348b added rule_corruption "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 27 diff changeset	467 $self->{'cities'}->{$cityId}->{"space"} = {};
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	468 foreach my $j (qw/occupied total/) {
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	469 my ($elem) = $html->getElementsByAttribute("class", sprintf("value %s", $j));
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	470 if(defined($elem)) {
28 99723b8f348b added rule_corruption "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 27 diff changeset	471 $self->{'cities'}->{$cityId}->{"space"}->{$j} = $elem->innerText();
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	472 }
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	473 }
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	474
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	475 # Actions
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	476 # <span id="value_maxActionPoints">1</span>
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	477
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	478 # <li class="incomegold incomegold_negative">
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	479 # <li class="incomegold incomegold_positive">
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	480 # <span class="value">-178</span>
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	481
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	482 my ($elem) = $html->getElementsByAttribute("title", "目前腐敗程度");
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	483 if(defined($elem)) {
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	484 $self->{'cities'}->{$cityId}->{corruption} = $elem->innerText();
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	485 $self->{'cities'}->{$cityId}->{corruption} =~ s/%//g;
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	486 }
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	487
52 d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	488 # countCiizens
27 dd85b55eec2a implemented basic inference engine. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 26 diff changeset	489 my @citizens_type = qw/citizens woodworkers specialworkers scientists/;
dd85b55eec2a implemented basic inference engine. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 26 diff changeset	490 @elems = $html->getElementsByAttribute('class', 'count');
dd85b55eec2a implemented basic inference engine. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 26 diff changeset	491 $self->{'cities'}->{$cityId}->{'citizens'} = {};
dd85b55eec2a implemented basic inference engine. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 26 diff changeset	492 $self->{'cities'}->{$cityId}->{'citizens'}->{total} = 0;
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	493
27 dd85b55eec2a implemented basic inference engine. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 26 diff changeset	494 foreach my $i (0..$#citizens_type)
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	495 {
27 dd85b55eec2a implemented basic inference engine. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 26 diff changeset	496 $self->{'cities'}->{$cityId}->{'citizens'}->{$citizens_type[$i]} = $elems[$i]->innerText();
dd85b55eec2a implemented basic inference engine. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 26 diff changeset	497 $self->{'cities'}->{$cityId}->{'citizens'}->{total} += $elems[$i]->innerText();;
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	498 }
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	499
52 d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	500 # }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	501
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	502 $self->{'cities'}->{$cityId}->{'research'} = $self->checkResearch($cityId);
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	503
52 d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	504 # sub checkArmies {
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	505 my %force_types;
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	506 $force_types{'army'} = [ qw/undef undef Slinger Swordsman Phalanx Ram Archer Catapult Gunsman Mortar SteamGiant Gyrocopter Bombardier Doctor Cook/ ];
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	507 $force_types{'fleet'} = [ qw/undef undef Ram-Ship BallistaShip Flamethrower CatapultShip MortarShip PaddleWheelRam DivingBoat/ ];
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	508 foreach my $x (qw/army fleet/)
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	509 {
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	510 $self->{'cities'}->{$cityId}->{$x} = {};
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	511 # search army
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	512 $res = $self->{mech}->get(sprintf('http://%s/index.php?view=cityMilitary-%s&id=%d', $self->{server}, $x, $cityId));
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	513 gunzip \$res->content => \$content
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	514 or die "gunzip failed: $GunzipError\n";
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	515
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	516 $html = HTML::TagParser->new($content);
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	517 @elems = $html->getElementsByTagName('td');
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	518 foreach my $j (0..$#{$force_types{$x}}) {
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	519 next if($force_types{$x}[$j] eq 'undef');
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	520 if($elems[$j]->innerText() == '-') {
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	521 $self->{'cities'}->{$cityId}->{$x}->{$force_types{$x}[$j]} = 0;
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	522 } else {
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	523 $self->{'cities'}->{$cityId}->{$x}->{$force_types{$x}[$j]} = $elems[$j]->innerText();
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	524 }
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	525 }
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	526 }
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	527 }
26 d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	528 # print Dumper($self->{'cities'});
d8117792c6f5 collecting more data from townHall "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 23 diff changeset	529 return $self->{'cities'};
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	530 }
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	531
9 ae412d1f7761 added logout function. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 8 diff changeset	532 sub logout
ae412d1f7761 added logout function. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 8 diff changeset	533 {
ae412d1f7761 added logout function. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 8 diff changeset	534 my $self = shift;
ae412d1f7761 added logout function. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 8 diff changeset	535 $self->{mech}->get(sprintf('http://%s/index.php?action=loginAvatar&function=logout', $self->{server}));
ae412d1f7761 added logout function. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 8 diff changeset	536 }
ae412d1f7761 added logout function. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 8 diff changeset	537
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	538 sub login
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	539 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	540 my $self = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	541
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	542 my $res = $self->{mech}->post(sprintf("http://%s/index.php?action=loginAvatar&function=login", $self->{server}), [
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	543 name => $self->{user},
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	544 password => $self->{pass},
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	545 ]);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	546 my $c;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	547 my $status = gunzip \$res->content => \$c
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	548 or die "gunzip failed: $GunzipError\n";
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	549
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	550 if($c =~ /錯誤！/)
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	551 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	552 die ("password error\n");
23 54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	553 } else {
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	554 my $html = HTML::TagParser->new($c);
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	555 my @elems;
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	556
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	557 @elems = $html->getElementsByAttribute("class", "avatarCities coords");
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	558 foreach my $elem (@elems) {
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	559 # my cities
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	560 $self->{'cities'}->{$elem->getAttribute('value')} = {};
54ab0becd730 implemented a prototype for collecting account status. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 19 diff changeset	561 }
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	562 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	563 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	564
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	565 sub getElementsByTagName {
52 d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	566 my $element = shift;
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	567 my $tagname = lc(shift);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	568 my ( $flat, $cur ) = @$element;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	569
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	570 my $out = [];
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	571 for( ; $cur <= $#$flat ; $cur++ ) {
52 d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	572 last if ($flat->[ $cur + 1 ]->[001] eq $element->tagName() );
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	573 next if ($flat->[$cur]->[001] ne $tagname );
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	574 next if $flat->[$cur]->[000]; # close
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree) "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 48 diff changeset	575
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	576 my $elem = HTML::TagParser::Element->new( $flat, $cur );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	577 return $elem unless wantarray;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	578 push( @$out, $elem );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	579 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	580 return unless wantarray;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	581 @$out;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	582 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	583
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	584 sub getElementsByAttribute {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	585 my $element = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	586 my $key = lc(shift);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	587 my $val = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	588 my ( $flat, $cur ) = @$element;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	589
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	590 my $out = [];
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	591 for ( ; $cur <= $#$flat ; $cur++ ) {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	592 next if $flat->[$cur]->[000]; # close
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	593 my $elem = HTML::TagParser::Element->new( $flat, $cur );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	594 my $attr = $elem->attributes();
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	595 next unless exists $attr->{$key};
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	596 next if ( $attr->{$key} ne $val );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	597 return $elem unless wantarray;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	598 push( @$out, $elem );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	599 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	600 return unless wantarray;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	601 @$out;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	602 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	603
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	604 1;

Mercurial > eagle-eye

annotate Ikariam.pm @ 55:ff00d108e955