eagle-eye: Ikariam.pm annotate

annotate Ikariam.pm @ 370:ba1643654e6d

added locking for avoid duplicated instance.

author	"Rex Tsai <chihchun@kalug.linux.org.tw>"
date	Tue, 14 Apr 2009 16:57:51 +0800
parents	d9d3cdff27c6
children	5d6f429e5f19

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

Mercurial > eagle-eye

annotate Ikariam.pm @ 370:ba1643654e6d