Mercurial > eagle-eye
annotate Ikariam.pm @ 16:59f2c435760c
implemented cached by timing.
author | "Rex Tsai <chihchun@kalug.linux.org.tw>" |
---|---|
date | Wed, 08 Oct 2008 15:24:21 +0800 |
parents | f590b5ea5e55 |
children | 9c52ae71c1cb |
rev | line source |
---|---|
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
1 #!/usr/bin/env perl |
2
0fb73a7a0b94
ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
1
diff
changeset
|
2 |
0fb73a7a0b94
ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
1
diff
changeset
|
3 use Class::DBI::AutoLoader ( |
0fb73a7a0b94
ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
1
diff
changeset
|
4 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
|
5 options => { RaiseError => 1 }, |
8
e4b3168d0319
implemented sheep and enemy scripts.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
7
diff
changeset
|
6 tables => ['cities', 'island', 'user'], |
2
0fb73a7a0b94
ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
1
diff
changeset
|
7 use_base => 'Class::DBI::SQLite', |
0fb73a7a0b94
ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
1
diff
changeset
|
8 namespace => 'Ikariam', |
0fb73a7a0b94
ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
1
diff
changeset
|
9 ); |
0fb73a7a0b94
ok, we done basic island scanning functions.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
1
diff
changeset
|
10 |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
11 package Ikariam; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
12 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
13 use Data::Dumper; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
14 use LWP; |
7
2040ccc95670
implemented scores collection.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
6
diff
changeset
|
15 # use LWP::Debug qw(+ -conns -trace -debug); |
2040ccc95670
implemented scores collection.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
6
diff
changeset
|
16 use LWP::Debug qw(+trace); |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
17 use HTTP::Cookies; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
18 use WWW::Mechanize; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
19 use HTML::TagParser; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
20 use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
21 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
22 sub new |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
23 { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
24 my ($class, $server, $user, $pass) = @_; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
25 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
26 my $self = |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
27 { |
16
59f2c435760c
implemented cached by timing.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
10
diff
changeset
|
28 mech => WWW::Mechanize->new( |
59f2c435760c
implemented cached by timing.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
10
diff
changeset
|
29 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
|
30 timeout => 10, |
59f2c435760c
implemented cached by timing.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
10
diff
changeset
|
31 ), |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
32 server => $server, |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
33 user => $user, |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
34 pass => $pass, |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
35 }; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
36 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
37 $self->{mech}->cookie_jar(HTTP::Cookies->new(file => "./cookies.txt", autosave => 1)); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
38 $self->{mech}->default_headers->push_header('Accept-Encoding', 'deflate'); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
39 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
40 return bless $self, $class; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
41 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
42 |
5
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
43 sub viewScore |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
44 { |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
45 my $self = shift; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
46 my $type = shift || 'score'; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
47 my $user = shift || ''; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
48 my $offset = shift || 0; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
49 |
7
2040ccc95670
implemented scores collection.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
6
diff
changeset
|
50 my $res = $self->{mech}->post(sprintf("http://%s/index.php", $self->{server}), [ |
6 | 51 highscoreType => $type, |
52 offset => $offset, | |
53 searchUser => $user, | |
54 view => 'highscore' | |
55 ]); | |
5
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
56 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
57 my $c; |
6 | 58 my $status = gunzip \$res->content => \$c |
59 or die "gunzip failed: $GunzipError\n"; | |
60 | |
5
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
61 my $html = HTML::TagParser->new($c); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
62 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
63 my ($table) = $html->getElementsByAttribute("class", "table01"); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
64 my @elems = getElementsByTagName($table, "tr"); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
65 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
66 my %users; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
67 foreach my $elem (@elems) { |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
68 my $e; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
69 my %user; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
70 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
71 $e = getElementsByAttribute($elem, "class", "action"); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
72 $e = getElementsByTagName($e, "a"); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
73 |
8
e4b3168d0319
implemented sheep and enemy scripts.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
7
diff
changeset
|
74 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
|
75 { |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
76 $user{'id'} = $1; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
77 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
78 $e = getElementsByAttribute($elem, "class", "name"); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
79 $user{'name'} = $e->innerText(); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
80 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
81 $e = getElementsByAttribute($elem, "class", "allytag"); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
82 $user{'ally'} = $e->innerText(); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
83 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
84 $e = getElementsByTagName($e, "a"); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
85 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
|
86 { |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
87 $user{'allyId'} = $1; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
88 } |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
89 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
90 $e = getElementsByAttribute($elem, "class", "score"); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
91 $user{$type} = $e->innerText(); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
92 $user{$type} =~ s/,//; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
93 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
94 $users{$user{'id'}} = \%user; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
95 } else { |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
96 next; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
97 } |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
98 } |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
99 |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
100 return \%users; |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
101 } |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
102 |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
103 sub viewWorldMap |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
104 { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
105 my $self = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
106 my $x = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
107 my $y = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
108 |
1 | 109 if(!defined($x) && !defined($y)) |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
110 { |
1 | 111 die('location required'); |
112 } | |
113 | |
114 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
|
115 xajax => 'getMapData', |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
116 'xajaxargs[]' => $x, |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
117 'xajaxargs[]' => $y, |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
118 xajaxr => time, |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
119 ]); |
1 | 120 |
121 my $c; | |
122 my $status = gunzip \$res->content => \$c | |
123 or die "gunzip failed: $GunzipError\n"; | |
124 | |
125 my @islands; | |
126 # parsing xjxobj | |
127 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) | |
128 { | |
129 my %island; | |
130 $island{id} = $3; | |
131 $island{x} = $1; | |
132 $island{y} = $2; | |
133 $island{name} = $6; | |
134 $island{tradegood} = $4; | |
135 $island{wonder} = $5; | |
136 # $7 ? | |
137 $island{people} = $8; | |
138 push @islands, \%island; | |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
139 } |
1 | 140 return @islands; |
141 } | |
142 | |
3 | 143 sub viewHomeMap |
1 | 144 { |
145 my $self = shift; | |
146 | |
147 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
|
148 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
149 my $c; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
150 my $status = gunzip \$res->content => \$c |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
151 or die "gunzip failed: $GunzipError\n"; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
152 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
153 # 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
|
154 # x = 43-57 = 6 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
155 # y = 27-41 = 6 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
156 my @islands; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
157 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
|
158 { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
159 my %island; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
160 $island{id} = $3; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
161 $island{x} = $1; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
162 $island{y} = $2; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
163 $island{name} = $6; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
164 $island{tradegood} = $4; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
165 $island{wonder} = $5; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
166 # $7 ? |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
167 $island{people} = $8; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
168 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
169 #foreach my $i (sort(keys(%island))) |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
170 #{ |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
171 # printf ("%s %s\n", $i, $island{$i}); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
172 #} |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
173 #print("\n"); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
174 push @islands, \%island; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
175 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
176 return @islands; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
177 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
178 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
179 sub viewIsland |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
180 { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
181 my $self = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
182 my $island = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
183 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
184 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
|
185 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
186 my $c; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
187 my $status = gunzip \$res->content => \$c |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
188 or die "gunzip failed: $GunzipError\n"; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
189 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
190 my $html = HTML::TagParser->new($c); |
10
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
191 |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
192 # find inactivity and vacation |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
193 my %status; |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
194 foreach my $class (qw/inactivity vacation/) |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
195 { |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
196 @elems = $html->getElementsByAttribute("class", $class); |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
197 foreach my $elem (@elems) { |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
198 if($elem->innerText() =~ /^(.*?) \((\w)\)/) { |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
199 $status{$1} = $2; |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
200 # printf("%s\n", $elem->innerText()); |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
201 } |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
202 } |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
203 } |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
204 |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
205 # find content |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
206 my @elems = $html->getElementsByClassName( "cityinfo" ); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
207 my @cities; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
208 foreach my $elem (@elems) { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
209 my %info; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
210 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
211 my @e = getElementsByTagName($elem, "li"); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
212 $info{'cityname'} = substr($e[0]->innerText(), 8); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
213 $info{'citylevel'} = substr($e[1]->innerText(), 14); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
214 $info{'owner'} = substr($e[2]->innerText(), 8); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
215 $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
|
216 delete($info{'ally'}) if($info{'ally'} eq '-'); |
dbb97c4265ba
implemented the scores search tool
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
3
diff
changeset
|
217 |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
218 @e = getElementsByAttribute($elem, "class", "messageSend"); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
219 if ( $e[0]->getAttribute("href") =~ /with=(\d+)&destinationCityId=(\d+)/) |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
220 { |
8
e4b3168d0319
implemented sheep and enemy scripts.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
7
diff
changeset
|
221 $info{'user'} = $1; |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
222 $info{'cityId'} = $2; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
223 } |
10
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
224 |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
225 # update status; |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
226 if(defined($status{$info{'cityname'}})) { |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
227 $info{'status'} = $status{$info{'cityname'}}; |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
228 } else { |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
229 $info{'status'} = undef; |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
230 } |
f590b5ea5e55
fixed bug of sheep.pl
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
9
diff
changeset
|
231 # print(Dumper(\%info)); |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
232 push @cities, \%info; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
233 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
234 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
235 return @cities; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
236 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
237 |
9
ae412d1f7761
added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
8
diff
changeset
|
238 sub logout |
ae412d1f7761
added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
8
diff
changeset
|
239 { |
ae412d1f7761
added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
8
diff
changeset
|
240 my $self = shift; |
ae412d1f7761
added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
8
diff
changeset
|
241 $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
|
242 } |
ae412d1f7761
added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
8
diff
changeset
|
243 |
0
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
244 sub login |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
245 { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
246 my $self = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
247 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
248 my $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
|
249 name => $self->{user}, |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
250 password => $self->{pass}, |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
251 ]); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
252 my $c; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
253 my $status = gunzip \$res->content => \$c |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
254 or die "gunzip failed: $GunzipError\n"; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
255 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
256 if($c =~ /錯誤!/) |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
257 { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
258 die ("password error\n"); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
259 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
260 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
261 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
262 sub getElementsByTagName { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
263 my $element = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
264 my $tagname = lc(shift); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
265 my ( $flat, $cur ) = @$element; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
266 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
267 my $out = []; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
268 for( ; $cur <= $#$flat ; $cur++ ) { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
269 next if ( $flat->[$cur]->[001] ne $tagname ); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
270 next if $flat->[$cur]->[000]; # close |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
271 my $elem = HTML::TagParser::Element->new( $flat, $cur ); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
272 return $elem unless wantarray; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
273 push( @$out, $elem ); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
274 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
275 return unless wantarray; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
276 @$out; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
277 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
278 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
279 sub getElementsByAttribute { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
280 my $element = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
281 my $key = lc(shift); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
282 my $val = shift; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
283 my ( $flat, $cur ) = @$element; |
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 $out = []; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
286 for ( ; $cur <= $#$flat ; $cur++ ) { |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
287 next if $flat->[$cur]->[000]; # close |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
288 my $elem = HTML::TagParser::Element->new( $flat, $cur ); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
289 my $attr = $elem->attributes(); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
290 next unless exists $attr->{$key}; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
291 next if ( $attr->{$key} ne $val ); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
292 return $elem unless wantarray; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
293 push( @$out, $elem ); |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
294 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
295 return unless wantarray; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
296 @$out; |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
297 } |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
298 |
abaee7064429
new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff
changeset
|
299 1; |