annotate Ikariam.pm @ 250:a654d43731f0

implement multi-thread Ikariam::Scanner
author "Rex Tsai <chihchun@kalug.linux.org.tw>"
date Mon, 17 Nov 2008 00:26:44 +0800
parents 5f6f845bbb1d
children 83e3ce37779d
rev   line source
41
5849b6fdc76c removed my password from scripts.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 37
diff changeset
1 BEGIN {
48
96ee35378696 modified for searching configuration files
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 41
diff changeset
2 foreach (((getpwuid($<))[7], $ENV{HOME}, $ENV{LOGDIR}, ".")) {
96ee35378696 modified for searching configuration files
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 41
diff changeset
3 require "$_/.eagleeye.pm" if (-f "$_/.eagleeye.pm");
96ee35378696 modified for searching configuration files
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 41
diff changeset
4 }
41
5849b6fdc76c removed my password from scripts.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 37
diff changeset
5 }
2
0fb73a7a0b94 ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 1
diff changeset
6
0fb73a7a0b94 ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 1
diff changeset
7 use Class::DBI::AutoLoader (
0fb73a7a0b94 ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 1
diff changeset
8 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
9 options => { RaiseError => 1 },
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
10 tables => ['cities', 'island', 'user', 'ally', 'report'],
2
0fb73a7a0b94 ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 1
diff changeset
11 use_base => 'Class::DBI::SQLite',
0fb73a7a0b94 ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 1
diff changeset
12 namespace => 'Ikariam',
0fb73a7a0b94 ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 1
diff changeset
13 );
0fb73a7a0b94 ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 1
diff changeset
14
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
15 package Ikariam::Extractor;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
16 use strict;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
17 use Data::Dumper;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
18 use XML::LibXML;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
19 use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
20 use Carp;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
21 use utf8;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
22
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
23 sub new {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
24 Carp::croak("Options should be key/value pairs, not hash reference") if ref($_[1]) eq 'HASH';
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
25
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
26 my($class, %conf) = @_;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
27
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
28 my $self = bless {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
29 doc => undef,
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
30 gzip => 1,
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
31 }, $class;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
32
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
33 $self->{gzip} = $conf{'gzip'} if(defined($conf{'gzip'}));
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
34 $self->parse($conf{'content'}) if(defined($conf{'content'}));
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
35
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
36 return $self;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
37 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
38
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
39 sub parse {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
40 my ($self, $content) = @_;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
41 my $string;
110
279a000eb3b0 fixed encoding issue of LibXML
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 106
diff changeset
42 my $parser = XML::LibXML->new('1.0','UTF-8');
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
43
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
44 if($self->{gzip} == 1) {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
45 gunzip \$content => \$string
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
46 or die "gunzip failed: $GunzipError\n";
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
47 } else {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
48 $string = $content;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
49 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
50
117
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
51 # dirty hack for stupid highScore search function.
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
52 $string =~ s/name="searchUser" value=".*?"/name="searchUser" value=""/;
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
53
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
54 $self->{doc} = $parser->parse_html_string ($string, { suppress_errors => 1, encoding => 'UTF-8' });
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
55 return;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
56 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
57
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
58 # find($XPathQuery);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
59 sub find {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
60 my $self = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
61 my $query = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
62 my $out = [];
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
63
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
64 my $result = $self->{doc}->find($query);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
65
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
66 return undef unless defined($result);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
67
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
68 if ( $result->isa( 'XML::LibXML::NodeList' ) ) {
150
fab1593cadf1 fixed the combat reading issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 148
diff changeset
69 if($result->size() == 0) {
fab1593cadf1 fixed the combat reading issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 148
diff changeset
70 return undef unless wantarray;
fab1593cadf1 fixed the combat reading issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 148
diff changeset
71 return ();
fab1593cadf1 fixed the combat reading issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 148
diff changeset
72 }
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
73 foreach ( @$result ) {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
74 # $_ is XML::LibXML::Element, XML::LibXML::Node
92
bcd2e32cfabb fixed the user name encoding issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 91
diff changeset
75 my $literal = $_->to_literal();
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
76 utf8::encode($literal);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
77 # warn $_->toString(1) , "\n";
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
78 return $literal unless wantarray;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
79 push( @$out, $literal);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
80 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
81 } else {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
82 Carp::croak("Unsupported data type");
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
83 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
84 # TODO
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
85 # XML::LibXML::Literal
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
86 # XML::LibXML::Boolean
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
87
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
88 return @$out;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
89 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
90
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
91 1;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
92
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
93 package Ikariam;
27
dd85b55eec2a implemented basic inference engine.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 26
diff changeset
94 use strict;
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
95 use Data::Dumper;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
96 use LWP;
154
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
97
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
98 use HTTP::Cookies;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
99 use WWW::Mechanize;
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
100 use XML::LibXML qw(:encoding);
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
101 use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
102 use POSIX;
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
103 use utf8;
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
104
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
105 sub new
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
106 {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
107 my ($class, $server, $user, $pass) = @_;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
108
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
109 my $self =
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
110 {
16
59f2c435760c implemented cached by timing.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 10
diff changeset
111 mech => WWW::Mechanize->new(
59f2c435760c implemented cached by timing.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 10
diff changeset
112 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
113 timeout => 10,
59f2c435760c implemented cached by timing.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 10
diff changeset
114 ),
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
115 server => $server,
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
116 user => $user,
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
117 pass => $pass,
117
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
118 debug => undef,
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
119 };
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
120
117
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
121 # if debug
179
8afd380c20ac do not fight with friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
122 LWP::Debug::level('+trace');
117
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
123
250
a654d43731f0 implement multi-thread Ikariam::Scanner
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 242
diff changeset
124 $self->{mech}->cookie_jar(HTTP::Cookies->new(file => "/tmp/ikariam-$server-cookies.txt", autosave => 1, ignore_discard => 1));
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
125 $self->{mech}->default_headers->push_header('Accept-Encoding', 'deflate');
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
126
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
127 return bless $self, $class;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
128 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
129
250
a654d43731f0 implement multi-thread Ikariam::Scanner
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 242
diff changeset
130 sub clone
a654d43731f0 implement multi-thread Ikariam::Scanner
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 242
diff changeset
131 {
a654d43731f0 implement multi-thread Ikariam::Scanner
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 242
diff changeset
132 my $self = shift;
a654d43731f0 implement multi-thread Ikariam::Scanner
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 242
diff changeset
133 my $copy = bless { %$self }, ref $self; # copy most fields
a654d43731f0 implement multi-thread Ikariam::Scanner
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 242
diff changeset
134
a654d43731f0 implement multi-thread Ikariam::Scanner
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 242
diff changeset
135 $copy;
a654d43731f0 implement multi-thread Ikariam::Scanner
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 242
diff changeset
136 }
a654d43731f0 implement multi-thread Ikariam::Scanner
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 242
diff changeset
137
98
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
138 sub viewAlly
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
139 {
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
140 my $self = shift;
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
141 my $allyId = shift;
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
142
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
143 my $res = $self->{mech}->get(sprintf("http://%s/index.php?view=allyPage&allyId=%d", $self->{server}, $allyId));
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
144 my $extractor = new Ikariam::Extractor(content => $res->content);
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
145
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
146 my %ally;
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
147 $ally{'id'} = $allyId;
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
148 $ally{'name'} = $extractor->find("//table[\@id='allyinfo']/tr[1]/td[2]/text()");
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
149 $ally{'members'} = $extractor->find("//table[\@id='allyinfo']/tr[2]/td[2]/text()");
240
937fc672df56 count by Ally's score
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 232
diff changeset
150 $ally{'score'} = $extractor->find("//table[\@id='allyinfo']/tr[4]/td[2]/text()");
937fc672df56 count by Ally's score
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 232
diff changeset
151 $ally{'score'} =~ s/\d+ \(([\d,]+)\)/$1/;
937fc672df56 count by Ally's score
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 232
diff changeset
152 $ally{'score'} =~ s/,//g;
937fc672df56 count by Ally's score
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 232
diff changeset
153
98
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
154 $ally{'url'} = $extractor->find("//table[\@id='allyinfo']/tr[5]/td[2]/text()");
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
155 delete($ally{'url'}) if($ally{'url'} eq '-');
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
156
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
157 return \%ally;
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
158 }
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
159
5
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
160 sub viewScore
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
161 {
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
162 my $self = shift;
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
163 my $type = shift || 'score';
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
164 my $user = shift || '';
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
165 my $offset = shift || 0;
91
53c87400183f rewrite viewScore with Extractor.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 88
diff changeset
166 my %users;
5
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
167
117
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
168 $self->{mech}->get(sprintf("http://%s/index.php?view=highscore&showMe=1", $self->{server}));
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
169 my $res = $self->{mech}->submit_form(
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
170 form_number => 1,
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
171 fields => {
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
172 highscoreType => $type,
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
173 offset => $offset,
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
174 searchUser => $user,
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
175 }
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
176 );
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
177
91
53c87400183f rewrite viewScore with Extractor.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 88
diff changeset
178 my $extractor = new Ikariam::Extractor(content => $res->content);
53c87400183f rewrite viewScore with Extractor.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 88
diff changeset
179 my $result = $extractor->{doc}->find('//table[@class="table01"][2]//tr');
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
180
91
53c87400183f rewrite viewScore with Extractor.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 88
diff changeset
181 foreach my $tr ( @$result ) {
5
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
182 my %user;
117
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
183 my $extractor = new Ikariam::Extractor(content => $tr->toString(0));
5
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
184
92
bcd2e32cfabb fixed the user name encoding issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 91
diff changeset
185 my $href = $extractor->find('//td[@class="action"]/a/@href');
91
53c87400183f rewrite viewScore with Extractor.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 88
diff changeset
186 if($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
187 $user{'id'} = $1;
117
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
188 # $user{'name'} = $user;
110
279a000eb3b0 fixed encoding issue of LibXML
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 106
diff changeset
189 # encoding issue.
279a000eb3b0 fixed encoding issue of LibXML
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 106
diff changeset
190 $user{'name'} = $extractor->find('//td[@class="name"]/text()');
117
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
191 next if($user{'name'} eq '');
92
bcd2e32cfabb fixed the user name encoding issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 91
diff changeset
192
bcd2e32cfabb fixed the user name encoding issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 91
diff changeset
193 $user{'ally'} = $extractor->find('//td[@class="allytag"]/a/text()');
bcd2e32cfabb fixed the user name encoding issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 91
diff changeset
194 my $allyHref = $extractor->find('//td[@class="allytag"]/a/@href');
98
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
195 if($allyHref =~ /\?view=allyPage&oldView=highscore&allyId=(\d+)/) {
5
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
196 $user{'allyId'} = $1;
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
197 }
92
bcd2e32cfabb fixed the user name encoding issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 91
diff changeset
198 $user{$type} = $extractor->find('//td[@class="score"]/text()');
19
9c52ae71c1cb fixed , in score
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 16
diff changeset
199 $user{$type} =~ s/,//g;
5
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
200 $users{$user{'id'}} = \%user;
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
201 }
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
202 }
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
203 # print(Dumper(\%users));
5
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
204 return \%users;
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
205 }
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
206
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
207 sub viewWorldMap
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
208 {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
209 my $self = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
210 my $x = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
211 my $y = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
212
88
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
213 if(!defined($x) && !defined($y)) {
1
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
214 die('location required');
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
215 }
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
216
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
217 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
218 xajax => 'getMapData',
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
219 'xajaxargs[]' => $x,
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
220 'xajaxargs[]' => $y,
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
221 xajaxr => time,
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
222 ]);
1
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
223
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
224 my $c;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
225 my $status = gunzip \$res->content => \$c
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
226 or die "gunzip failed: $GunzipError\n";
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
227
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
228 my @islands;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
229 # parsing xjxobj
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
230 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
231 {
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
232 my %island;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
233 $island{id} = $3;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
234 $island{x} = $1;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
235 $island{y} = $2;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
236 $island{name} = $6;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
237 $island{tradegood} = $4;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
238 $island{wonder} = $5;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
239 # $7 ?
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
240 $island{people} = $8;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
241 push @islands, \%island;
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
242 }
1
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
243 return @islands;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
244 }
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
245
3
b72786cdccbb fixed a typo
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 2
diff changeset
246 sub viewHomeMap
1
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
247 {
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
248 my $self = shift;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
249
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
250 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
251
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
252 my $c;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
253 my $status = gunzip \$res->content => \$c
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
254 or die "gunzip failed: $GunzipError\n";
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
255
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
256 # 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
257 # x = 43-57 = 6
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
258 # y = 27-41 = 6
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
259 my @islands;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
260 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
261 {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
262 my %island;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
263 $island{id} = $3;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
264 $island{x} = $1;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
265 $island{y} = $2;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
266 $island{name} = $6;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
267 $island{tradegood} = $4;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
268 $island{wonder} = $5;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
269 # $7 ?
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
270 $island{people} = $8;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
271
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
272 #foreach my $i (sort(keys(%island)))
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
273 #{
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
274 # printf ("%s %s\n", $i, $island{$i});
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
275 #}
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
276 #print("\n");
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
277 push @islands, \%island;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
278 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
279 return @islands;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
280 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
281
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
282 sub viewIsland
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
283 {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
284 my $self = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
285 my $island = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
286
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
287 my $res = $self->{mech}->get(sprintf("http://%s/index.php?view=island&id=%s", $self->{server}, $island));
88
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
288 my $extractor = new Ikariam::Extractor(content => $res->content);
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
289
88
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
290 my @cities;
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
291 foreach my $i (0..16) {
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
292 my $cityLocations = $extractor->find(sprintf('//li[@id="cityLocation%s"]/@class', $i));
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
293 if($cityLocations =~ /city level(\d+)/) {
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
294 my %info;
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
295 $info{'citylevel'} = $1;
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
296 $info{'cityname'} = $extractor->find(sprintf('//li[@id="cityLocation%s"]//li[@class="name"]/text()', $i));
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
297 $info{'owner'} = $extractor->find(sprintf('//li[@id="cityLocation%s"]//li[@class="owner"]/text()', $i));
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
298 $info{'owner'} =~ s/\s+//g;
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
299 $info{'ally'} = $extractor->find(sprintf('//li[@id="cityLocation%s"]//li[@class="ally"]/a/text()', $i));
117
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
300 if($info{'ally'} eq '-') {
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
301 delete($info{'ally'})
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
302 } else {
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
303 my $href = $extractor->find(sprintf('//li[@id="cityLocation%s"]//li[@class="ally"]/a/@href', $i));
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
304 if($href =~ /&allyId=(\d+)&/) {
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
305 $info{'allyId'} = $1;
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
306 }
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
307 }
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
308
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
309 # Ally Id
88
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
310 my $href = $extractor->find(sprintf('//li[@id="cityLocation%s"]//a[@class="messageSend"]/@href', $i));
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
311 if ($href =~ /with=(\d+)&destinationCityId=(\d+)/) {
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
312 $info{'user'} = $1;
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
313 $info{'cityId'} = $2;
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
314 } else {
183
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
315 # 聯盟 this is me.
88
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
316 my $id = $extractor->find(sprintf('//li[@id="cityLocation%s"]/a/@id', $i));
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
317 if($id =~ /city_(\d+)/) {
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
318 $info{'user'} = undef; # FIXME
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
319 $info{'cityId'} = $1;
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
320 }
10
f590b5ea5e55 fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 9
diff changeset
321 }
f590b5ea5e55 fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 9
diff changeset
322
88
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
323 if(defined(($extractor->find(sprintf('//li[@id="cityLocation%s"]//span[@class="vacation"]', $i)))[0])) {
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
324 $info{'status'} = 'v';
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
325 }
96
65c102183458 saved the status of inactivity player
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 92
diff changeset
326 if(defined(($extractor->find(sprintf('//li[@id="cityLocation%s"]//span[@class="inactivity"]', $i)))[0])) {
65c102183458 saved the status of inactivity player
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 92
diff changeset
327 $info{'status'} = 'i';
65c102183458 saved the status of inactivity player
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 92
diff changeset
328 }
88
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
329 push @cities, \%info;
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
330 } else {
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
331 # TODO: delete the old city.
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
332 }
10
f590b5ea5e55 fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 9
diff changeset
333
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
334 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
335
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
336 return @cities;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
337 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
338
54
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
339 sub increaseTransporter {
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
340 my $self = shift;
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
341 my $param = shift;
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
342 my $cityId = shift;
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
343
80
7ab5fc8c847c added some memo of TODO
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 79
diff changeset
344 # TODO: 應該扣除買船之黃金, 以免誤計
7ab5fc8c847c added some memo of TODO
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 79
diff changeset
345 # TODO: 加上所有之船隻
7ab5fc8c847c added some memo of TODO
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 79
diff changeset
346 # my @cargoCost = qw/160 244 396 812 1240 1272 1832 1888 3848 3972 5204 5384 6868 7120 8864 9200 11268 11712 14108 14680 23320 24288 28664 29880 34956 36468 42348 44212 51024 53308 61236 64024 73096 76468 87020 91088 103224 116524 122072 137432 180060 202132 211964 237444 249108 278276 292076 306623 321963 338138 355198 373191 392171 412195 433320 455612 479135 503962 530166 557828 587031 617863 650420 684802 721113 759466 799981 842783 888005 935790 986286 1039654 1096062 1155689 1218724 1285369 1355837 1430353 1509159 1592508 1680670 1773932 1872597 1976989 2087448 2204338 2328045 2458976 2597567 2744276 2899594 3064040 3238163 3422550 3617820 3824635 4043693 4275738 4521561 4782000 5057946 5350345 5660202 5988585 6336630 6705540 7096598 7511164 7950683 8416694 8910828 9434823 9990523 10579889 11205006 11868090 12571498 13317734 14109462 14949514/;
7ab5fc8c847c added some memo of TODO
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 79
diff changeset
347 # $city->{transporters}->{sum}
7ab5fc8c847c added some memo of TODO
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 79
diff changeset
348
7ab5fc8c847c added some memo of TODO
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 79
diff changeset
349 # TODO: 找買船最便宜之城市
54
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
350 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
351 foreach (1..2) {
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
352 if($locations[$_] eq 'port') {
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
353 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
354 $self->{server}, $cityId, $_));
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
355 }
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
356 }
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
357 }
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
358
183
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
359
173
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
360 # for tavern only
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
361 sub set {
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
362 my $self = shift;
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
363 my $type = shift;
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
364 my $cityId = shift;
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
365
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
366 die ("we don't know about this city") unless(defined($self->{'cities'}->{$cityId}));
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
367
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
368 my $position = -1;
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
369 my @locations = @{$self->{'cities'}->{$cityId}->{locations}};
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
370 foreach (0..$#locations) {
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
371 $position = $_ if($locations[$_] eq $type);
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
372 }
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
373
232
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
374 # Academy - inputScientists
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
375 if($position != -1 && $type eq 'academy') {
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
376 $self->{mech}->get (sprintf("http://%s/index.php?view=%s&id=%s&position=%d", $self->{server}, $type, $cityId, $position));
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
377 $self->{mech}->submit_form(
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
378 form_number => 1,
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
379 fields => {
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
380 s => $self->{'cities'}->{$cityId}->{$type}->{maxValue},
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
381 }
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
382 );
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
383
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
384 }
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
385
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
386 # Tavern
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
387 if($position != -1 && $type eq 'tavern') {
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
388 $self->{mech}->get (sprintf("http://%s/index.php?view=%s&id=%s&position=%d", $self->{server}, $type, $cityId, $position));
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
389 $self->{mech}->submit_form(
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
390 form_number => 1,
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
391 fields => {
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
392 amount => $self->{'cities'}->{$cityId}->{$type}->{maxValue},
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
393 }
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
394 );
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
395
173
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
396 }
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
397 }
e8a244ce5a1d update the tavern setting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 172
diff changeset
398
183
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
399 sub is_shipyard_upgrading {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
400 my $self = shift;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
401 my $cityId = shift;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
402 my $type = "shipyard";
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
403
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
404 my $position = -1;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
405 my @locations = @{$self->{'cities'}->{$cityId}->{locations}};
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
406 foreach (1..2) {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
407 $position = $_ if($locations[$_] eq $type);
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
408 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
409
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
410 if($position != -1) {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
411 my $res = $self->{mech}->get (sprintf("http://%s/index.php?view=%s&id=%s&position=%d", $self->{server}, $type, $cityId, $position));
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
412 if(defined(Ikariam::Extractor->new(content => $res->content)->find('//div[@class="isUpgrading"]'))) {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
413 return 1;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
414 } else {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
415 return 0;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
416 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
417 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
418 return 0;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
419 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
420
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
421 sub is_navy_trainning {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
422 my $self = shift;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
423 my $cityId = shift;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
424 my $type = "shipyard";
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
425
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
426 my $position = -1;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
427 my @locations = @{$self->{'cities'}->{$cityId}->{locations}};
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
428 foreach (1..2) {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
429 $position = $_ if($locations[$_] eq $type);
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
430 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
431
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
432 if($position != -1) {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
433 my $res = $self->{mech}->get (sprintf("http://%s/index.php?view=%s&id=%s&position=%d", $self->{server}, $type, $cityId, $position));
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
434 if(defined(Ikariam::Extractor->new(content => $res->content)->find('//div[@id="unitConstructionList"]//h4'))) {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
435 return 1;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
436 } else {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
437 return 0;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
438 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
439 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
440 # FIXME we can not found the shipyard
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
441 return 0;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
442 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
443
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
444 sub buildShips {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
445 my $self = shift;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
446 my $shipType = shift;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
447 my $cityId = shift;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
448 my $type = 'shipyard';
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
449
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
450 warn("buildShips $shipType");
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
451 my $position = -1;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
452 my @locations = @{$self->{'cities'}->{$cityId}->{locations}};
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
453 foreach (1..2) {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
454 $position = $_ if($locations[$_] eq $type);
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
455 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
456
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
457 if($position != -1) {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
458 my $res = $self->{mech}->get (sprintf("http://%s/index.php?view=%s&id=%s&position=%d", $self->{server}, $type, $cityId, $position));
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
459 $self->{mech}->submit_form(
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
460 form_number => 1,
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
461 fields => {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
462 $shipType => 1,
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
463 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
464 );
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
465 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
466 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
467
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
468 sub is_army_trainning {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
469 my $self = shift;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
470 my $cityId = shift;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
471 my $type = "barracks";
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
472
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
473 my $position = -1;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
474 my @locations = @{$self->{'cities'}->{$cityId}->{locations}};
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
475 foreach (2..$#locations) {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
476 $position = $_ if($locations[$_] eq $type);
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
477 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
478
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
479 if($position != -1) {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
480 my $res = $self->{mech}->get (sprintf("http://%s/index.php?view=%s&id=%s&position=%d", $self->{server}, $type, $cityId, $position));
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
481 if(defined(Ikariam::Extractor->new(content => $res->content)->find('//div[@id="unitConstructionList"]//h4'))) {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
482 return 1;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
483 } else {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
484 return 0;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
485 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
486 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
487 # FIXME we can not found the shipyard
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
488 return 0;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
489 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
490
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
491 sub is_barracks_upgrading {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
492 my $self = shift;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
493 my $cityId = shift;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
494 my $type = 'barracks';
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
495
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
496 my $position = -1;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
497 my @locations = @{$self->{'cities'}->{$cityId}->{locations}};
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
498 foreach (2..$#locations) {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
499 $position = $_ if($locations[$_] eq $type);
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
500 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
501
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
502 if($position != -1) {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
503 my $res = $self->{mech}->get (sprintf("http://%s/index.php?view=%s&id=%s&position=%d", $self->{server}, $type, $cityId, $position));
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
504 if(defined(Ikariam::Extractor->new(content => $res->content)->find('//div[@class="isUpgrading"]'))) {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
505 return 1;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
506 } else {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
507 return 0;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
508 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
509 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
510 return 0;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
511 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
512
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
513 sub buildUnits {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
514 my $self = shift;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
515 my $unitType = shift;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
516 my $cityId = shift;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
517 my $type = 'barracks';
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
518
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
519 warn("buildShips $unitType");
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
520 my $position = -1;
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
521 my @locations = @{$self->{'cities'}->{$cityId}->{locations}};
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
522 foreach (2..$#locations) {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
523 $position = $_ if($locations[$_] eq $type);
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
524 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
525
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
526 if($position != -1) {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
527 my $res = $self->{mech}->get (sprintf("http://%s/index.php?view=%s&id=%s&position=%d", $self->{server}, $type, $cityId, $position));
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
528 $self->{mech}->submit_form(
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
529 form_number => 1,
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
530 fields => {
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
531 $unitType => 1,
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
532 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
533 );
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
534 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
535 }
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
536
207
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
537 sub buildSpy {
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
538 my $self = shift;
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
539 my $unitType = shift;
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
540 my $cityId = shift;
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
541 my $type = 'safehouse';
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
542
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
543 my $position = -1;
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
544 my @locations = @{$self->{'cities'}->{$cityId}->{locations}};
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
545 foreach (2..$#locations) {
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
546 $position = $_ if($locations[$_] eq $type);
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
547 }
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
548
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
549 if($position != -1) {
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
550 my $res = $self->{mech}->get (sprintf("http://%s/index.php?view=%s&id=%s&position=%d", $self->{server}, $type, $cityId, $position));
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
551 my $url =
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
552 Ikariam::Extractor->new(content => $res->content)->find(sprintf('//div[@class="forminput"]/a/@href'));
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
553 $self->{mech}->get($url) if(defined($url));
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
554 }
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
555 }
48ea8222782a automatic build spys
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 205
diff changeset
556
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
557 sub build {
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
558 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
559 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
560 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
561
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
562 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
563
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
564 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
565 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
566 foreach (0..$#locations) {
54
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
567 $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
568 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
569
82
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
570 if($position == -1) {
200
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
571 my $targetPosition = undef;
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
572 if($type eq "wall") {
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
573 # 14 is wall.
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
574 $targetPosition = 14;
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
575 } else {
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
576 foreach (0..13) {
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
577 next if($_ <= 2 && ($type ne "workshop-fleet" &&
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
578 $type ne "shipyard"));
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
579
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
580 if($locations[$_] eq undef) {
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
581 $targetPosition = $_;
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
582 last;
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
583 }
54
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
584 }
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
585 }
200
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
586
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
587 my $res = $self->{mech}->get(sprintf('http://%s/index.php?view=buildingGround&id=%s&position=%s',
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
588 $self->{server}, $cityId, $targetPosition));
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
589 my $url =
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
590 Ikariam::Extractor->new(content => $res->content)->find(sprintf('//li[@class="building %s"]//a/@href', $type));
e9f111057392 fixed the build new building function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 197
diff changeset
591 $self->{mech}->get($url) if(defined($url));
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
592 } else {
82
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
593 my $res = $self->{mech}->get (sprintf("http://%s/index.php?view=%s&id=%s&position=%d", $self->{server}, $type, $cityId, $position));
83
ec087515da38 fixed a typo.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 82
diff changeset
594 my $url = Ikariam::Extractor->new(content => $res->content)->find('//a[@title="升級建築物"]/@href');
ec087515da38 fixed a typo.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 82
diff changeset
595 $self->{mech}->get($url) if(defined($url));
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
596 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
597 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
598
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
599 sub run {
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
600 my $self = shift;
84
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
601 my $param = shift;
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
602 # defense.
183
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
603 warn ("run $param not implemented yet.");
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
604 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
605
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
606 sub research
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
607 {
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
608 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
609 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
610 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
611
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
612 # 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
613 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
614 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
615
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
616 sub checkResearch {
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
617 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
618 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
619
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
620 my $res = $self->{mech}->get(sprintf('http://%s/index.php?view=researchOverview&id=%s', $self->{server}, $cityId));
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
621
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
622 my @urls = Ikariam::Extractor->new(content => $res->content)->find('//ul[@class="explored"]//a/@href');
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
623 my $out = {};
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
624 foreach(@urls) {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
625 if(/view=researchDetail&id=\d+&position=\d+&researchId=(\d+)$/) {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
626 # we ignore the chinese name of technology researched.
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
627 @$out{$1} = 1;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
628 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
629 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
630 return $out;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
631 }
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
632
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
633 sub plunderCity {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
634 my $self = shift;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
635 my $cityId = shift;
171
2efa901871e5 check peace treaty
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
636 my $res = $self->{mech}->get(sprintf("http://%s/index.php?view=plunder&destinationCityId=%d", $self->{server}, $cityId));
2efa901871e5 check peace treaty
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
637
242
5f6f845bbb1d check if the city still exist.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 240
diff changeset
638 my $extractor = Ikariam::Extractor->new(content => $res->content);
171
2efa901871e5 check peace treaty
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
639 # check peace treaty
242
5f6f845bbb1d check if the city still exist.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 240
diff changeset
640 my $treaty = $extractor->find('//div[@class="warning"]');
171
2efa901871e5 check peace treaty
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
641 if(!defined($treaty)) {
242
5f6f845bbb1d check if the city still exist.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 240
diff changeset
642 my @forms = $self->{mech}->forms();
5f6f845bbb1d check if the city still exist.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 240
diff changeset
643 if($#forms < 1) {
5f6f845bbb1d check if the city still exist.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 240
diff changeset
644 my $city = Ikariam::Cities->retrieve($cityId);
5f6f845bbb1d check if the city still exist.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 240
diff changeset
645 $city->delete;
5f6f845bbb1d check if the city still exist.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 240
diff changeset
646 } else {
5f6f845bbb1d check if the city still exist.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 240
diff changeset
647 $self->{mech}->submit_form(
5f6f845bbb1d check if the city still exist.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 240
diff changeset
648 form_number => 1,
5f6f845bbb1d check if the city still exist.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 240
diff changeset
649 fields => {
5f6f845bbb1d check if the city still exist.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 240
diff changeset
650 cargo_army_302 => '3', # 劍士
179
8afd380c20ac do not fight with friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
651 }
242
5f6f845bbb1d check if the city still exist.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 240
diff changeset
652 );
5f6f845bbb1d check if the city still exist.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 240
diff changeset
653 }
171
2efa901871e5 check peace treaty
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
654 } else {
179
8afd380c20ac do not fight with friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
655 # put the id in the friends.txt file.
8afd380c20ac do not fight with friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
656 Ikariam::Cities->has_a(user => 'Ikariam::User');
8afd380c20ac do not fight with friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
657 my $city = Ikariam::Cities->retrieve($cityId);
8afd380c20ac do not fight with friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
658 my $sheep = $city->user;
8afd380c20ac do not fight with friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
659
8afd380c20ac do not fight with friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
660 open(OUT, ">>friends.txt") or Carp::carp("can not open friends.txt");
8afd380c20ac do not fight with friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
661 print OUT $sheep->name . "\n";
8afd380c20ac do not fight with friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
662 close(OUT);
8afd380c20ac do not fight with friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
663 Carp::carp($treaty);
171
2efa901871e5 check peace treaty
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
664 }
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
665 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
666
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
667 sub changeCity {
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
668 my $self = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
669 my $cityId = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
670
84
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
671 $self->{mech}->get(sprintf("http://%s/index.php", $self->{server}));
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
672 $self->{mech}->submit_form(
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
673 form_number => 2,
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
674 fields => {
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
675 cityId => $cityId,
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
676 }
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
677 );
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
678 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
679
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
680 sub checkCity {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
681 my $self = shift;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
682 my $cityId = shift;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
683
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
684 $self->changeCity($cityId);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
685
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
686 my $res = $self->{mech}->get(sprintf("http://%s/index.php?view=city&id=%d", $self->{server}, $cityId));
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
687 my $extractor = new Ikariam::Extractor(content => $res->content);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
688
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
689 $self->{'cities'}->{$cityId}->{resources}->{gold} = $extractor->find('//span[@id="value_gold"]/text()');
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
690 $self->{'cities'}->{$cityId}->{resources}->{gold} =~ s/,//g;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
691
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
692 $self->{'cities'}->{$cityId}->{name} = $extractor->find('//span[@class="city"]/text()');
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
693
125
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
694 my $island = $extractor->find('//div[@id="breadcrumbs"]/a[@class="island"]');
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
695 if($island =~ /(\w+)\[(\d+):(\d+)\]/) {
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
696 $self->{'cities'}->{$cityId}->{island}->{name} = $1;
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
697 $self->{'cities'}->{$cityId}->{island}->{x} = $2;
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
698 $self->{'cities'}->{$cityId}->{island}->{y} = $3;
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
699 $self->{'cities'}->{$cityId}->{island}->{id} = my $island = $extractor->find('//div[@id="breadcrumbs"]/a[@class="island"]/@href');
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
700 $self->{'cities'}->{$cityId}->{island}->{id} =~ s/\?view=island&id=(\d+)/$1/;
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
701 }
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
702
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
703 $self->{'cities'}->{$cityId}->{construction} = defined($extractor->find('//*[@class="constructionSite"]')) ? 1 : 0;
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
704
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
705 # maxCapacity
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
706 my $page = $extractor->{doc}->toString(1);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
707 if($page =~ /maxCapacity : {\s+wood: (\d+),\s+wine: (\d+),\s+marble: (\d+),\s+crystal: (\d+),\s+sulfur: (\d+)\s+}/s) {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
708 $self->{'cities'}->{$cityId}->{maxCapacity}->{wood} = $1;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
709 $self->{'cities'}->{$cityId}->{maxCapacity}->{wine} = $2;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
710 $self->{'cities'}->{$cityId}->{maxCapacity}->{marble} = $3;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
711 $self->{'cities'}->{$cityId}->{maxCapacity}->{crystal} = $4;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
712 $self->{'cities'}->{$cityId}->{maxCapacity}->{sulfur} = $5;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
713 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
714
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
715 foreach my $good (qw/wood wine marble crystal sulfur/) {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
716 $self->{'cities'}->{$cityId}->{resources}->{$good} = $extractor->find(sprintf('//span[@id="value_%s"]', $good));
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
717 $self->{'cities'}->{$cityId}->{resources}->{$good} =~ s/,//g;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
718 }
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
719
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
720 foreach my $i (0..14) {
84
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
721 my @buildings = $extractor->find(sprintf('//li[@id="position%s"]/@class', $i));
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
722 foreach my $building (@buildings) {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
723 if (!($building =~ /buildingGround/) && !($building =~ /townhall/)) {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
724 $self->{'cities'}->{$cityId}->{locations}[$i] = $building;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
725
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
726 my $span;
84
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
727 my @spans = $extractor->find(sprintf('//li[@id="position%s"]//span[@class="textLabel"]/text()', $i));
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
728 if($#spans >= 1) {
81
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
729 $span = $spans[1];
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
730 } else {
81
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
731 $span = $spans[0];
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
732 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
733 my (undef, undef, $level) = split(/ /, $span);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
734 $self->{'cities'}->{$cityId}->{buildings}->{$building} = $level;
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
735 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
736 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
737 }
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
738
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
739 $self->{'cities'}->{$cityId}->{transporters}->{avail} = $extractor->find('//span[@id="value_transAvail"]/text()');
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
740 $self->{'cities'}->{$cityId}->{transporters}->{sum} = $extractor->find('//span[@id="value_transSum"]/text()');
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
741 $self->{'cities'}->{$cityId}->{transporters}->{sum} =~ s/[\(|\)]//g;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
742 $self->{'cities'}->{$cityId}->{maxActionPoints} = $extractor->find('//span[@id="value_maxActionPoints"]');;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
743 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
744
232
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
745 sub checkAcademy {
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
746 my $self = shift;
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
747 my $cityId = shift;
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
748 my $building = "academy";
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
749
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
750 my @locations = @{$self->{'cities'}->{$cityId}->{locations}};
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
751 # init
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
752 $self->{'cities'}->{$cityId}->{$building}->{'maxValue'} = 0;
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
753 $self->{'cities'}->{$cityId}->{$building}->{'iniValue'} = 0;
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
754 foreach (0..$#locations) {
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
755 if($locations[$_] eq $building) {
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
756 my $res = $self->{mech}->get(sprintf('http://%s/index.php?view=%s&id=%d&position=%d', $self->{server}, $building, $cityId, $_ ));
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
757 my $extractor = Ikariam::Extractor->new(content => $res->content);
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
758 if($extractor->{doc}->toString(0) =~ /maxValue : (\d+),\s+overcharge : \d+,\s+iniValue : (\d+),/) {
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
759 $self->{'cities'}->{$cityId}->{$building}->{'maxValue'} = $1;
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
760 $self->{'cities'}->{$cityId}->{$building}->{'iniValue'} = $2;
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
761 }
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
762 last;
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
763 }
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
764 }
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
765 }
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
766
172
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
767 sub checkTavern {
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
768 my $self = shift;
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
769 my $cityId = shift;
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
770
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
771 my @locations = @{$self->{'cities'}->{$cityId}->{locations}};
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
772 # init
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
773 $self->{'cities'}->{$cityId}->{'tavern'}->{'maxValue'} = 0;
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
774 $self->{'cities'}->{$cityId}->{'tavern'}->{'iniValue'} = 0;
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
775 foreach (0..$#locations) {
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
776 if($locations[$_] eq 'tavern') {
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
777 my $res = $self->{mech}->get(sprintf('http://%s/index.php?view=tavern&id=%d&position=%d', $self->{server}, $cityId, $_ ));
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
778 my $extractor = Ikariam::Extractor->new(content => $res->content);
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
779 if($extractor->{doc}->toString(0) =~ /maxValue : (\d+),\s+overcharge : \d+,\s+iniValue : (\d+),/) {
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
780 $self->{'cities'}->{$cityId}->{'tavern'}->{'maxValue'} = $1;
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
781 $self->{'cities'}->{$cityId}->{'tavern'}->{'iniValue'} = $2;
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
782 }
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
783 last;
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
784 }
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
785 }
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
786 }
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
787
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
788 sub checkMilitaryAdvisorMilitaryMovements {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
789 my $self = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
790 my $res = $self->{mech}->get(sprintf('http://%s/index.php?view=militaryAdvisorMilitaryMovements', $self->{server}));
81
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
791 my $extractor = new Ikariam::Extractor(content => $res->content);
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
792
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
793 $self->{'military'}->{wars} = 0;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
794 $self->{'military'}->{attack} = 0;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
795
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
796 foreach (qw/homeland elsewhere/) {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
797 $self->{'military'}->{$_} = ();
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
798 my $result = $extractor->{doc}->find(sprintf('//div[@id="%s"]//ul[@id="battleReports"]/li[@class="enroute"]', $_));
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
799 foreach my $div ( @$result ) {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
800 my $extractor = new Ikariam::Extractor(content => $div->toString(1));
106
31803acb9c5f fixed typo again
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 104
diff changeset
801 my $f = $extractor->find('//div[@class="report"]/a[1]/@href');
31803acb9c5f fixed typo again
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 104
diff changeset
802 my $t = $extractor->find('//div[@class="report"]/a[2]/@href');
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
803 $f = $1 if($f =~ /\?view=island&cityId=(\d+)/);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
804 $t = $1 if($t =~ /\?view=island&cityId=(\d+)/);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
805
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
806 push @{$self->{'military'}->{$_}}, { from => $f, to => $t};
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
807 if($_ eq 'homeland') {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
808 $self->{'military'}->{wars}++;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
809 } else {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
810 $self->{'military'}->{attack}++;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
811 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
812 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
813 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
814 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
815
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
816 sub checkMilitaryAdvisorReportView {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
817 my $self = shift;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
818 my $combatId = shift;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
819 my $res = $self->{mech}->get(sprintf('http://%s/index.php?view=militaryAdvisorReportView&detailedCombatId=%s', $self->{server}, $combatId));
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
820 my $extractor = new Ikariam::Extractor(content => $res->content);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
821
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
822 my %report;
81
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
823
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
824 $report{id} = $combatId;
205
d9f17bcbf1f1 we keep 10 transporters for prize
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 204
diff changeset
825 my $c = $extractor->{doc}->toString(0);
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
826
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
827 # FIXME 城鎮 6 級)的城牆( 2 級)為防禦部隊增加了 7% 的防禦力。
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
828 while($c =~ /城鎮\s+(\d+)/gs) {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
829 $report{cityLevel} = $1;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
830 $report{wallLevel} = $2;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
831 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
832
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
833 $report{attacker} = $extractor->find('//div[@id="troopsReport"]//table[@id="result"]//th[@class="attackers"]');
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
834 $report{defender} = $extractor->find('//div[@id="troopsReport"]//table[@id="result"]//th[@class="defenders"]');
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
835 $report{winner} = $extractor->find('//div[@id="troopsReport"]//table[@id="result"]//td[@class="winner"]');
81
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
836
150
fab1593cadf1 fixed the combat reading issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 148
diff changeset
837 # the combat we win!
147
7f9109a50679 trying to fixed report
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 146
diff changeset
838 $report{targetCity} = $extractor->find('//div[@id="troopsReport"]/div/h3/a/text()');
7f9109a50679 trying to fixed report
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 146
diff changeset
839 my $href = $extractor->find('//div[@id="troopsReport"]/div/h3/a/@href');
150
fab1593cadf1 fixed the combat reading issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 148
diff changeset
840 if(!defined($href)) {
fab1593cadf1 fixed the combat reading issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 148
diff changeset
841 # the combat we lost!
fab1593cadf1 fixed the combat reading issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 148
diff changeset
842 $report{targetCity} = $extractor->find('//td[@class="battle"]/a/text()');
fab1593cadf1 fixed the combat reading issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 148
diff changeset
843 $href = $extractor->find('//td[@class="battle"]/a/@href');
fab1593cadf1 fixed the combat reading issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 148
diff changeset
844 }
145
aad08889ddb3 hacked for s4.ikariam.tw
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 143
diff changeset
845
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
846 if($href =~ /index\.php\?view=island&id=(\d+)&selectCity=(\d+)/) {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
847 $report{island} = $1;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
848 $report{city} = $2;
129
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
849 } else {
150
fab1593cadf1 fixed the combat reading issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 148
diff changeset
850 warn($href);
143
bfa78302cf09 ignore some combat reports, which is not finished.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 129
diff changeset
851 warn ("can not read combat reprot $combatId");
bfa78302cf09 ignore some combat reports, which is not finished.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 129
diff changeset
852 return undef;
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
853 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
854 $report{gold} = $extractor->find('//div[@id="troopsReport"]//ul[@class="resources"]/li[@class="gold"]');
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
855 $report{wood} = $extractor->find('//div[@id="troopsReport"]//ul[@class="resources"]/li[@class="wood"]');
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
856 $report{crystal} = $extractor->find('//div[@id="troopsReport"]//ul[@class="resources"]/li[@class="glass"]');
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
857 $report{wine} = $extractor->find('//div[@id="troopsReport"]//ul[@class="resources"]/li[@class="wine"]');
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
858 $report{sulfur} = $extractor->find('//div[@id="troopsReport"]//ul[@class="resources"]/li[@class="sulfur"]');
81
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
859
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
860 foreach(qw/gold wood crystal wine sulfur attacker defender winner/) {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
861 $report{$_} =~ s/^.*?:\s+//;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
862 $report{$_} =~ s/\s+$//;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
863 $report{$_} =~ s/,//g;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
864 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
865 return \%report;
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
866 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
867
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
868 sub checkMilitaryAdvisorCombatReports {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
869 my $self = shift;
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
870 my $page = shift || 0;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
871
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
872 my $res = $self->{mech}->get(sprintf('http://%s/index.php?view=militaryAdvisorCombatReports&start=%s', $self->{server}, $page));
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
873 my $extractor = new Ikariam::Extractor(content => $res->content);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
874
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
875 my $result = $extractor->{doc}->find('//div[@id="troopsOverview"]//table/tr[position()<=10]');
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
876 foreach my $tr ( @$result ) {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
877 my $trExtractor = new Ikariam::Extractor(content => $tr->toString(1));
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
878 my $date = $trExtractor->find('//td[@class="date"]');
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
879 $date =~ s/^\s+//g; $date =~ s/\s+$//g;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
880
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
881
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
882 my $href = $trExtractor->find('//td/a/@href');
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
883 if($href =~ /index.php\?view=militaryAdvisorReportView&combatId=(\d+)/) {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
884 my $report = Ikariam::Report->retrieve($1);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
885 if(!$report) {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
886 my $report_hash = $self->checkMilitaryAdvisorReportView($1);
129
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
887 if(defined($report_hash)) {
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
888 $report = Ikariam::Report->insert($report_hash);
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
889
129
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
890 if($date =~ /(\d+)\.(\d+)\. (\d+):(\d+)/) {
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
891 my $unixtime = mktime (0, $4, $3, $1, ($2-1), '108');
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
892 $report->set('date', $unixtime);
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
893 }
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
894 $report->set('time', time);
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
895
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
896 $report->update();
143
bfa78302cf09 ignore some combat reports, which is not finished.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 129
diff changeset
897 } else {
bfa78302cf09 ignore some combat reports, which is not finished.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 129
diff changeset
898 # for some reason, we can not read the report.
bfa78302cf09 ignore some combat reports, which is not finished.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 129
diff changeset
899 next;
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
900 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
901 } else {
129
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
902 # we have found the report we like to know, exit the function.
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
903 return;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
904 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
905 } else {
129
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
906 # there is not report yet.
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
907 return;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
908 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
909 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
910
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
911 my @moreCombats = $extractor->find('//div[@id="troopsOverview"]//table/tr[position()>10]//a/@href');
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
912 foreach (@moreCombats){
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
913 last if(/^javascript/);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
914 if(/\?view=militaryAdvisorCombatReports&start=(\d+)/) {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
915 next if($1 le $page);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
916 $self->checkMilitaryAdvisorCombatReports($1);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
917 last;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
918 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
919 }
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
920 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
921
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
922 sub checkTownHall {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
923 my $self = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
924 my $cityId = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
925
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
926 my $res = $self->{mech}->get(sprintf('http://%s/index.php?view=townHall&id=%d', $self->{server}, $cityId));
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
927 my $extractor = new Ikariam::Extractor(content => $res->content);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
928
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
929 # //div[@id='SatisfactionOverview']//div[@class='value']
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
930 # //div[@id='SatisfactionOverview']//div[@class='text']
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
931 $self->{"cities"}->{$cityId}->{happiness} = $extractor->find('//div[@id="SatisfactionOverview"]//div[@class="value"]');
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
932
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
933 # 取 SatisfactionOverview 中的其他值
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
934 # 一個城鎮的市民滿意度結合了多方面的因素
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
935 # check happiness
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
936 # Happiness = Basic bonuses (196 + Capital Bonus + Holiday Bonus(25)) +
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
937 # Wine (Tavern Base(12*level) +
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
938 # Tavern Bonus(80*step)) +
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
939 # Culture (Museum Base(20*level) +
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
940 # Cultural Goods Bonus(50*Cultural Goods)) -
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
941 # Population (population) -
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
942 # Corruption (Corruption rate * population)
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
943 #
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
944 # Growth Rate = Happiness * 0.02
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
945
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
946 # Space, 房屋數
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
947 $self->{'cities'}->{$cityId}->{"space"} = {};
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
948 $self->{'cities'}->{$cityId}->{"space"}->{'total'} = $extractor->find('//span[@class="value total"]/text()');
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
949 $self->{'cities'}->{$cityId}->{"space"}->{'occupied'} = $extractor->find('//span[@class="value occupied"]/text()');
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
950
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
951 my @values = $extractor->find('//div[@id="CityOverview"]//span[@class="value"]');
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
952 $self->{'cities'}->{$cityId}->{"growth"} = $values[0];
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
953 $self->{'cities'}->{$cityId}->{"incomegold"} = $values[1];
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
954
100
ed6160630329 save actionPoints.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 98
diff changeset
955 my $actionPoints = $extractor->find('//div[@id="CityOverview"]//li[@class="actions"]/text()');
ed6160630329 save actionPoints.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 98
diff changeset
956 if($actionPoints =~ /(\d+)\/(\d+)/) {
ed6160630329 save actionPoints.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 98
diff changeset
957 $self->{'cities'}->{$cityId}->{actionPoints} = $1;
ed6160630329 save actionPoints.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 98
diff changeset
958 $self->{'cities'}->{$cityId}->{maxActionPoints} = $2;
ed6160630329 save actionPoints.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 98
diff changeset
959 }
ed6160630329 save actionPoints.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 98
diff changeset
960
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
961 $self->{'cities'}->{$cityId}->{corruption} = $extractor->find('//li[@class="corruption"]//span[@title="目前腐敗程度"]');
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
962 $self->{'cities'}->{$cityId}->{corruption} =~ s/%//g;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
963
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
964 my @citizens_type = qw/citizens woodworkers specialworkers scientists/;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
965 @values = $extractor->find('//div[@id="PopulationGraph"]//span[@class="count"]');
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
966 foreach my $i (0..$#citizens_type)
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
967 {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
968 $self->{'cities'}->{$cityId}->{'citizens'}->{$citizens_type[$i]} = $values[$i];
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
969 $self->{'cities'}->{$cityId}->{'citizens'}->{total} += $values[$i];
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
970 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
971 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
972
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
973 sub checkArmies
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
974 {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
975 my $self = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
976 my $cityId = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
977 my %force_types;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
978
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
979 $force_types{'army'} = [ qw/undef undef Slinger Swordsman Phalanx Ram Archer Catapult Gunsman Mortar SteamGiant Gyrocopter Bombardier Doctor Cook/ ];
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
980 $force_types{'fleet'} = [ qw/undef undef Ram-Ship BallistaShip Flamethrower CatapultShip MortarShip PaddleWheelRam DivingBoat/ ];
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
981
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
982 foreach my $x (qw/army fleet/) {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
983 $self->{'cities'}->{$cityId}->{$x} = {};
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
984 my $res = $self->{mech}->get(sprintf('http://%s/index.php?view=cityMilitary-%s&id=%d', $self->{server}, $x, $cityId));
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
985 my @numbers = Ikariam::Extractor->new(content => $res->content)->find('//table//tr/td');
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
986 foreach my $j (0..$#{$force_types{$x}}) {
87
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
987 next if(!defined($force_types{$x}[$j]));
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
988 if ($numbers[$j] == '-') {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
989 $self->{'cities'}->{$cityId}->{$x}->{$force_types{$x}[$j]} = 0;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
990 } else {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
991 $self->{'cities'}->{$cityId}->{$x}->{$force_types{$x}[$j]} = $numbers[$j];
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
992 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
993 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
994 }
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
995 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
996
154
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
997 sub checkFriends
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
998 {
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
999 # must check cities first, so we know if we have a museum available.
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1000 my $self = shift;
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1001
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1002 foreach my $cityId (keys(%{$self->{'cities'}})) {
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1003 my @locations = @{$self->{'cities'}->{$cityId}->{locations}};
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1004 foreach (0..$#locations) {
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1005 if($locations[$_] eq 'museum') {
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1006 my $res = $self->{mech}->get(sprintf('http://%s/index.php?view=museum&id=%d&position=%d', $self->{server}, $cityId, $_ ));
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1007 my @hrefs = Ikariam::Extractor->new(content => $res->content)->find('//div[@class="content"]/table/tbody/tr/td/a[1]/@href');
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1008 foreach my $href (@hrefs) {
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1009 if ($href =~ /&id=(\d+)&/) {
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1010 $self->{'friends'}->{$1} = undef;
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1011 }
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1012 }
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1013 last;
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1014 }
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1015 }
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1016 }
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1017
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1018 if(-f "friends.txt") {
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1019 # load friends
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1020 open(IN, "friends.txt") or die "Unable to open friends.txt\n";
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1021 while(<IN>) {
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1022 chomp;
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1023 my $friend = Ikariam::User->retrieve(name => $_);
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1024 $self->{friends}->{$friend->id} = undef if(defined($friend));
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1025 }
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1026 close(IN);
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1027 }
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1028 }
637314cc57ed checking for friends.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 150
diff changeset
1029
23
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
1030 sub check
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
1031 {
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
1032 my $self = shift;
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
1033
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
1034 # MilitaryAdvisor
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
1035 $self->checkMilitaryAdvisorMilitaryMovements();
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
1036 $self->checkMilitaryAdvisorCombatReports();
81
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
1037 $self->{'research'} = $self->checkResearch((keys(%{$self->{'cities'}}))[0]);
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
1038
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
1039 # alerts
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
1040 # //li[@id="advCities"]/a[@class="normalalert"]
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
1041 # //li[@id="advMilitary"]/a[@class="normalalert"]
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
1042 # //li[@id="advResearch"]/a[@class="normalalert"]
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
1043 # //li[@id="advDiplomacy"]/a[@class="normalalert"]
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
1044
26
d8117792c6f5 collecting more data from townHall
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 23
diff changeset
1045 # looking for cities
125
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
1046 foreach my $cityId (keys(%{$self->{'cities'}})) {
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
1047 $self->checkCity($cityId);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
1048 $self->checkTownHall($cityId);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
1049 $self->checkArmies($cityId);
172
ba03aa8abdb2 reading Tavern's infomration
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 154
diff changeset
1050 $self->checkTavern($cityId);
232
978a949602e5 Auto-update Scientists numbers for Academy.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 210
diff changeset
1051 $self->checkAcademy($cityId);
23
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
1052 }
197
dbdd7dcc91c6 fixed for friendly troop and corruption
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 195
diff changeset
1053 # $self->checkFriends();
26
d8117792c6f5 collecting more data from townHall
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 23
diff changeset
1054 return $self->{'cities'};
23
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
1055 }
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
1056
84
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1057 sub getNetIncome {
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1058 my $self = shift;
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1059 my $cityId = shift;
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1060
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1061 Carp::croak("must assign cityId") if !defined($cityId);
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1062
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1063 # 扣除研發每人花費 8 GOLD
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1064 return ($self->{cities}->{$cityId}->{citizens}->{total}*4 - $self->{cities}->{$cityId}->{citizens}->{scientists}*8 );
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1065 }
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1066
87
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1067 sub getNavyExpenditure {
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1068 my $self = shift;
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1069 my $cityId = shift;
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1070 my $cities = $self->{cities};
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1071
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1072 my $ships = {
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1073 CargoShip => {n => "CargoShip",a => 0,d => 0,s => 4,c => "Steamship",v => 20,A => 0,D => 0},
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1074 'Ram-Ship' => {n => "Ram-Ship",p => 6,w => 56,S => 21,b => "34m",u => 20,m => 1,o => 3,a => 16,d => 16,A => 4,D => 4,s => 10,c => "Sailer",v => 10},
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1075 BallistaShip => {n => "BallistaShip",p => 5,w => 72,S => 29,b => "47m",u => 24,m => 3,o => 5,a => 20,d => 28,A => 5,D => 7,s => 11,c => "Sailer",v => 8,x => "Resistance"},
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1076 Flamethrower => {n => "Flamethrower",p => 5,w => 105,S => 77,b => "1h 55m",u => 45,m => 5,o => 7,a => 40,d => 40,A => 10,D => 10,s => 12,c => "Steamship",v => 8,x => "Assault"},
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1077 CatapultShip => {n => "CatapultShip",p => 10,w => 173,S => 76,b => "3h 11m",u => 57,m => 7,o => 10,a => 60,d => 60,A => 12,D => 12,s => 16,c => "Sailer",v => 6},
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1078 MortarShip => {n => "MortarShip",p => 22,w => 456,S => 282,b => "3h 38m",u => 130,m => 12,o => 15,a => 160,d => 160,A => 35,D => 35,s => 14,c => "Steamship",v => 4},
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1079 PaddleWheelRam => {n => "PaddleWheelRam",i => "steamboat",p => 12,w => 513,S => 167,b => "4h 8m",u => 114,m => 10,o => 13,a => 100,d => 90,A => 20,D => 18,s => 13,c => "Steamship",v => 8,x => "Assault"},
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1080 DivingBoat => {n => "DivingBoat",i => "submarine",p => 16,w => 493,C => 378,b => "5h 5m",u => 126,m => 15,o => 16,a => 110,d => 155,A => 20,D => 30,s => 10,c => "Steamship",v => 2,x => "Resistance"}
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1081 };
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1082 my $cost = 0;
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1083 foreach(keys(%{$cities->{$cityId}->{fleet}})) {
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1084 $cost += $cities->{$cityId}->{fleet}->{$_} * $ships->{$_}->{u};
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1085 }
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1086 return $cost;
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1087 }
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
1088
86
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1089 sub getMilityExpenditure {
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1090 my $self = shift;
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1091 my $cityId = shift;
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1092 my $cities = $self->{cities};
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1093 my $troops = {
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1094 # p 需要人口
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1095 # w 木頭
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1096 # S 硫磺
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1097 # b 製造時間
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1098 # u 維持費用
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1099 # m 最低軍營等級
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1100 # o 最佳軍營等級
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1101 # a 攻擊力
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1102 # d 防守力
210
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1103 # A 攻擊力加成
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1104 # D 防守力加成
86
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1105 # s 耐力
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1106 # c 種類
210
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1107 # v Speed
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1108 # x 攻防加成 Assault, Resistance
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1109 Slinger => {n => "Slinger", p => 1, w => 40, b => "12m", u => 8, m => 1, o => 4, a => 7, d => 6, A => 2, D => 2, s => 10, c => "Human", v => 20},
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1110 Swordsman => {n => "Swordsman", p => 2, w => 47, S => 16, b => "17m", u => 16, m => 3, o => 5, a => 18, d => 14, A => 4, D => 3, s => 12, c => "Human", v => 20, x => "Assault"},
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1111 Phalanx => {n => "Phalanx", p => 4, w => 104, S => 64, b => "40m", u => 24, m => 4, o => 7, a => 24, d => 40, A => 6, D => 10, s => 14, c => "Human", v => 20, x => "Resistance"},
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1112 Ram => {n => "Ram", p => 8, w => 198, S => 128, b => "42m", u => 52, m => 5, o => 8, a => 14, d => 18, A => 3, D => 4, s => 16, c => "Machina", v => 20, x => "Ram"},
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1113 Archer => {n => "Archer", p => 4, w => 172, S => 86, b => "49m", u => 32, m => 7, o => 10, a => 40, d => 40, A => 10, D => 10, s => 12, c => "Human", v => 20},
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1114 Catapult => {n => "Catapult", p => 10, w => 342, S => 232, b => "49m", u => 72, m => 10, o => 14, a => 36, d => 28, A => 9, D => 7, s => 16, c => "Machina", v => 20, x => "Ram"},
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1115 Gunsman => {n => "Gunsman", i => "marksman", p => 7, w => 355, S => 154, b => "1h 23m", u => 58, m => 14, o => 18, a => 80, d => 64, A => 18, D => 14, s => 10, c => "Human", v => 20},
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1116 Mortar => {n => "Mortar", p => 12, w => 1325, S => 938, b => "1h 53m", u => 128, m => 19, o => 21, a => 64, d => 64, A => 15, D => 15, s => 16, c => "Machina", v => 20, x => "Ram"},
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1117 SteamGiant => {n => "SteamGiant", i => "steamgiant", p => 6, w => 1150, S => 716, b => "1h 45m", u => 68, m => 16, o => 20, a => 100, d => 140, A => 20, D => 30, s => 14, c => "Machina", v => 20, x => "Resistance"},
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1118 Gyrocopter => {n => "Gyrocopter", p => 8, w => 1250, S => 670, b => "1h 2m", u => 97, m => 12, o => 16, a => 112, d => 112, A => 25, D => 25, s => 12, c => "Machina", v => 20},
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1119 Bombardier => {n => "Bombardier", p => 24, w => 2270, S => 878, b => "2h 10m", u => 228, m => 22, o => 24, a => 200, d => 165, A => 45, D => 35, s => 14, c => "Machina", v => 20, x => "Assault"},
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1120 Doctor => {n => "Doctor", i => "medic", p => 6, w => 640, C => 361, b => "1h 2m", u => 244, m => 11, o => 12, a => 4, d => 28, A => 0, D => 0, s => 14, c => "Human", v => 20, x => "Healer"},
a5862d3f1c84 fixed build_barracks and build_shipyard
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 207
diff changeset
1121 Cook => {n => "Cook", p => 4, w => 520, W => 103, b => "38m", u => 138, m => 8, o => 8, a => 6, d => 26, A => 0, D => 0, s => 16, c => "Human", v => 20, x => "Regeneration"}
86
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1122 };
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1123
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1124 my $cost = 0;
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1125 foreach(keys(%{$cities->{$cityId}->{army}})) {
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1126 $cost += $cities->{$cityId}->{army}->{$_} * $troops->{$_}->{u};
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1127 }
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1128 return $cost;
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1129 }
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1130
84
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1131 sub blanceHurmanResource {
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1132 my $self = shift;
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1133 my $cityId = shift;
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1134 my $workersRatio = {
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1135 'citizens' => 0.4,
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1136 'specialworkers' => 0.3,
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1137 'woodworkers' => 0.7,
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1138 };
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1139
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1140 my $netincome = $self->getNetIncome($cityId);
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1141
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1142 # --- HR ---
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1143 # 扣除研發,四成種田生產,剩下 3:7 挖資源
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1144 # 四成收入中可用兩成做軍事用途
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1145 # 生產共四成
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1146 my $produceworkers = int(($netincome * $workersRatio->{citizens}) / 4);
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1147
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1148 # 換成生產人力
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1149 my $freePeople = $self->{cities}->{$cityId}->{citizens}->{total} - ($produceworkers + $self->{cities}->{$cityId}->{scientists});
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1150
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1151 # XXX
86
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1152 # 需計算資源開挖上限, 依照島等級區分
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1153 # 木頭
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1154 # create_slider({
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1155 # dir : 'ltr',
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1156 # id : "default",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1157 # maxValue : 367,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1158 # overcharge : 0,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1159 # iniValue : 367,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1160 # bg : "sliderbg",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1161 # thumb : "sliderthumb",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1162 # topConstraint: -10,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1163 # bottomConstraint: 344,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1164 # bg_value : "actualValue",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1165 # bg_overcharge : "overcharge",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1166 # textfield:"inputWorkers"
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1167 # });
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1168
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1169 # create_slider({
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1170 # dir : 'ltr',
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1171 # id : "default",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1172 # maxValue : 367,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1173 # overcharge : 0,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1174 # iniValue : 367,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1175 # bg : "sliderbg",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1176 # thumb : "sliderthumb",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1177 # topConstraint: -10,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1178 # bottomConstraint: 344,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1179 # bg_value : "actualValue",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1180 # bg_overcharge : "overcharge",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1181 # textfield:"inputWorkers"
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1182 # });
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1183
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
1184 Carp::carp(sprintf("Suggested HR palnning - produce: %s wood %s special %s\n", $produceworkers, int($freePeople*0.3), int($freePeople*0.7)));
84
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1185 }
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
1186
9
ae412d1f7761 added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 8
diff changeset
1187 sub logout
ae412d1f7761 added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 8
diff changeset
1188 {
ae412d1f7761 added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 8
diff changeset
1189 my $self = shift;
ae412d1f7761 added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 8
diff changeset
1190 $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
1191 }
ae412d1f7761 added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 8
diff changeset
1192
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
1193 sub login
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
1194 {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
1195 my $self = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
1196
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
1197 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
1198 name => $self->{user},
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
1199 password => $self->{pass},
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
1200 ]);
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
1201
82
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
1202 my @cities = Ikariam::Extractor->new(content => $res->content)->find('//option[@class="avatarCities coords"]/@value');
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
1203
82
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
1204 if($#cities<0) {
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
1205 die ("login failed\n");
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
1206 }
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
1207 foreach(@cities) {
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
1208 $self->{'cities'}->{$_} = {};
183
2362c8c8909e implemented military builder.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 174
diff changeset
1209 $self->{'cities'}->{$_}->{id} = $_;
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
1210 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
1211 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
1212
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
1213
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
1214 1;