Mercurial > eagle-eye

comparison Ikariam.pm @ 0:abaee7064429

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
new scanning prototype.
author "Rex Tsai <chihchun@kalug.linux.org.tw>"
date Tue, 07 Oct 2008 22:24:46 +0800
parents
children f9eac5385dc0
comparison
equal deleted inserted replaced
-1:000000000000 0:abaee7064429
1 #!/usr/bin/env perl
2 package Ikariam;
3
4 use Data::Dumper;
5 use LWP;
6 use LWP::Debug qw(+ -conns);
7 use HTTP::Cookies;
8 use WWW::Mechanize;
9 use HTML::TagParser;
10 use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
11
12 sub new
13 {
14 my ($class, $server, $user, $pass) = @_;
15
16 my $self =
17 {
18 mech => WWW::Mechanize->new(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)"),
19 server => $server,
20 user => $user,
21 pass => $pass,
22 };
23
24 $self->{mech}->cookie_jar(HTTP::Cookies->new(file => "./cookies.txt", autosave => 1));
25 $self->{mech}->default_headers->push_header('Accept-Encoding', 'deflate');
26
27 return bless $self, $class;
28 }
29
30 sub viewWorldMap
31 {
32 my $self = shift;
33 my $x = shift;
34 my $y = shift;
35
36 my $res;
37 if(defined($x) && defined($y))
38 {
39 $res = $self->{mech}->post(sprintf("http://%s/index.php?view=worldmap_iso", $self->{server}), [
40 xajax => 'getMapData',
41 'xajaxargs[]' => $x,
42 'xajaxargs[]' => $y,
43 xajaxr => time,
44 ]);
45 } else {
46 $res = $self->{mech}->get(sprintf("http://%s/index.php?view=worldmap_iso", $self->{server}));
47 }
48
49 my $c;
50 my $status = gunzip \$res->content => \$c
51 or die "gunzip failed: $GunzipError\n";
52
53 # m[50][36]=new Array(564,1,5,'Risietia', '5', 13);
54 # x = 43-57 = 6
55 # y = 27-41 = 6
56 my @islands;
57 while($c =~ /m\[(\d+)\]\[(\d+)\]=new Array\((\d+),(\d+),(\d+),'(\w+)', '(\d+)', (\d+)\);/g)
58 {
59 my %island;
60 $island{id} = $3;
61 $island{x} = $1;
62 $island{y} = $2;
63 $island{name} = $6;
64 $island{tradegood} = $4;
65 $island{wonder} = $5;
66 # $7 ?
67 $island{people} = $8;
68
69 #foreach my $i (sort(keys(%island)))
70 #{
71 # printf ("%s %s\n", $i, $island{$i});
72 #}
73 #print("\n");
74 push @islands, \%island;
75 }
76 return @islands;
77 }
78
79 sub viewIsland
80 {
81 my $self = shift;
82 my $island = shift;
83
84 my $res = $self->{mech}->get(sprintf("http://%s/index.php?view=island&id=%s", $self->{server}, $island));
85
86 my $c;
87 my $status = gunzip \$res->content => \$c
88 or die "gunzip failed: $GunzipError\n";
89
90 my $html = HTML::TagParser->new($c);
91 my @elems = $html->getElementsByClassName( "cityinfo" );
92 my @cities;
93 foreach my $elem (@elems) {
94 my %info;
95
96 my @e = getElementsByTagName($elem, "li");
97 $info{'cityname'} = substr($e[0]->innerText(), 8);
98 $info{'citylevel'} = substr($e[1]->innerText(), 14);
99 $info{'owner'} = substr($e[2]->innerText(), 8);
100 $info{'ally'} = substr($e[3]->innerText(), 8);
101 @e = getElementsByAttribute($elem, "class", "messageSend");
102 if ( $e[0]->getAttribute("href") =~ /with=(\d+)&destinationCityId=(\d+)/)
103 {
104 $info{'ownerId'} = $1;
105 $info{'cityId'} = $2;
106 }
107
108 push @cities, \%info;
109 #foreach my $i (sort(keys(%info)))
110 #{
111 # printf("%s: %s ", $i, $info{$i});
112 # }
113 # printf("\n");
114 }
115
116 return @cities;
117 }
118
119 sub login
120 {
121 my $self = shift;
122
123 # $self->{mech}->get(sprintf('http://%s/', $self->{server}));
124 my $res = $self->{mech}->post(sprintf("http://%s/index.php?action=loginAvatar&function=login", $self->{server}), [
125 name => $self->{user},
126 password => $self->{pass},
127 ]);
128 my $c;
129 my $status = gunzip \$res->content => \$c
130 or die "gunzip failed: $GunzipError\n";
131
132 if($c =~ /錯誤！/)
133 {
134 die ("password error\n");
135 }
136 }
137
138 sub getElementsByTagName {
139 my $element = shift;
140 my $tagname = lc(shift);
141 my ( $flat, $cur ) = @$element;
142
143 my $out = [];
144 for( ; $cur <= $#$flat ; $cur++ ) {
145 next if ( $flat->[$cur]->[001] ne $tagname );
146 next if $flat->[$cur]->[000]; # close
147 my $elem = HTML::TagParser::Element->new( $flat, $cur );
148 return $elem unless wantarray;
149 push( @$out, $elem );
150 }
151 return unless wantarray;
152 @$out;
153 }
154
155 sub getElementsByAttribute {
156 my $element = shift;
157 my $key = lc(shift);
158 my $val = shift;
159 my ( $flat, $cur ) = @$element;
160
161 my $out = [];
162 for ( ; $cur <= $#$flat ; $cur++ ) {
163 next if $flat->[$cur]->[000]; # close
164 my $elem = HTML::TagParser::Element->new( $flat, $cur );
165 my $attr = $elem->attributes();
166 next unless exists $attr->{$key};
167 next if ( $attr->{$key} ne $val );
168 return $elem unless wantarray;
169 push( @$out, $elem );
170 }
171 return unless wantarray;
172 @$out;
173 }
174
175 1;