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;