annotate Ikariam.pm @ 142:9b8aa30a532c

counting members by ally
author "Rex Tsai <chihchun@kalug.linux.org.tw>"
date Fri, 31 Oct 2008 10:53:14 +0800
parents 3756298f8e4b
children bfa78302cf09
rev   line source
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
1 #!/usr/bin/env perl
41
5849b6fdc76c removed my password from scripts.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 37
diff changeset
2 BEGIN {
48
96ee35378696 modified for searching configuration files
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 41
diff changeset
3 foreach (((getpwuid($<))[7], $ENV{HOME}, $ENV{LOGDIR}, ".")) {
96ee35378696 modified for searching configuration files
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 41
diff changeset
4 require "$_/.eagleeye.pm" if (-f "$_/.eagleeye.pm");
96ee35378696 modified for searching configuration files
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 41
diff changeset
5 }
41
5849b6fdc76c removed my password from scripts.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 37
diff changeset
6 }
2
0fb73a7a0b94 ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 1
diff changeset
7
0fb73a7a0b94 ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 1
diff changeset
8 use Class::DBI::AutoLoader (
0fb73a7a0b94 ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 1
diff changeset
9 dsn => 'dbi:SQLite:dbname=ikariam.sqlite',
0fb73a7a0b94 ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 1
diff changeset
10 options => { RaiseError => 1 },
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
11 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
12 use_base => 'Class::DBI::SQLite',
0fb73a7a0b94 ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 1
diff changeset
13 namespace => 'Ikariam',
0fb73a7a0b94 ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 1
diff changeset
14 );
0fb73a7a0b94 ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 1
diff changeset
15
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
16 package Ikariam::Extractor;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
17 use strict;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
18 use Data::Dumper;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
19 use XML::LibXML;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
20 use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
21 use Carp;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
22 use utf8;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
23
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
24 sub new {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
25 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
26
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
27 my($class, %conf) = @_;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
28
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
29 my $self = bless {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
30 doc => undef,
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
31 gzip => 1,
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
32 }, $class;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
33
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
34 $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
35 $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
36
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
37 return $self;
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
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
40 # parse($Content);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
41 sub parse {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
42 my ($self, $content) = @_;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
43 my $string;
110
279a000eb3b0 fixed encoding issue of LibXML
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 106
diff changeset
44 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
45
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
46 if($self->{gzip} == 1) {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
47 gunzip \$content => \$string
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
48 or die "gunzip failed: $GunzipError\n";
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
49 } else {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
50 $string = $content;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
51 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
52
117
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
53 # 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
54 $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
55
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
56 $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
57 return;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
58 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
59
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
60 # find($XPathQuery);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
61 sub find {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
62 my $self = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
63 my $query = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
64 my $out = [];
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 my $result = $self->{doc}->find($query);
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 return undef unless defined($result);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
69
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
70 if ( $result->isa( 'XML::LibXML::NodeList' ) ) {
81
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
71 return () if($result->size() == 0);
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
72 foreach ( @$result ) {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
73 # $_ 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
74 my $literal = $_->to_literal();
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
75 utf8::encode($literal);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
76 # warn $_->toString(1) , "\n";
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
77 return $literal unless wantarray;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
78 push( @$out, $literal);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
79 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
80 } else {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
81 Carp::croak("Unsupported data type");
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
82 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
83 # TODO
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
84 # XML::LibXML::Literal
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
85 # XML::LibXML::Boolean
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
86
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
87 return @$out;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
88 }
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 1;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
91
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
92 package Ikariam;
27
dd85b55eec2a implemented basic inference engine.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 26
diff changeset
93 use strict;
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
94 use Data::Dumper;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
95 use LWP;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
96 use HTTP::Cookies;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
97 use WWW::Mechanize;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
98 use HTML::TagParser;
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
99 use XML::LibXML qw(:encoding);
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
100 use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
101 use POSIX;
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
102 use utf8;
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
103
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
104 sub new
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
105 {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
106 my ($class, $server, $user, $pass) = @_;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
107
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
108 my $self =
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
109 {
16
59f2c435760c implemented cached by timing.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 10
diff changeset
110 mech => WWW::Mechanize->new(
59f2c435760c implemented cached by timing.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 10
diff changeset
111 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
112 timeout => 10,
59f2c435760c implemented cached by timing.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 10
diff changeset
113 ),
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
114 server => $server,
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
115 user => $user,
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
116 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
117 debug => undef,
54
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
118 buildingIDs => {
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
119 townHall => 0,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
120 townhall => 0,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
121 port => 3,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
122 academy => 4,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
123 shipyard => 5,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
124 barracks => 6,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
125 warehouse => 7,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
126 wall => 8,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
127 tavern => 9,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
128 museum => 10,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
129 palace => 11,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
130 embassy => 12,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
131 branchOffice => 13,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
132 workshop => 15,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
133 'workshop-army' => 15,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
134 'workshop-fleet' => 15,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
135 safehouse => 16,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
136 palaceColony => 17,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
137 resource => 1,
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
138 tradegood => 2
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
139 }
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
140 };
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
141
54
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
142
117
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
143 # if debug
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
144 # LWP::Debug::level('+conns');
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
145
26
d8117792c6f5 collecting more data from townHall
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 23
diff changeset
146 $self->{mech}->cookie_jar(HTTP::Cookies->new(file => "/tmp/ikariam-cookies.txt", autosave => 1));
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
147 $self->{mech}->default_headers->push_header('Accept-Encoding', 'deflate');
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
148
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
149 return bless $self, $class;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
150 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
151
98
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
152 sub viewAlly
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
153 {
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
154 my $self = shift;
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
155 my $allyId = shift;
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 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
158 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
159
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
160 my %ally;
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
161 $ally{'id'} = $allyId;
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
162 $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
163 $ally{'members'} = $extractor->find("//table[\@id='allyinfo']/tr[2]/td[2]/text()");
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
164 $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
165 delete($ally{'url'}) if($ally{'url'} eq '-');
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
166
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
167 return \%ally;
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
168 }
34749e907405 we now scan for ally
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 96
diff changeset
169
5
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
170 sub viewScore
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
171 {
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
172 my $self = shift;
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
173 my $type = shift || 'score';
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
174 my $user = shift || '';
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
175 my $offset = shift || 0;
91
53c87400183f rewrite viewScore with Extractor.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 88
diff changeset
176 my %users;
5
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
177
117
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
178 $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
179 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
180 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
181 fields => {
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
182 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
183 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
184 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
185 }
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
186 );
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
187
91
53c87400183f rewrite viewScore with Extractor.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 88
diff changeset
188 my $extractor = new Ikariam::Extractor(content => $res->content);
53c87400183f rewrite viewScore with Extractor.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 88
diff changeset
189 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
190
91
53c87400183f rewrite viewScore with Extractor.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 88
diff changeset
191 foreach my $tr ( @$result ) {
5
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
192 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
193 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
194
92
bcd2e32cfabb fixed the user name encoding issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 91
diff changeset
195 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
196 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
197 $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
198 # $user{'name'} = $user;
110
279a000eb3b0 fixed encoding issue of LibXML
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 106
diff changeset
199 # encoding issue.
279a000eb3b0 fixed encoding issue of LibXML
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 106
diff changeset
200 $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
201 next if($user{'name'} eq '');
92
bcd2e32cfabb fixed the user name encoding issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 91
diff changeset
202
bcd2e32cfabb fixed the user name encoding issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 91
diff changeset
203 $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
204 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
205 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
206 $user{'allyId'} = $1;
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
207 }
92
bcd2e32cfabb fixed the user name encoding issue.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 91
diff changeset
208 $user{$type} = $extractor->find('//td[@class="score"]/text()');
19
9c52ae71c1cb fixed , in score
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 16
diff changeset
209 $user{$type} =~ s/,//g;
5
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
210 $users{$user{'id'}} = \%user;
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
211 }
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
212 }
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
213 # print(Dumper(\%users));
5
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
214 return \%users;
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
215 }
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
216
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
217 sub viewWorldMap
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
218 {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
219 my $self = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
220 my $x = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
221 my $y = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
222
88
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
223 if(!defined($x) && !defined($y)) {
1
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
224 die('location required');
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
225 }
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
226
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
227 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
228 xajax => 'getMapData',
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
229 'xajaxargs[]' => $x,
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
230 'xajaxargs[]' => $y,
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
231 xajaxr => time,
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
232 ]);
1
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
233
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
234 my $c;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
235 my $status = gunzip \$res->content => \$c
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
236 or die "gunzip failed: $GunzipError\n";
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
237
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
238 my @islands;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
239 # parsing xjxobj
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
240 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
241 {
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
242 my %island;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
243 $island{id} = $3;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
244 $island{x} = $1;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
245 $island{y} = $2;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
246 $island{name} = $6;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
247 $island{tradegood} = $4;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
248 $island{wonder} = $5;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
249 # $7 ?
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
250 $island{people} = $8;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
251 push @islands, \%island;
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
252 }
1
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
253 return @islands;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
254 }
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
255
3
b72786cdccbb fixed a typo
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 2
diff changeset
256 sub viewHomeMap
1
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
257 {
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
258 my $self = shift;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
259
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
260 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
261
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
262 my $c;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
263 my $status = gunzip \$res->content => \$c
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
264 or die "gunzip failed: $GunzipError\n";
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
265
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
266 # 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
267 # x = 43-57 = 6
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
268 # y = 27-41 = 6
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
269 my @islands;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
270 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
271 {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
272 my %island;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
273 $island{id} = $3;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
274 $island{x} = $1;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
275 $island{y} = $2;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
276 $island{name} = $6;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
277 $island{tradegood} = $4;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
278 $island{wonder} = $5;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
279 # $7 ?
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
280 $island{people} = $8;
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 #foreach my $i (sort(keys(%island)))
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 # printf ("%s %s\n", $i, $island{$i});
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
285 #}
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
286 #print("\n");
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
287 push @islands, \%island;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
288 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
289 return @islands;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
290 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
291
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
292 sub viewIsland
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
293 {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
294 my $self = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
295 my $island = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
296
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
297 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
298 my $extractor = new Ikariam::Extractor(content => $res->content);
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
299
88
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
300 my @cities;
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
301 foreach my $i (0..16) {
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
302 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
303 if($cityLocations =~ /city level(\d+)/) {
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
304 my %info;
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
305 $info{'citylevel'} = $1;
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
306 $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
307 $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
308 $info{'owner'} =~ s/\s+//g;
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
309 $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
310 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
311 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
312 } else {
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
313 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
314 # http://s2.ikariam.tw/index.php?view=allyPage&allyId=264&oldView=island&id=569
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
315 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
316 $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
317 }
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
318 }
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
319
5a66fea952fe implemented a dirty hack to fixed the stupid highscore search function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 110
diff changeset
320 # Ally Id
10
f590b5ea5e55 fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 9
diff changeset
321
88
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
322 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
323 # ?view=sendMessage&type=0&with=20204&destinationCityId=64165&oldView=island
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
324 if ($href =~ /with=(\d+)&destinationCityId=(\d+)/) {
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
325 $info{'user'} = $1;
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
326 $info{'cityId'} = $2;
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
327 # ?view=sendAllyMessage&allyId=1192&oldView=island&id=721
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
328 } else {
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
329 # 聯盟
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
330 # this is me.
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
331 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
332 if($id =~ /city_(\d+)/) {
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
333 $info{'user'} = undef; # FIXME
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
334 $info{'cityId'} = $1;
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
335 }
10
f590b5ea5e55 fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 9
diff changeset
336 }
f590b5ea5e55 fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 9
diff changeset
337
88
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
338 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
339 $info{'status'} = 'v';
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
340 }
96
65c102183458 saved the status of inactivity player
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 92
diff changeset
341 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
342 $info{'status'} = 'i';
65c102183458 saved the status of inactivity player
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 92
diff changeset
343 }
88
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
344 push @cities, \%info;
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
345 } else {
0fa9cd836e1e rewrited the viewIsland function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 87
diff changeset
346 # TODO: delete the old city.
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
347 }
10
f590b5ea5e55 fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 9
diff changeset
348
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
349 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
350
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
351 return @cities;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
352 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
353
54
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
354 sub increaseTransporter {
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
355 my $self = shift;
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
356 my $param = shift;
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
357 my $cityId = shift;
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
358
80
7ab5fc8c847c added some memo of TODO
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 79
diff changeset
359 # TODO: 應該扣除買船之黃金, 以免誤計
7ab5fc8c847c added some memo of TODO
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 79
diff changeset
360 # TODO: 加上所有之船隻
7ab5fc8c847c added some memo of TODO
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 79
diff changeset
361 # 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
362 # $city->{transporters}->{sum}
7ab5fc8c847c added some memo of TODO
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 79
diff changeset
363
7ab5fc8c847c added some memo of TODO
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 79
diff changeset
364 # TODO: 找買船最便宜之城市
54
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
365 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
366 foreach (1..2) {
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
367 if($locations[$_] eq 'port') {
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
368 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
369 $self->{server}, $cityId, $_));
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
370 }
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
371 }
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
372 }
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
373
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
374 sub build {
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
375 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
376 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
377 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
378
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
379 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
380
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
381 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
382 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
383 foreach (0..$#locations) {
54
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
384 $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
385 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
386
82
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
387 if($position == -1) {
54
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
388 foreach (0..$#locations) {
82
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
389 # XXX
54
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
390 next if($_ <= 2 && ($self->{buildingIDs}->{$type} ne "workshop-fleet" &&
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
391 $self->{buildingIDs}->{$type} ne "shipyard"));
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
392 if($locations[$_] eq undef) {
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
393 my $res = $self->{mech}->get(sprintf('http://%s/index.php?action=CityScreen&function=build&id=%s&position=%s&building=%d',
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
394 $self->{server}, $cityId, $_, $self->{buildingIDs}->{$type} ));
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
395 last;
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
396 }
2d3c394b7940 rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 52
diff changeset
397 }
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
398 } else {
82
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
399 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
400 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
401 $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
402 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
403 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
404
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
405 sub run {
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
406 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
407 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
408 # defense.
84
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
409 die("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
410 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
411
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
412 sub research
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
413 {
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
414 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
415 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
416 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
417
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
418 # 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
419 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
420 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
421
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
422 sub checkResearch {
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
423 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
424 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
425
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
426 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
427
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
428 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
429 my $out = {};
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
430 foreach(@urls) {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
431 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
432 # 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
433 @$out{$1} = 1;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
434 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
435 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
436 return $out;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
437 }
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
438
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
439 sub plunderCity {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
440 my $self = shift;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
441 my $cityId = shift;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
442 $self->{mech}->get(sprintf("http://%s/index.php?view=plunder&destinationCityId=%d", $self->{server}, $cityId));
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
443 $self->{mech}->submit_form(
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
444 form_number => 1,
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
445 fields => {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
446 cargo_army_302 => '2',
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
447 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
448 );
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
449 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
450
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
451 sub changeCity {
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
452 my $self = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
453 my $cityId = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
454
84
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
455 $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
456 $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
457 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
458 fields => {
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
459 cityId => $cityId,
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
460 }
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
461 );
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
462 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
463
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
464 sub checkCity {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
465 my $self = shift;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
466 my $cityId = shift;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
467
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
468 $self->changeCity($cityId);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
469
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
470 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
471 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
472
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
473 $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
474 $self->{'cities'}->{$cityId}->{resources}->{gold} =~ s/,//g;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
475
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
476 $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
477
125
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
478 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
479 if($island =~ /(\w+)\[(\d+):(\d+)\]/) {
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
480 $self->{'cities'}->{$cityId}->{island}->{name} = $1;
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
481 $self->{'cities'}->{$cityId}->{island}->{x} = $2;
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
482 $self->{'cities'}->{$cityId}->{island}->{y} = $3;
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
483 $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
484 $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
485 }
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
486
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
487 $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
488
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
489 # maxCapacity
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
490 my $page = $extractor->{doc}->toString(1);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
491 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
492 $self->{'cities'}->{$cityId}->{maxCapacity}->{wood} = $1;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
493 $self->{'cities'}->{$cityId}->{maxCapacity}->{wine} = $2;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
494 $self->{'cities'}->{$cityId}->{maxCapacity}->{marble} = $3;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
495 $self->{'cities'}->{$cityId}->{maxCapacity}->{crystal} = $4;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
496 $self->{'cities'}->{$cityId}->{maxCapacity}->{sulfur} = $5;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
497 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
498
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
499 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
500 $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
501 $self->{'cities'}->{$cityId}->{resources}->{$good} =~ s/,//g;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
502 }
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
503
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
504 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
505 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
506 foreach my $building (@buildings) {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
507 if (!($building =~ /buildingGround/) && !($building =~ /townhall/)) {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
508 $self->{'cities'}->{$cityId}->{locations}[$i] = $building;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
509
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
510 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
511 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
512 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
513 $span = $spans[1];
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
514 } else {
81
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
515 $span = $spans[0];
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
516 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
517 my (undef, undef, $level) = split(/ /, $span);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
518 $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
519 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
520 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
521 }
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
522
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
523 $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
524 $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
525 $self->{'cities'}->{$cityId}->{transporters}->{sum} =~ s/[\(|\)]//g;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
526 $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
527 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
528
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
529
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
530 sub checkMilitaryAdvisorMilitaryMovements {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
531 my $self = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
532 # TODO
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
533 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
534 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
535
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
536 $self->{'military'}->{wars} = 0;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
537 $self->{'military'}->{attack} = 0;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
538
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
539 foreach (qw/homeland elsewhere/) {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
540 $self->{'military'}->{$_} = ();
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
541 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
542 foreach my $div ( @$result ) {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
543 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
544 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
545 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
546 $f = $1 if($f =~ /\?view=island&cityId=(\d+)/);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
547 $t = $1 if($t =~ /\?view=island&cityId=(\d+)/);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
548
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
549 push @{$self->{'military'}->{$_}}, { from => $f, to => $t};
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
550 if($_ eq 'homeland') {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
551 $self->{'military'}->{wars}++;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
552 } else {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
553 $self->{'military'}->{attack}++;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
554 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
555 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
556 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
557 # print(Dumper($self->{'military'}));
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
558 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
559
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
560 sub checkMilitaryAdvisorReportView {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
561 my $self = shift;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
562 my $combatId = shift;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
563 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
564 my $extractor = new Ikariam::Extractor(content => $res->content);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
565
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
566 my %report;
81
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
567
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
568 $report{id} = $combatId;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
569 my $c = $extractor->{doc}->toString(1);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
570
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
571 # FIXME 城鎮 6 級)的城牆( 2 級)為防禦部隊增加了 7% 的防禦力。
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
572 while($c =~ /城鎮\s+(\d+)/gs) {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
573 $report{cityLevel} = $1;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
574 $report{wallLevel} = $2;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
575 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
576
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
577 $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
578 $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
579 $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
580
129
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
581 # $report{targetCity} = $extractor->find('//div[@id="troopsReport"]/div/h3/a/text()');
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
582 # my $href = $extractor->find('//div[@id="troopsReport"]/div/h3/a/@href');
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
583 $report{targetCity} = $extractor->find('//td[@class="battle"]/a/text()');
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
584 my $href = $extractor->find('//td[@class="battle"]/a/@href');
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
585 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
586 $report{island} = $1;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
587 $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
588 } else {
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
589 die ($href);
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
590 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
591 $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
592 $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
593 $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
594 $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
595 $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
596
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
597 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
598 $report{$_} =~ s/^.*?:\s+//;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
599 $report{$_} =~ s/\s+$//;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
600 $report{$_} =~ s/,//g;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
601 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
602 return \%report;
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
603 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
604
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
605 sub checkMilitaryAdvisorCombatReports {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
606 my $self = shift;
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
607 my $page = shift || 0;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
608
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
609 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
610 my $extractor = new Ikariam::Extractor(content => $res->content);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
611
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
612 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
613 foreach my $tr ( @$result ) {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
614 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
615 my $date = $trExtractor->find('//td[@class="date"]');
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
616 $date =~ s/^\s+//g; $date =~ s/\s+$//g;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
617
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
618
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
619 my $href = $trExtractor->find('//td/a/@href');
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
620 if($href =~ /index.php\?view=militaryAdvisorReportView&combatId=(\d+)/) {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
621 my $report = Ikariam::Report->retrieve($1);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
622 if(!$report) {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
623 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
624 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
625 $report = Ikariam::Report->insert($report_hash);
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
626
129
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
627 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
628 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
629 $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
630 }
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
631 $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
632
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
633 $report->update();
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
634 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
635 } else {
129
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
636 # 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
637 return;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
638 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
639 } else {
129
3756298f8e4b fixed the island and city id in the military reports.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 125
diff changeset
640 # there is not report yet.
101
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
641 return;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
642 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
643 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
644
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
645 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
646 foreach (@moreCombats){
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
647 last if(/^javascript/);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
648 if(/\?view=militaryAdvisorCombatReports&start=(\d+)/) {
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
649 next if($1 le $page);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
650 $self->checkMilitaryAdvisorCombatReports($1);
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
651 last;
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
652 }
592d3b3b7898 implemented the WAR robot
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 100
diff changeset
653 }
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
654 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
655
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
656 sub checkTownHall {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
657 my $self = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
658 my $cityId = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
659
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
660 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
661 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
662
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
663 # //div[@id='SatisfactionOverview']//div[@class='value']
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
664 # //div[@id='SatisfactionOverview']//div[@class='text']
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
665 $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
666
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
667 # 取 SatisfactionOverview 中的其他值
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
668 # 一個城鎮的市民滿意度結合了多方面的因素
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
669 # check happiness
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
670 # 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
671 # Wine (Tavern Base(12*level) +
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
672 # Tavern Bonus(80*step)) +
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
673 # Culture (Museum Base(20*level) +
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
674 # Cultural Goods Bonus(50*Cultural Goods)) -
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
675 # Population (population) -
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
676 # Corruption (Corruption rate * population)
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
677 #
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
678 # Growth Rate = Happiness * 0.02
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
679
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
680 # Space, 房屋數
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
681 $self->{'cities'}->{$cityId}->{"space"} = {};
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
682 $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
683 $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
684
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
685 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
686 $self->{'cities'}->{$cityId}->{"growth"} = $values[0];
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
687 $self->{'cities'}->{$cityId}->{"incomegold"} = $values[1];
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
688
100
ed6160630329 save actionPoints.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 98
diff changeset
689 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
690 if($actionPoints =~ /(\d+)\/(\d+)/) {
ed6160630329 save actionPoints.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 98
diff changeset
691 $self->{'cities'}->{$cityId}->{actionPoints} = $1;
ed6160630329 save actionPoints.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 98
diff changeset
692 $self->{'cities'}->{$cityId}->{maxActionPoints} = $2;
ed6160630329 save actionPoints.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 98
diff changeset
693 }
ed6160630329 save actionPoints.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 98
diff changeset
694
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
695 $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
696 $self->{'cities'}->{$cityId}->{corruption} =~ s/%//g;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
697
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
698 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
699 @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
700 foreach my $i (0..$#citizens_type)
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
701 {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
702 $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
703 $self->{'cities'}->{$cityId}->{'citizens'}->{total} += $values[$i];
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
704 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
705 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
706
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
707 sub checkArmies
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
708 {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
709 my $self = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
710 my $cityId = shift;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
711 my %force_types;
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
712
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
713 $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
714 $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
715
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
716 foreach my $x (qw/army fleet/) {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
717 $self->{'cities'}->{$cityId}->{$x} = {};
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
718 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
719 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
720 foreach my $j (0..$#{$force_types{$x}}) {
87
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
721 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
722 if ($numbers[$j] == '-') {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
723 $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
724 } else {
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
725 $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
726 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
727 }
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
728 }
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
729 }
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
730
23
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
731 sub check
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
732 {
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
733 my $self = shift;
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
734
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
735 # MilitaryAdvisor
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
736 $self->checkMilitaryAdvisorMilitaryMovements();
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
737 $self->checkMilitaryAdvisorCombatReports();
81
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
738 $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
739
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
740 # alerts
d57920014cb4 split buliding.yaml to city.yaml and overall.yaml
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 80
diff changeset
741 # //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
742 # //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
743 # //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
744 # //li[@id="advDiplomacy"]/a[@class="normalalert"]
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
745
26
d8117792c6f5 collecting more data from townHall
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 23
diff changeset
746 # looking for cities
125
4374173bab47 collect hometown island information.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 117
diff changeset
747 foreach my $cityId (keys(%{$self->{'cities'}})) {
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
748 $self->checkCity($cityId);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
749 $self->checkTownHall($cityId);
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
750 $self->checkArmies($cityId);
23
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
751 }
26
d8117792c6f5 collecting more data from townHall
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 23
diff changeset
752 return $self->{'cities'};
23
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
753 }
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
754
84
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
755 sub getNetIncome {
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
756 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
757 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
758
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
759 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
760
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
761 # 扣除研發每人花費 8 GOLD
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
762 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
763 }
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
764
87
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
765 sub getNavyExpenditure {
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
766 my $self = shift;
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
767 my $cityId = shift;
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
768 my $cities = $self->{cities};
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
769
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
770 my $ships = {
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
771 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
772 '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
773 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
774 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
775 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
776 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
777 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
778 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
779 };
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
780 my $cost = 0;
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
781 foreach(keys(%{$cities->{$cityId}->{fleet}})) {
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
782 $cost += $cities->{$cityId}->{fleet}->{$_} * $ships->{$_}->{u};
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
783 }
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
784 return $cost;
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
785 }
4c82cf844aa8 counting navy expenditure
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 86
diff changeset
786
86
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
787 sub getMilityExpenditure {
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
788 my $self = shift;
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
789 my $cityId = shift;
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
790 my $cities = $self->{cities};
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
791 my $troops = {
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
792 # p 需要人口
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
793 # w 木頭
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
794 # S 硫磺
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
795 # b 製造時間
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
796 # u 維持費用
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
797 # m 最低軍營等級
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
798 # o 最佳軍營等級
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
799 # a 攻擊力
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
800 # d 防守力
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
801 # A
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
802 # D
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
803 # s 耐力
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
804 # c 種類
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
805 # v speed
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
806 # x 加成 Assault, Resistance
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
807 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},
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
808 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"},
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
809 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"},
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
810 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"},
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
811 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},
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
812 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"},
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
813 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},
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
814 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"},
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
815 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"},
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
816 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},
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
817 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"},
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
818 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"},
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
819 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"}
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
820 };
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
821
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
822 my $cost = 0;
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
823 foreach(keys(%{$cities->{$cityId}->{army}})) {
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
824 # printf("%s %d = %d\n", $_, $cities->{$cityId}->{army}->{$_}, $cities->{$cityId}->{army}->{$_} * $troops->{$_}->{u});
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
825 $cost += $cities->{$cityId}->{army}->{$_} * $troops->{$_}->{u};
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
826 }
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
827 return $cost;
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
828 }
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
829
84
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
830 sub blanceHurmanResource {
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
831 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
832 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
833 my $workersRatio = {
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
834 '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
835 '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
836 '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
837 };
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
838
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
839 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
840
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
841 # --- HR ---
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
842 # 扣除研發,四成種田生產,剩下 3:7 挖資源
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
843 # 四成收入中可用兩成做軍事用途
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
844 # 生產共四成
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
845 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
846
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
847 # 換成生產人力
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
848 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
849
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
850 # XXX
86
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
851 # 需計算資源開挖上限, 依照島等級區分
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
852 # 木頭
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
853 # create_slider({
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
854 # dir : 'ltr',
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
855 # id : "default",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
856 # maxValue : 367,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
857 # overcharge : 0,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
858 # iniValue : 367,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
859 # bg : "sliderbg",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
860 # thumb : "sliderthumb",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
861 # topConstraint: -10,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
862 # bottomConstraint: 344,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
863 # bg_value : "actualValue",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
864 # bg_overcharge : "overcharge",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
865 # textfield:"inputWorkers"
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
866 # });
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
867
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
868 # create_slider({
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
869 # dir : 'ltr',
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
870 # id : "default",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
871 # maxValue : 367,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
872 # overcharge : 0,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
873 # iniValue : 367,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
874 # bg : "sliderbg",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
875 # thumb : "sliderthumb",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
876 # topConstraint: -10,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
877 # bottomConstraint: 344,
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
878 # bg_value : "actualValue",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
879 # bg_overcharge : "overcharge",
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
880 # textfield:"inputWorkers"
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
881 # });
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
882
a8acf50bf7bb implemented a simple MilityExpenditure counting
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 84
diff changeset
883 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
884 }
2c6c219dc3ff fixed the checkCity function, implemneted a human resources palnning function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 83
diff changeset
885
9
ae412d1f7761 added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 8
diff changeset
886 sub logout
ae412d1f7761 added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 8
diff changeset
887 {
ae412d1f7761 added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 8
diff changeset
888 my $self = shift;
ae412d1f7761 added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 8
diff changeset
889 $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
890 }
ae412d1f7761 added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 8
diff changeset
891
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
892 sub login
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
893 {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
894 my $self = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
895
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
896 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
897 name => $self->{user},
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
898 password => $self->{pass},
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
899 ]);
79
9d92e8c12f58 rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 75
diff changeset
900
82
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
901 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
902
82
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
903 if($#cities<0) {
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
904 die ("login failed\n");
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
905 }
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
906 foreach(@cities) {
82acbba33b97 fixed the build function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 81
diff changeset
907 $self->{'cities'}->{$_} = {};
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
908 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
909 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
910
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
911 sub getElementsByTagName {
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
912 my $element = shift;
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
913 my $tagname = lc(shift);
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
914 my ( $flat, $cur ) = @$element;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
915
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
916 my $out = [];
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
917 for( ; $cur <= $#$flat ; $cur++ ) {
52
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
918 last if ($flat->[ $cur + 1 ]->[001] eq $element->tagName() );
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
919 next if ($flat->[$cur]->[001] ne $tagname );
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
920 next if $flat->[$cur]->[000]; # close
d2ac1e198ce4 implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 48
diff changeset
921
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
922 my $elem = HTML::TagParser::Element->new( $flat, $cur );
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
923 return $elem unless wantarray;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
924 push( @$out, $elem );
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
925 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
926 return unless wantarray;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
927 @$out;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
928 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
929
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
930 sub getElementsByAttribute {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
931 my $element = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
932 my $key = lc(shift);
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
933 my $val = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
934 my ( $flat, $cur ) = @$element;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
935
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
936 my $out = [];
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
937 for ( ; $cur <= $#$flat ; $cur++ ) {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
938 next if $flat->[$cur]->[000]; # close
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
939 my $elem = HTML::TagParser::Element->new( $flat, $cur );
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
940 my $attr = $elem->attributes();
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
941 next unless exists $attr->{$key};
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
942 next if ( $attr->{$key} ne $val );
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
943 return $elem unless wantarray;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
944 push( @$out, $elem );
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
945 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
946 return unless wantarray;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
947 @$out;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
948 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
949
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
950 1;