Mercurial > eagle-eye
annotate Ikariam.pm @ 79:9d92e8c12f58
rewrited the code in XPath.
author | "Rex Tsai <chihchun@kalug.linux.org.tw>" |
---|---|
date | Fri, 24 Oct 2008 21:46:33 +0800 |
parents | 3d1784140009 |
children | 7ab5fc8c847c |
rev | line source |
---|---|
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
1 #!/usr/bin/env perl |
41
5849b6fdc76c
removed my password from scripts.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
37
diff
changeset
|
2 BEGIN { |
48
96ee35378696
modified for searching configuration files
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
41
diff
changeset
|
3 foreach (((getpwuid($<))[7], $ENV{HOME}, $ENV{LOGDIR}, ".")) { |
96ee35378696
modified for searching configuration files
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
41
diff
changeset
|
4 require "$_/.eagleeye.pm" if (-f "$_/.eagleeye.pm"); |
96ee35378696
modified for searching configuration files
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
41
diff
changeset
|
5 } |
41
5849b6fdc76c
removed my password from scripts.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
37
diff
changeset
|
6 } |
2
0fb73a7a0b94
ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
1
diff
changeset
|
7 |
0fb73a7a0b94
ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
1
diff
changeset
|
8 use Class::DBI::AutoLoader ( |
0fb73a7a0b94
ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
1
diff
changeset
|
9 dsn => 'dbi:SQLite:dbname=ikariam.sqlite', |
0fb73a7a0b94
ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
1
diff
changeset
|
10 options => { RaiseError => 1 }, |
8
e4b3168d0319
implemented sheep and enemy scripts.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
7
diff
changeset
|
11 tables => ['cities', 'island', 'user'], |
2
0fb73a7a0b94
ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
1
diff
changeset
|
12 use_base => 'Class::DBI::SQLite', |
0fb73a7a0b94
ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
1
diff
changeset
|
13 namespace => 'Ikariam', |
0fb73a7a0b94
ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
1
diff
changeset
|
14 ); |
0fb73a7a0b94
ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
1
diff
changeset
|
15 |
79
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
16 package Ikariam::Extractor; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
17 use strict; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
18 use Data::Dumper; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
19 use XML::LibXML; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
20 use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
21 use Carp; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
22 use utf8; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
23 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
24 sub new { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
25 Carp::croak("Options should be key/value pairs, not hash reference") if ref($_[1]) eq 'HASH'; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
26 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
27 my($class, %conf) = @_; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
28 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
29 my $self = bless { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
30 doc => undef, |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
31 gzip => 1, |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
32 }, $class; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
33 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
34 $self->{gzip} = $conf{'gzip'} if(defined($conf{'gzip'})); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
35 $self->parse($conf{'content'}) if(defined($conf{'content'})); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
36 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
37 return $self; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
38 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
39 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
40 # parse($Content); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
41 sub parse { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
42 my ($self, $content) = @_; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
43 my $string; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
44 my $parser = XML::LibXML->new('1.0','utf-8'); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
45 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
46 if($self->{gzip} == 1) { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
47 gunzip \$content => \$string |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
48 or die "gunzip failed: $GunzipError\n"; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
49 } else { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
50 $string = $content; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
51 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
52 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
53 $self->{doc} = $parser->parse_html_string ($string, { suppress_errors => 1 }); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
54 return; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
55 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
56 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
57 # find($XPathQuery); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
58 sub find { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
59 my $self = shift; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
60 my $query = shift; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
61 my $out = []; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
62 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
63 my $result = $self->{doc}->find($query); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
64 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
65 return undef unless defined($result); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
66 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
67 if ( $result->isa( 'XML::LibXML::NodeList' ) ) { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
68 return undef if($result->size() == 0); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
69 foreach ( @$result ) { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
70 # $_ is XML::LibXML::Element, XML::LibXML::Node |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
71 my $literal = $_->to_literal() , "\n"; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
72 utf8::encode($literal); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
73 # warn $_->toString(1) , "\n"; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
74 return $literal unless wantarray; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
75 push( @$out, $literal); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
76 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
77 } else { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
78 Carp::croak("Unsupported data type"); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
79 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
80 # TODO |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
81 # XML::LibXML::Literal |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
82 # XML::LibXML::Boolean |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
83 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
84 return @$out; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
85 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
86 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
87 1; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
88 |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
89 package Ikariam; |
27
dd85b55eec2a
implemented basic inference engine.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
26
diff
changeset
|
90 use strict; |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
91 use Data::Dumper; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
92 use LWP; |
7
2040ccc95670
implemented scores collection.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
6
diff
changeset
|
93 # use LWP::Debug qw(+ -conns -trace -debug); |
56
6e0d5e781949
fixed a typo in agent.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
54
diff
changeset
|
94 # use LWP::Debug qw(+trace); |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
95 use HTTP::Cookies; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
96 use WWW::Mechanize; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
97 use HTML::TagParser; |
79
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
98 use XML::LibXML qw(:encoding); |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
99 use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ; |
79
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
100 use utf8; |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
101 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
102 sub new |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
103 { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
104 my ($class, $server, $user, $pass) = @_; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
105 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
106 my $self = |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
107 { |
16
59f2c435760c
implemented cached by timing.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
10
diff
changeset
|
108 mech => WWW::Mechanize->new( |
59f2c435760c
implemented cached by timing.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
10
diff
changeset
|
109 agent => "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.9.0.3) Gecko/2008092816 Iceweasel/3.0.1 (Debian-3.0.1-1)", |
59f2c435760c
implemented cached by timing.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
10
diff
changeset
|
110 timeout => 10, |
59f2c435760c
implemented cached by timing.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
10
diff
changeset
|
111 ), |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
112 server => $server, |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
113 user => $user, |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
114 pass => $pass, |
54
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
115 buildingIDs => { |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
116 townHall => 0, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
117 townhall => 0, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
118 port => 3, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
119 academy => 4, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
120 shipyard => 5, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
121 barracks => 6, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
122 warehouse => 7, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
123 wall => 8, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
124 tavern => 9, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
125 museum => 10, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
126 palace => 11, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
127 embassy => 12, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
128 branchOffice => 13, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
129 workshop => 15, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
130 'workshop-army' => 15, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
131 'workshop-fleet' => 15, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
132 safehouse => 16, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
133 palaceColony => 17, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
134 resource => 1, |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
135 tradegood => 2 |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
136 } |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
137 }; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
138 |
54
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
139 |
26
d8117792c6f5
collecting more data from townHall
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
23
diff
changeset
|
140 $self->{mech}->cookie_jar(HTTP::Cookies->new(file => "/tmp/ikariam-cookies.txt", autosave => 1)); |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
141 $self->{mech}->default_headers->push_header('Accept-Encoding', 'deflate'); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
142 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
143 return bless $self, $class; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
144 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
145 |
5
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
146 sub viewScore |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
147 { |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
148 my $self = shift; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
149 my $type = shift || 'score'; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
150 my $user = shift || ''; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
151 my $offset = shift || 0; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
152 |
7
2040ccc95670
implemented scores collection.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
6
diff
changeset
|
153 my $res = $self->{mech}->post(sprintf("http://%s/index.php", $self->{server}), [ |
6 | 154 highscoreType => $type, |
155 offset => $offset, | |
156 searchUser => $user, | |
157 view => 'highscore' | |
158 ]); | |
5
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
159 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
160 my $c; |
6 | 161 my $status = gunzip \$res->content => \$c |
162 or die "gunzip failed: $GunzipError\n"; | |
163 | |
37
7d1e353520ca
just return empty users list, when the score link table is missed.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
34
diff
changeset
|
164 my %users; |
5
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
165 my $html = HTML::TagParser->new($c); |
37
7d1e353520ca
just return empty users list, when the score link table is missed.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
34
diff
changeset
|
166 my ($table) = $html->getElementsByAttribute("class", "table01"); |
7d1e353520ca
just return empty users list, when the score link table is missed.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
34
diff
changeset
|
167 return %users if(!defined($table)); |
5
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
168 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
169 my @elems = getElementsByTagName($table, "tr"); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
170 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
171 foreach my $elem (@elems) { |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
172 my $e; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
173 my %user; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
174 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
175 $e = getElementsByAttribute($elem, "class", "action"); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
176 $e = getElementsByTagName($e, "a"); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
177 |
8
e4b3168d0319
implemented sheep and enemy scripts.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
7
diff
changeset
|
178 if(defined ($e) && $e->getAttribute('href') =~ /index\.php\?view=sendMessage&with=(\d+)&oldView=highscore/) |
5
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
179 { |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
180 $user{'id'} = $1; |
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 $e = getElementsByAttribute($elem, "class", "name"); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
183 $user{'name'} = $e->innerText(); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
184 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
185 $e = getElementsByAttribute($elem, "class", "allytag"); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
186 $user{'ally'} = $e->innerText(); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
187 |
26
d8117792c6f5
collecting more data from townHall
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
23
diff
changeset
|
188 $e = getElementsByTagName($e, "a"); |
5
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
189 if($e->getAttribute('href') =~ /\?view=allyPage&allyId=(\d+)/) |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
190 { |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
191 $user{'allyId'} = $1; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
192 } |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
193 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
194 $e = getElementsByAttribute($elem, "class", "score"); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
195 $user{$type} = $e->innerText(); |
19 | 196 $user{$type} =~ s/,//g; |
5
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
197 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
198 $users{$user{'id'}} = \%user; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
199 } else { |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
200 next; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
201 } |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
202 } |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
203 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
204 return \%users; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
205 } |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
206 |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
207 sub viewWorldMap |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
208 { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
209 my $self = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
210 my $x = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
211 my $y = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
212 |
1 | 213 if(!defined($x) && !defined($y)) |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
214 { |
1 | 215 die('location required'); |
216 } | |
217 | |
218 my $res = $self->{mech}->post(sprintf("http://%s/index.php?view=worldmap_iso", $self->{server}), [ | |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
219 xajax => 'getMapData', |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
220 'xajaxargs[]' => $x, |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
221 'xajaxargs[]' => $y, |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
222 xajaxr => time, |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
223 ]); |
1 | 224 |
225 my $c; | |
226 my $status = gunzip \$res->content => \$c | |
227 or die "gunzip failed: $GunzipError\n"; | |
228 | |
229 my @islands; | |
230 # parsing xjxobj | |
231 while($c =~ /<cmd n="jc" t="addToMap"><xjxobj><e><k>0<\/k><v><!\[CDATA\[(\d+)\]\]><\/v><\/e><e><k>1<\/k><v><!\[CDATA\[(\d+)\]\]><\/v><\/e><e><k>2<\/k><v><!\[CDATA\[(\d+)\]\]><\/v><\/e><e><k>3<\/k><v><!\[CDATA\[(\d+)\]\]><\/v><\/e><e><k>4<\/k><v><!\[CDATA\[(\d+)\]\]><\/v><\/e><e><k>5<\/k><v><!\[CDATA\[(\w+)\]\]><\/v><\/e><e><k>6<\/k><v><!\[CDATA\[(\d+)\]\]><\/v><\/e><e><k>7<\/k><v><!\[CDATA\[(\d+)\]\]><\/v><\/e><\/xjxobj><\/cmd>/g) | |
232 { | |
233 my %island; | |
234 $island{id} = $3; | |
235 $island{x} = $1; | |
236 $island{y} = $2; | |
237 $island{name} = $6; | |
238 $island{tradegood} = $4; | |
239 $island{wonder} = $5; | |
240 # $7 ? | |
241 $island{people} = $8; | |
242 push @islands, \%island; | |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
243 } |
1 | 244 return @islands; |
245 } | |
246 | |
3 | 247 sub viewHomeMap |
1 | 248 { |
249 my $self = shift; | |
250 | |
251 my $res = $self->{mech}->get(sprintf("http://%s/index.php?view=worldmap_iso", $self->{server})); | |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
252 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
253 my $c; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
254 my $status = gunzip \$res->content => \$c |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
255 or die "gunzip failed: $GunzipError\n"; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
256 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
257 # m[50][36]=new Array(564,1,5,'Risietia', '5', 13); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
258 # x = 43-57 = 6 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
259 # y = 27-41 = 6 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
260 my @islands; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
261 while($c =~ /m\[(\d+)\]\[(\d+)\]=new Array\((\d+),(\d+),(\d+),'(\w+)', '(\d+)', (\d+)\);/g) |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
262 { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
263 my %island; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
264 $island{id} = $3; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
265 $island{x} = $1; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
266 $island{y} = $2; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
267 $island{name} = $6; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
268 $island{tradegood} = $4; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
269 $island{wonder} = $5; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
270 # $7 ? |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
271 $island{people} = $8; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
272 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
273 #foreach my $i (sort(keys(%island))) |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
274 #{ |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
275 # printf ("%s %s\n", $i, $island{$i}); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
276 #} |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
277 #print("\n"); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
278 push @islands, \%island; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
279 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
280 return @islands; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
281 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
282 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
283 sub viewIsland |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
284 { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
285 my $self = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
286 my $island = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
287 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
288 my $res = $self->{mech}->get(sprintf("http://%s/index.php?view=island&id=%s", $self->{server}, $island)); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
289 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
290 my $c; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
291 my $status = gunzip \$res->content => \$c |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
292 or die "gunzip failed: $GunzipError\n"; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
293 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
294 my $html = HTML::TagParser->new($c); |
10
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
295 |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
296 # find inactivity and vacation |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
297 my %status; |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
298 foreach my $class (qw/inactivity vacation/) |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
299 { |
27
dd85b55eec2a
implemented basic inference engine.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
26
diff
changeset
|
300 my @elems = $html->getElementsByAttribute("class", $class); |
10
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
301 foreach my $elem (@elems) { |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
302 if($elem->innerText() =~ /^(.*?) \((\w)\)/) { |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
303 $status{$1} = $2; |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
304 # printf("%s\n", $elem->innerText()); |
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 } |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
307 } |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
308 |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
309 # find content |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
310 my @elems = $html->getElementsByClassName( "cityinfo" ); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
311 my @cities; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
312 foreach my $elem (@elems) { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
313 my %info; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
314 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
315 my @e = getElementsByTagName($elem, "li"); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
316 $info{'cityname'} = substr($e[0]->innerText(), 8); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
317 $info{'citylevel'} = substr($e[1]->innerText(), 14); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
318 $info{'owner'} = substr($e[2]->innerText(), 8); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
319 $info{'ally'} = substr($e[3]->innerText(), 8); |
5
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
320 delete($info{'ally'}) if($info{'ally'} eq '-'); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
321 |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
322 @e = getElementsByAttribute($elem, "class", "messageSend"); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
323 if ( $e[0]->getAttribute("href") =~ /with=(\d+)&destinationCityId=(\d+)/) |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
324 { |
8
e4b3168d0319
implemented sheep and enemy scripts.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
7
diff
changeset
|
325 $info{'user'} = $1; |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
326 $info{'cityId'} = $2; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
327 } |
10
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
328 |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
329 # update status; |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
330 if(defined($status{$info{'cityname'}})) { |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
331 $info{'status'} = $status{$info{'cityname'}}; |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
332 } else { |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
333 $info{'status'} = undef; |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
334 } |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
335 # print(Dumper(\%info)); |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
336 push @cities, \%info; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
337 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
338 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
339 return @cities; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
340 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
341 |
54
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
342 sub increaseTransporter { |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
343 my $self = shift; |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
344 my $param = shift; |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
345 my $cityId = shift; |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
346 |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
347 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
|
348 foreach (1..2) { |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
349 if($locations[$_] eq 'port') { |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
350 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
|
351 $self->{server}, $cityId, $_)); |
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 } |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
354 } |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
355 |
52
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
356 sub build { |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
357 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
|
358 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
|
359 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
|
360 |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
361 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
|
362 |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
363 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
|
364 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
|
365 foreach (0..$#locations) { |
54
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
366 $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
|
367 } |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
368 |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
369 if($position == -1) |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
370 { |
54
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
371 foreach (0..$#locations) { |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
372 next if($_ <= 2 && ($self->{buildingIDs}->{$type} ne "workshop-fleet" && |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
373 $self->{buildingIDs}->{$type} ne "shipyard")); |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
374 if($locations[$_] eq undef) { |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
375 my $res = $self->{mech}->get(sprintf('http://%s/index.php?action=CityScreen&function=build&id=%s&position=%s&building=%d', |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
376 $self->{server}, $cityId, $_, $self->{buildingIDs}->{$type} )); |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
377 last; |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
378 } |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
379 } |
52
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
380 } else { |
54
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
381 $self->{mech}->add_header( Referer => |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
382 sprintf("http://%s/index.php?view=%s&id=%s&position=%d", $self->{server}, $type, $cityId, $position)); |
52
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
383 my $res = $self->{mech}->post(sprintf('http://%s/index.php', $self->{server}), [ |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
384 action => 'CityScreen', |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
385 'function' => 'upgradeBuilding', |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
386 id => $cityId, |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
387 position => $position, |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
388 level => $self->{'cities'}->{$cityId}->{buildings}->{$type}, |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
389 oldView => $type, |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
390 ]); |
54
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
391 # my $content; |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
392 # gunzip \$res->content => \$content |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
393 # or die "gunzip failed: $GunzipError\n"; |
2d3c394b7940
rules for build new building and buy transporters
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
52
diff
changeset
|
394 # print ($content); |
52
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
395 } |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
396 } |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
397 |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
398 sub run { |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
399 my $self = shift; |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
400 # defense. |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
401 die("Not implemented"); |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
402 } |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
403 |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
404 sub research |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
405 { |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
406 my $self = shift; |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
407 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
|
408 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
|
409 |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
410 # 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
|
411 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
|
412 |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
413 # my $content; |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
414 # gunzip \$res->content => \$content |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
415 # or die "gunzip failed: $GunzipError\n"; |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
416 # |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
417 # print ($content); |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
418 } |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
419 |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
420 sub checkResearch { |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
421 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
|
422 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
|
423 |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
424 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
|
425 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
426 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
|
427 my $out = {}; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
428 foreach(@urls) { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
429 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
|
430 # 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
|
431 @$out{$1} = 1; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
432 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
433 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
434 return $out; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
435 } |
52
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
436 |
79
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
437 sub checkCity { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
438 my $self = shift; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
439 my $cityId = shift; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
440 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
441 # search for goods |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
442 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
|
443 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
|
444 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
445 $self->{'cities'}->{$cityId}->{resources}->{gold} = $extractor->find('//span[@id="value_gold"]/text()'); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
446 $self->{'cities'}->{$cityId}->{resources}->{gold} =~ s/,//g; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
447 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
448 $self->{'cities'}->{$cityId}->{name} = $extractor->find('//span[@class="city"]/text()'); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
449 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
450 $self->{'cities'}->{$cityId}->{construction} = defined($extractor->find('//*[@class="constructionSite"]')) ? 1 : 0; |
52
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
451 |
79
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
452 # maxCapacity |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
453 my $page = $extractor->{doc}->toString(1); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
454 if($page =~ /maxCapacity : {\s+wood: (\d+),\s+wine: (\d+),\s+marble: (\d+),\s+crystal: (\d+),\s+sulfur: (\d+)\s+}/s) { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
455 $self->{'cities'}->{$cityId}->{maxCapacity}->{wood} = $1; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
456 $self->{'cities'}->{$cityId}->{maxCapacity}->{wine} = $2; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
457 $self->{'cities'}->{$cityId}->{maxCapacity}->{marble} = $3; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
458 $self->{'cities'}->{$cityId}->{maxCapacity}->{crystal} = $4; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
459 $self->{'cities'}->{$cityId}->{maxCapacity}->{sulfur} = $5; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
460 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
461 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
462 foreach my $good (qw/wood wine marble crystal sulfur/) { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
463 $self->{'cities'}->{$cityId}->{resources}->{$good} = $extractor->find(sprintf('//span[@id="value_%s"]', $good)); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
464 $self->{'cities'}->{$cityId}->{resources}->{$good} =~ s/,//g; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
465 } |
52
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
466 |
79
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
467 foreach my $i (0..14) { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
468 my @buildings = $extractor->find(sprintf('//*[@id="position%s"]/@class', $i)); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
469 foreach my $building (@buildings) { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
470 if (!($building =~ /buildingGround/) && !($building =~ /townhall/)) { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
471 $self->{'cities'}->{$cityId}->{locations}[$i] = $building; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
472 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
473 my $span; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
474 if($building eq 'townHall') { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
475 # this is stupid, the new vession give two cityTown information. |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
476 $span = ($extractor->find(sprintf('//*[@id="position%s"]//span[@class="textLabel"]/text()', $i)))[1]; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
477 } else { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
478 $span = $extractor->find(sprintf('//*[@id="position%s"]//span[@class="textLabel"]/text()', $i)); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
479 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
480 my (undef, undef, $level) = split(/ /, $span); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
481 $self->{'cities'}->{$cityId}->{buildings}->{$building} = $level; |
52
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
482 } |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
483 } |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
484 } |
79
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
485 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
486 $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
|
487 $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
|
488 $self->{'cities'}->{$cityId}->{transporters}->{sum} =~ s/[\(|\)]//g; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
489 $self->{'cities'}->{$cityId}->{maxActionPoints} = $extractor->find('//span[@id="value_maxActionPoints"]');; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
490 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
491 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
492 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
493 sub checkMilitaryAdvisorMilitaryMovements { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
494 my $self = shift; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
495 # TODO |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
496 # http://s2.ikariam.tw/index.php?view=militaryAdvisorMilitaryMovements |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
497 my $res = $self->{mech}->get(sprintf('http://%s/index.php?view=militaryAdvisorMilitaryMovements', $self->{server})); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
498 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
499 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
500 sub checkMilitaryAdvisorCombatReports { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
501 my $self = shift; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
502 my $content; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
503 my $res = $self->{mech}->get(sprintf('http://%s/index.php?view=militaryAdvisorCombatReports', $self->{server})); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
504 gunzip \$res->content => \$content |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
505 or die "gunzip failed: $GunzipError\n"; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
506 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
507 open(OUT,">foo.html"); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
508 print OUT $content; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
509 close(OUT); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
510 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
511 # TODO |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
512 # $self->{'cities'}->{$cityId}->{force}->{attacks} = $1 if($content =~ /敵人攻擊: (\d+)/); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
513 # $self->{'cities'}->{$cityId}->{force}->{wars} = $1 if($content =~ /我方軍隊行程: (\d+)/); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
514 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
515 # list down reports. |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
516 # /index.php?view=militaryAdvisorReportView&combatId=1887662 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
517 # //form[@id='finishedReports']//a |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
518 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
519 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
520 sub checkTownHall { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
521 my $self = shift; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
522 my $cityId = shift; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
523 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
524 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
|
525 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
|
526 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
527 # //div[@id='SatisfactionOverview']//div[@class='value'] |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
528 # //div[@id='SatisfactionOverview']//div[@class='text'] |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
529 $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
|
530 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
531 # 取 SatisfactionOverview 中的其他值 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
532 # 一個城鎮的市民滿意度結合了多方面的因素 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
533 # check happiness |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
534 # 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
|
535 # Wine (Tavern Base(12*level) + |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
536 # Tavern Bonus(80*step)) + |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
537 # Culture (Museum Base(20*level) + |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
538 # Cultural Goods Bonus(50*Cultural Goods)) - |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
539 # Population (population) - |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
540 # Corruption (Corruption rate * population) |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
541 # |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
542 # Growth Rate = Happiness * 0.02 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
543 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
544 # Space, 房屋數 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
545 $self->{'cities'}->{$cityId}->{"space"} = {}; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
546 $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
|
547 $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
|
548 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
549 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
|
550 $self->{'cities'}->{$cityId}->{"growth"} = $values[0]; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
551 $self->{'cities'}->{$cityId}->{"incomegold"} = $values[1]; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
552 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
553 $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
|
554 $self->{'cities'}->{$cityId}->{corruption} =~ s/%//g; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
555 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
556 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
|
557 @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
|
558 foreach my $i (0..$#citizens_type) |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
559 { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
560 $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
|
561 $self->{'cities'}->{$cityId}->{'citizens'}->{total} += $values[$i]; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
562 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
563 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
564 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
565 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
566 sub checkArmies |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
567 { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
568 my $self = shift; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
569 my $cityId = shift; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
570 my %force_types; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
571 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
572 $force_types{'army'} = [ qw/undef undef Slinger Swordsman Phalanx Ram Archer Catapult Gunsman Mortar SteamGiant Gyrocopter Bombardier Doctor Cook/ ]; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
573 $force_types{'fleet'} = [ qw/undef undef Ram-Ship BallistaShip Flamethrower CatapultShip MortarShip PaddleWheelRam DivingBoat/ ]; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
574 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
575 foreach my $x (qw/army fleet/) { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
576 $self->{'cities'}->{$cityId}->{$x} = {}; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
577 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
|
578 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
|
579 foreach my $j (0..$#{$force_types{$x}}) { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
580 if ($numbers[$j] == '-') { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
581 $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
|
582 } else { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
583 $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
|
584 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
585 } |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
586 } |
52
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
587 } |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
588 |
23
54ab0becd730
implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
19
diff
changeset
|
589 sub check |
54ab0becd730
implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
19
diff
changeset
|
590 { |
54ab0becd730
implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
19
diff
changeset
|
591 my $self = shift; |
54ab0becd730
implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
19
diff
changeset
|
592 |
79
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
593 # MilitaryAdvisor |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
594 $self->checkMilitaryAdvisorMilitaryMovements(); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
595 $self->checkMilitaryAdvisorCombatReports(); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
596 |
26
d8117792c6f5
collecting more data from townHall
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
23
diff
changeset
|
597 # looking for cities |
d8117792c6f5
collecting more data from townHall
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
23
diff
changeset
|
598 foreach my $cityId (keys(%{$self->{'cities'}})) |
23
54ab0becd730
implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
19
diff
changeset
|
599 { |
79
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
600 $self->checkCity($cityId); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
601 $self->checkTownHall($cityId); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
602 $self->checkArmies($cityId); |
52
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
603 $self->{'cities'}->{$cityId}->{'research'} = $self->checkResearch($cityId); |
23
54ab0becd730
implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
19
diff
changeset
|
604 } |
79
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
605 print Dumper($self->{'cities'}); |
26
d8117792c6f5
collecting more data from townHall
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
23
diff
changeset
|
606 return $self->{'cities'}; |
23
54ab0becd730
implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
19
diff
changeset
|
607 } |
54ab0becd730
implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
19
diff
changeset
|
608 |
9
ae412d1f7761
added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
8
diff
changeset
|
609 sub logout |
ae412d1f7761
added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
8
diff
changeset
|
610 { |
ae412d1f7761
added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
8
diff
changeset
|
611 my $self = shift; |
ae412d1f7761
added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
8
diff
changeset
|
612 $self->{mech}->get(sprintf('http://%s/index.php?action=loginAvatar&function=logout', $self->{server})); |
ae412d1f7761
added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
8
diff
changeset
|
613 } |
ae412d1f7761
added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
8
diff
changeset
|
614 |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
615 sub login |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
616 { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
617 my $self = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
618 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
619 my $res = $self->{mech}->post(sprintf("http://%s/index.php?action=loginAvatar&function=login", $self->{server}), [ |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
620 name => $self->{user}, |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
621 password => $self->{pass}, |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
622 ]); |
79
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
623 |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
624 my $c; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
625 my $status = gunzip \$res->content => \$c |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
626 or die "gunzip failed: $GunzipError\n"; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
627 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
628 if($c =~ /錯誤!/) |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
629 { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
630 die ("password error\n"); |
23
54ab0becd730
implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
19
diff
changeset
|
631 } else { |
79
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
632 my $result = XML::LibXML->new('1.0','utf-8') |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
633 ->parse_html_string ($c, { suppress_errors => 1 }) |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
634 ->find( '//option[@class="avatarCities coords"]' ); |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
635 |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
636 if ( $result->isa( 'XML::LibXML::NodeList' ) ) { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
637 foreach ( @$result ) { |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
638 $self->{'cities'}->{$_->getAttribute('value')} = {}; |
9d92e8c12f58
rewrited the code in XPath.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
75
diff
changeset
|
639 } |
23
54ab0becd730
implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
19
diff
changeset
|
640 } |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
641 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
642 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
643 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
644 sub getElementsByTagName { |
52
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
645 my $element = shift; |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
646 my $tagname = lc(shift); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
647 my ( $flat, $cur ) = @$element; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
648 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
649 my $out = []; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
650 for( ; $cur <= $#$flat ; $cur++ ) { |
52
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
651 last if ($flat->[ $cur + 1 ]->[001] eq $element->tagName() ); |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
652 next if ($flat->[$cur]->[001] ne $tagname ); |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
653 next if $flat->[$cur]->[000]; # close |
d2ac1e198ce4
implement a new agent based on Decision Tree (Decision::ParseTree)
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
48
diff
changeset
|
654 |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
655 my $elem = HTML::TagParser::Element->new( $flat, $cur ); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
656 return $elem unless wantarray; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
657 push( @$out, $elem ); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
658 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
659 return unless wantarray; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
660 @$out; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
661 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
662 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
663 sub getElementsByAttribute { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
664 my $element = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
665 my $key = lc(shift); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
666 my $val = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
667 my ( $flat, $cur ) = @$element; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
668 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
669 my $out = []; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
670 for ( ; $cur <= $#$flat ; $cur++ ) { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
671 next if $flat->[$cur]->[000]; # close |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
672 my $elem = HTML::TagParser::Element->new( $flat, $cur ); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
673 my $attr = $elem->attributes(); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
674 next unless exists $attr->{$key}; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
675 next if ( $attr->{$key} ne $val ); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
676 return $elem unless wantarray; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
677 push( @$out, $elem ); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
678 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
679 return unless wantarray; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
680 @$out; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
681 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
682 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
683 1; |