annotate Ikariam.pm @ 25:51a35c3d057e

cached 12 hours for user account.
author "Rex Tsai <chihchun@kalug.linux.org.tw>"
date Fri, 10 Oct 2008 03:20:05 +0800
parents 54ab0becd730
children d8117792c6f5
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
2975a94aa7a2 removed test code.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 5
diff changeset
51 highscoreType => $type,
2975a94aa7a2 removed test code.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 5
diff changeset
52 offset => $offset,
2975a94aa7a2 removed test code.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 5
diff changeset
53 searchUser => $user,
2975a94aa7a2 removed test code.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 5
diff changeset
54 view => 'highscore'
2975a94aa7a2 removed test code.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 5
diff changeset
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
2975a94aa7a2 removed test code.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 5
diff changeset
58 my $status = gunzip \$res->content => \$c
2975a94aa7a2 removed test code.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 5
diff changeset
59 or die "gunzip failed: $GunzipError\n";
2975a94aa7a2 removed test code.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 5
diff changeset
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();
19
9c52ae71c1cb fixed , in score
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 16
diff changeset
92 $user{$type} =~ s/,//g;
5
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
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
109 if(!defined($x) && !defined($y))
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
110 {
1
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
111 die('location required');
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
112 }
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
113
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
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
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
120
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
121 my $c;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
122 my $status = gunzip \$res->content => \$c
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
123 or die "gunzip failed: $GunzipError\n";
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
124
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
125 my @islands;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
126 # parsing xjxobj
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
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)
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
128 {
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
129 my %island;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
130 $island{id} = $3;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
131 $island{x} = $1;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
132 $island{y} = $2;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
133 $island{name} = $6;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
134 $island{tradegood} = $4;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
135 $island{wonder} = $5;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
136 # $7 ?
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
137 $island{people} = $8;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
138 push @islands, \%island;
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
139 }
1
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
140 return @islands;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
141 }
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
142
3
b72786cdccbb fixed a typo
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 2
diff changeset
143 sub viewHomeMap
1
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
144 {
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
145 my $self = shift;
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
146
f9eac5385dc0 added viewWorldMap
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 0
diff changeset
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
23
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
238 sub check
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
239 {
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
240 my $self = shift;
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
241
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
242 my $aaaa = $self->{'cities'};
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
243
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
244 # 運輸船
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
245 # CargoShip
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
246 foreach my $i (keys(%{$self->{'cities'}}))
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
247 {
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
248
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
249 # search for goods
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
250 my $res = $self->{mech}->post(sprintf('http://%s/index.php', $self->{server}), [
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
251 action => 'header',
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
252 cityId => $i,
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
253 function => 'changeCurrentCity',
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
254 id => $i,
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
255 oldView => 'city',
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
256 ]);
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
257 my $c;
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
258 my $status = gunzip \$res->content => \$c
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
259 or die "gunzip failed: $GunzipError\n";
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
260
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
261 my $html = HTML::TagParser->new($c);
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
262 my @elems;
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
263
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
264 foreach my $j (qw/value_wood value_wine value_marble value_crystal value_sulfur/) {
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
265 my ($elem) = $html->getElementsByAttribute("id", $j);
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
266 $self->{'cities'}->{$i}->{$j} = $elem->innerText();
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
267 $self->{'cities'}->{$i}->{$j} =~ s/,//g;
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
268 }
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
269
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
270 my %types;
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
271 $types{'army'} = [ qw/undef undef Slinger Swordsman Phalanx Ram Archer Catapult Gunsman Mortar SteamGiant Gyrocopter Bombardier Doctor Cook/ ];
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
272 $types{'fleet'} = [ qw/undef undef Ram-Ship BallistaShip Flamethrower CatapultShip MortarShip PaddleWheelRam DivingBoat/ ];
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
273
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
274 foreach my $x (qw/army fleet/)
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
275 {
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
276 $self->{'cities'}->{$i}->{$x} = {};
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
277 # search army
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
278 $res = $self->{mech}->get(sprintf('http://%s/index.php?view=cityMilitary-%s&id=%d', $self->{server}, $x, $i));
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
279 $status = gunzip \$res->content => \$c
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
280 or die "gunzip failed: $GunzipError\n";
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
281
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
282 $html = HTML::TagParser->new($c);
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
283 @elems = $html->getElementsByTagName('td');
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
284
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
285 foreach my $j (0..$#{$types{$x}}) {
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
286 next if($types{$x}[$j] eq 'undef');
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
287 if($elems[$j]->innerText() == '-') {
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
288 $self->{'cities'}->{$i}->{$x}->{$types{$x}[$j]} = 0;
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
289 } else {
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
290 $self->{'cities'}->{$i}->{$x}->{$types{$x}[$j]} = $elems[$j]->innerText();
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
291 }
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
292 }
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
293 }
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
294 }
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
295 print Dumper($self->{'cities'});
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
296 }
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
297
9
ae412d1f7761 added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 8
diff changeset
298 sub logout
ae412d1f7761 added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 8
diff changeset
299 {
ae412d1f7761 added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 8
diff changeset
300 my $self = shift;
ae412d1f7761 added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 8
diff changeset
301 $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
302 }
ae412d1f7761 added logout function.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 8
diff changeset
303
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
304 sub login
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
305 {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
306 my $self = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
307
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
308 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
309 name => $self->{user},
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
310 password => $self->{pass},
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
311 ]);
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
312 my $c;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
313 my $status = gunzip \$res->content => \$c
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
314 or die "gunzip failed: $GunzipError\n";
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
315
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
316 if($c =~ /錯誤!/)
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
317 {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
318 die ("password error\n");
23
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
319 } else {
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
320 my $html = HTML::TagParser->new($c);
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
321 my @elems;
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
322
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
323 @elems = $html->getElementsByAttribute("class", "avatarCities coords");
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
324 foreach my $elem (@elems) {
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
325 # my cities
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
326 $self->{'cities'}->{$elem->getAttribute('value')} = {};
54ab0becd730 implemented a prototype for collecting account status.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents: 19
diff changeset
327 }
0
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
328 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
329 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
330
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
331 sub getElementsByTagName {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
332 my $element = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
333 my $tagname = lc(shift);
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
334 my ( $flat, $cur ) = @$element;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
335
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
336 my $out = [];
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
337 for( ; $cur <= $#$flat ; $cur++ ) {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
338 next if ( $flat->[$cur]->[001] ne $tagname );
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
339 next if $flat->[$cur]->[000]; # close
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
340 my $elem = HTML::TagParser::Element->new( $flat, $cur );
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
341 return $elem unless wantarray;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
342 push( @$out, $elem );
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
343 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
344 return unless wantarray;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
345 @$out;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
346 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
347
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
348 sub getElementsByAttribute {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
349 my $element = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
350 my $key = lc(shift);
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
351 my $val = shift;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
352 my ( $flat, $cur ) = @$element;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
353
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
354 my $out = [];
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
355 for ( ; $cur <= $#$flat ; $cur++ ) {
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
356 next if $flat->[$cur]->[000]; # close
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
357 my $elem = HTML::TagParser::Element->new( $flat, $cur );
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
358 my $attr = $elem->attributes();
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
359 next unless exists $attr->{$key};
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
360 next if ( $attr->{$key} ne $val );
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
361 return $elem unless wantarray;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
362 push( @$out, $elem );
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
363 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
364 return unless wantarray;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
365 @$out;
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
366 }
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
367
abaee7064429 new scanning prototype.
"Rex Tsai <chihchun@kalug.linux.org.tw>"
parents:
diff changeset
368 1;