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
2975a94aa7a2 removed test code.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 5
diff changeset
154 highscoreType => $type,
2975a94aa7a2 removed test code.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 5
diff changeset
155 offset => $offset,
2975a94aa7a2 removed test code.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 5
diff changeset
156 searchUser => $user,
2975a94aa7a2 removed test code.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 5
diff changeset
157 view => 'highscore'
2975a94aa7a2 removed test code.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 5
diff changeset
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
2975a94aa7a2 removed test code.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 5
diff changeset
161 my $status = gunzip \$res->content => \$c
2975a94aa7a2 removed test code.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 5
diff changeset
162 or die "gunzip failed: $GunzipError\n";
2975a94aa7a2 removed test code.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 5
diff changeset
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
9c52ae71c1cb fixed , in score
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 16
diff changeset
196 $user{$type} =~ s/,//g;
5
dbb97c4265ba implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 3
diff changeset
197
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
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
213 if(!defined($x) && !defined($y))
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
214 {
1
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
215 die('location required');
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
216 }
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
217
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
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
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
224
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
225 my $c;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
226 my $status = gunzip \$res->content => \$c
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
227 or die "gunzip failed: $GunzipError\n";
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
228
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
229 my @islands;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
230 # parsing xjxobj
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
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)
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
232 {
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
233 my %island;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
234 $island{id} = $3;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
235 $island{x} = $1;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
236 $island{y} = $2;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
237 $island{name} = $6;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
238 $island{tradegood} = $4;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
239 $island{wonder} = $5;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
240 # $7 ?
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
241 $island{people} = $8;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
242 push @islands, \%island;
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
243 }
1
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
244 return @islands;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
245 }
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
246
3
b72786cdccbb fixed a typo
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 2
diff changeset
247 sub viewHomeMap
1
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
248 {
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
249 my $self = shift;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
250
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
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&amp;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;