eagle-eye: Ikariam.pm annotate

annotate Ikariam.pm @ 6:2975a94aa7a2

removed test code.

author	"Rex Tsai <chihchun@kalug.linux.org.tw>"
date	Wed, 08 Oct 2008 01:52:18 +0800
parents	dbb97c4265ba
children	2040ccc95670

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 },
5 dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	6 tables => ['cities', 'islands', 'users'],
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;
1 f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	15 # use LWP::Debug qw(+ -conns);
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	16 use HTTP::Cookies;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	17 use WWW::Mechanize;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	18 use HTML::TagParser;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	19 use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	20
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	21 sub new
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	22 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	23 my ($class, $server, $user, $pass) = @_;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	24
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	25 my $self =
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	26 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	27 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)"),
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	28 server => $server,
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	29 user => $user,
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	30 pass => $pass,
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	31 };
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	32
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	33 $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	34 $self->{mech}->default_headers->push_header('Accept-Encoding', 'deflate');
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 return bless $self, $class;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	37 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	38
5 dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	39 sub viewScore
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	40 {
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	41 my $self = shift;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	42 my $type = shift \|\| 'score';
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	43 my $user = shift \|\| '';
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	44 my $offset = shift \|\| 0;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	45
6 2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	46 my $res = $self->{mech}->post(sprintf("http://%s/index.php?view=worldmap_iso", $self->{server}), [
2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	47 highscoreType => $type,
2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	48 offset => $offset,
2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	49 searchUser => $user,
2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	50 view => 'highscore'
2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	51 ]);
5 dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	52
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	53 my $c;
6 2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	54 my $status = gunzip \$res->content => \$c
2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	55 or die "gunzip failed: $GunzipError\n";
2975a94aa7a2 removed test code. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 5 diff changeset	56
5 dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	57 my $html = HTML::TagParser->new($c);
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	58
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	59 my ($table) = $html->getElementsByAttribute("class", "table01");
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	60 my @elems = getElementsByTagName($table, "tr");
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	61
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	62 my %users;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	63 foreach my $elem (@elems) {
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	64 my $e;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	65 my %user;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	66
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	67 $e = getElementsByAttribute($elem, "class", "action");
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	68 $e = getElementsByTagName($e, "a");
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	69
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	70 if($e->getAttribute('href') =~ /index\.php\?view=sendMessage&with=(\d+)&oldView=highscore/)
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	71 {
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	72 $user{'id'} = $1;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	73
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	74 $e = getElementsByAttribute($elem, "class", "name");
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	75 $user{'name'} = $e->innerText();
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	76
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	77 $e = getElementsByAttribute($elem, "class", "allytag");
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	78 $user{'ally'} = $e->innerText();
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	79
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	80 $e = getElementsByTagName($e, "a");
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	81 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	82 {
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	83 $user{'allyId'} = $1;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	84 }
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	85
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	86 $e = getElementsByAttribute($elem, "class", "score");
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	87 $user{$type} = $e->innerText();
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	88 $user{$type} =~ s/,//;
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 $users{$user{'id'}} = \%user;
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	91 } else {
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	92 next;
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 }
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	95
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	96 return \%users;
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
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	99 sub viewWorldMap
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	100 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	101 my $self = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	102 my $x = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	103 my $y = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	104
1 f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	105 if(!defined($x) && !defined($y))
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	106 {
1 f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	107 die('location required');
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	108 }
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	109
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	110 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	111 xajax => 'getMapData',
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	112 'xajaxargs[]' => $x,
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	113 'xajaxargs[]' => $y,
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	114 xajaxr => time,
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	115 ]);
1 f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	116
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	117 my $c;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	118 my $status = gunzip \$res->content => \$c
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	119 or die "gunzip failed: $GunzipError\n";
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 @islands;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	122 # parsing xjxobj
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	123 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	124 {
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	125 my %island;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	126 $island{id} = $3;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	127 $island{x} = $1;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	128 $island{y} = $2;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	129 $island{name} = $6;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	130 $island{tradegood} = $4;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	131 $island{wonder} = $5;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	132 # $7 ?
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	133 $island{people} = $8;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	134 push @islands, \%island;
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	135 }
1 f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	136 return @islands;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	137 }
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	138
3 b72786cdccbb fixed a typo "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 2 diff changeset	139 sub viewHomeMap
1 f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	140 {
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	141 my $self = shift;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	142
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	143 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	144
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	145 my $c;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	146 my $status = gunzip \$res->content => \$c
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	147 or die "gunzip failed: $GunzipError\n";
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 # 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	150 # x = 43-57 = 6
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	151 # y = 27-41 = 6
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	152 my @islands;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	153 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	154 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	155 my %island;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	156 $island{id} = $3;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	157 $island{x} = $1;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	158 $island{y} = $2;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	159 $island{name} = $6;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	160 $island{tradegood} = $4;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	161 $island{wonder} = $5;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	162 # $7 ?
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	163 $island{people} = $8;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	164
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	165 #foreach my $i (sort(keys(%island)))
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	166 #{
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	167 # printf ("%s %s\n", $i, $island{$i});
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 #print("\n");
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	170 push @islands, \%island;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	171 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	172 return @islands;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	173 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	174
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	175 sub viewIsland
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	176 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	177 my $self = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	178 my $island = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	179
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	180 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	181
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	182 my $c;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	183 my $status = gunzip \$res->content => \$c
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	184 or die "gunzip failed: $GunzipError\n";
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 $html = HTML::TagParser->new($c);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	187 my @elems = $html->getElementsByClassName( "cityinfo" );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	188 my @cities;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	189 foreach my $elem (@elems) {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	190 my %info;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	191
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	192 my @e = getElementsByTagName($elem, "li");
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	193 $info{'cityname'} = substr($e[0]->innerText(), 8);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	194 $info{'citylevel'} = substr($e[1]->innerText(), 14);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	195 $info{'owner'} = substr($e[2]->innerText(), 8);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	196 $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	197 delete($info{'ally'}) if($info{'ally'} eq '-');
dbb97c4265ba implemented the scores search tool "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 3 diff changeset	198
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	199 @e = getElementsByAttribute($elem, "class", "messageSend");
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	200 if ( $e[0]->getAttribute("href") =~ /with=(\d+)&destinationCityId=(\d+)/)
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	201 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	202 $info{'ownerId'} = $1;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	203 $info{'cityId'} = $2;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	204 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	205 push @cities, \%info;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	206 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	207
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	208 return @cities;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	209 }
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 sub login
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	212 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	213 my $self = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	214
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	215 # $self->{mech}->get(sprintf('http://%s/', $self->{server}));
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	216 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	217 name => $self->{user},
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	218 password => $self->{pass},
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	219 ]);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	220 my $c;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	221 my $status = gunzip \$res->content => \$c
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	222 or die "gunzip failed: $GunzipError\n";
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	223
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	224 if($c =~ /錯誤！/)
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	225 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	226 die ("password error\n");
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	227 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	228 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	229
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	230 sub getElementsByTagName {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	231 my $element = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	232 my $tagname = lc(shift);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	233 my ( $flat, $cur ) = @$element;
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 my $out = [];
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	236 for( ; $cur <= $#$flat ; $cur++ ) {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	237 next if ( $flat->[$cur]->[001] ne $tagname );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	238 next if $flat->[$cur]->[000]; # close
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	239 my $elem = HTML::TagParser::Element->new( $flat, $cur );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	240 return $elem unless wantarray;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	241 push( @$out, $elem );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	242 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	243 return unless wantarray;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	244 @$out;
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
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	247 sub getElementsByAttribute {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	248 my $element = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	249 my $key = lc(shift);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	250 my $val = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	251 my ( $flat, $cur ) = @$element;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	252
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	253 my $out = [];
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	254 for ( ; $cur <= $#$flat ; $cur++ ) {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	255 next if $flat->[$cur]->[000]; # close
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	256 my $elem = HTML::TagParser::Element->new( $flat, $cur );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	257 my $attr = $elem->attributes();
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	258 next unless exists $attr->{$key};
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	259 next if ( $attr->{$key} ne $val );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	260 return $elem unless wantarray;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	261 push( @$out, $elem );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	262 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	263 return unless wantarray;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	264 @$out;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	265 }
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 1;

Mercurial > eagle-eye

annotate Ikariam.pm @ 6:2975a94aa7a2