annotate Ikariam.pm @ 100:ed6160630329

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