eagle-eye: Ikariam.pm annotate

annotate Ikariam.pm @ 1:f9eac5385dc0

added viewWorldMap

author	"Rex Tsai <chihchun@kalug.linux.org.tw>"
date	Tue, 07 Oct 2008 22:56:12 +0800
parents	abaee7064429
children	0fb73a7a0b94

rev	line source
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	1 #!/usr/bin/env perl
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	2 package Ikariam;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	3
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	4 use Data::Dumper;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	5 use LWP;
1 f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	6 # use LWP::Debug qw(+ -conns);
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	7 use HTTP::Cookies;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	8 use WWW::Mechanize;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	9 use HTML::TagParser;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	10 use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	11
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	12 sub new
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	13 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	14 my ($class, $server, $user, $pass) = @_;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	15
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	16 my $self =
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	17 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	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)"),
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	19 server => $server,
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	20 user => $user,
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	21 pass => $pass,
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
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	24 $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	25 $self->{mech}->default_headers->push_header('Accept-Encoding', 'deflate');
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 return bless $self, $class;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	28 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	29
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	30 sub viewWorldMap
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 my $self = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	33 my $x = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	34 my $y = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	35
1 f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	36 if(!defined($x) && !defined($y))
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	37 {
1 f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	38 die('location required');
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	39 }
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	40
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	41 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	42 xajax => 'getMapData',
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	43 'xajaxargs[]' => $x,
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	44 'xajaxargs[]' => $y,
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	45 xajaxr => time,
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	46 ]);
1 f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	47
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	48 my $c;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	49 my $status = gunzip \$res->content => \$c
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	50 or die "gunzip failed: $GunzipError\n";
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	51
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	52 my @islands;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	53 # parsing xjxobj
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	54 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	55 {
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	56 my %island;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	57 $island{id} = $3;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	58 $island{x} = $1;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	59 $island{y} = $2;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	60 $island{name} = $6;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	61 $island{tradegood} = $4;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	62 $island{wonder} = $5;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	63 # $7 ?
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	64 $island{people} = $8;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	65 push @islands, \%island;
0 abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	66 }
1 f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	67 return @islands;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	68 }
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	69
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	70 sub viewHomedMap
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	71 {
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	72 my $self = shift;
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	73
f9eac5385dc0 added viewWorldMap "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: 0 diff changeset	74 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	75
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	76 my $c;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	77 my $status = gunzip \$res->content => \$c
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	78 or die "gunzip failed: $GunzipError\n";
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	79
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	80 # 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	81 # x = 43-57 = 6
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	82 # y = 27-41 = 6
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	83 my @islands;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	84 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	85 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	86 my %island;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	87 $island{id} = $3;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	88 $island{x} = $1;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	89 $island{y} = $2;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	90 $island{name} = $6;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	91 $island{tradegood} = $4;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	92 $island{wonder} = $5;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	93 # $7 ?
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	94 $island{people} = $8;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	95
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	96 #foreach my $i (sort(keys(%island)))
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	97 #{
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	98 # printf ("%s %s\n", $i, $island{$i});
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	99 #}
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	100 #print("\n");
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	101 push @islands, \%island;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	102 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	103 return @islands;
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
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	106 sub viewIsland
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	107 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	108 my $self = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	109 my $island = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	110
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	111 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	112
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	113 my $c;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	114 my $status = gunzip \$res->content => \$c
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	115 or die "gunzip failed: $GunzipError\n";
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	116
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	117 my $html = HTML::TagParser->new($c);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	118 my @elems = $html->getElementsByClassName( "cityinfo" );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	119 my @cities;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	120 foreach my $elem (@elems) {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	121 my %info;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	122
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	123 my @e = getElementsByTagName($elem, "li");
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	124 $info{'cityname'} = substr($e[0]->innerText(), 8);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	125 $info{'citylevel'} = substr($e[1]->innerText(), 14);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	126 $info{'owner'} = substr($e[2]->innerText(), 8);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	127 $info{'ally'} = substr($e[3]->innerText(), 8);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	128 @e = getElementsByAttribute($elem, "class", "messageSend");
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	129 if ( $e[0]->getAttribute("href") =~ /with=(\d+)&destinationCityId=(\d+)/)
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	130 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	131 $info{'ownerId'} = $1;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	132 $info{'cityId'} = $2;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	133 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	134
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	135 push @cities, \%info;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	136 #foreach my $i (sort(keys(%info)))
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	137 #{
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	138 # printf("%s: %s ", $i, $info{$i});
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	139 # }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	140 # printf("\n");
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	141 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	142
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	143 return @cities;
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
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	146 sub login
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	147 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	148 my $self = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	149
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	150 # $self->{mech}->get(sprintf('http://%s/', $self->{server}));
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	151 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	152 name => $self->{user},
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	153 password => $self->{pass},
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 $c;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	156 my $status = gunzip \$res->content => \$c
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	157 or die "gunzip failed: $GunzipError\n";
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 if($c =~ /錯誤！/)
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	160 {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	161 die ("password error\n");
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	162 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	163 }
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 sub getElementsByTagName {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	166 my $element = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	167 my $tagname = lc(shift);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	168 my ( $flat, $cur ) = @$element;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	169
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	170 my $out = [];
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	171 for( ; $cur <= $#$flat ; $cur++ ) {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	172 next if ( $flat->[$cur]->[001] ne $tagname );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	173 next if $flat->[$cur]->[000]; # close
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	174 my $elem = HTML::TagParser::Element->new( $flat, $cur );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	175 return $elem unless wantarray;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	176 push( @$out, $elem );
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 return unless wantarray;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	179 @$out;
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
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	182 sub getElementsByAttribute {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	183 my $element = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	184 my $key = lc(shift);
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	185 my $val = shift;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	186 my ( $flat, $cur ) = @$element;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	187
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	188 my $out = [];
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	189 for ( ; $cur <= $#$flat ; $cur++ ) {
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	190 next if $flat->[$cur]->[000]; # close
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	191 my $elem = HTML::TagParser::Element->new( $flat, $cur );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	192 my $attr = $elem->attributes();
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	193 next unless exists $attr->{$key};
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	194 next if ( $attr->{$key} ne $val );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	195 return $elem unless wantarray;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	196 push( @$out, $elem );
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	197 }
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	198 return unless wantarray;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	199 @$out;
abaee7064429 new scanning prototype. "Rex Tsai <chihchun@kalug.linux.org.tw>" parents: diff changeset	200 }
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 1;

Mercurial > eagle-eye

annotate Ikariam.pm @ 1:f9eac5385dc0