FreewarWiki:Bot/Skripts/maplist.pl
- !/usr/bin/perl
use strict; use LWP::UserAgent; use URI::Escape; use HTTP::Request; use Data::Dumper;
my $ua = LWP::UserAgent->new();
my $host = "http://www.fwwiki.de"; my $url = $host . "/index.php/Kategorie:Karten";
my %mapfields;
while($url ne "") {
my $c = ""; if (scalar(@ARGV) == 0) { my $request = HTTP::Request->new("GET", $url); my $response = $ua->simple_request($request); $c = $response->content(); } else { # Doofer Hack ^.^ foreach (@ARGV) { $c .= "<a href=\"/index.php/Karte:$_\">Karte:$_</a>"; } } $url = "";
while($c =~ /<a([^>]*)>([^<]*)<\/a>/gm) { my ($anchor, $text) = ($1, $2); my $href; $href = $1 if ($anchor =~ /href\s*=\s*"([^"]*)"/); $href =~ s/&/&/g;
my $title; $title = $1 if ($anchor =~ /title\s*=\s*"([^"]*)"/); $url = $host.$href if ($text =~ /n.*chste \d+/);
next if ($text !~ /Karte:\s*(.*)/);
my @fields = fetchMap(my $area = $1, $host.$href);
foreach (@fields) { my %field = %{$_}; if (exists($mapfields{$field{"x"}}{$field{"y"}})) { my %ofield = %{$mapfields{$field{"x"}}{$field{"y"}}}; if ($field{"grenzfeld"} && $ofield{"grenzfeld"}) { $field{"accessible"} = 0; } elsif (!exists($field{"accessible"})) { $field{"accessible"} = 1; } $field{"area"} = $area unless $field{"grenzfeld"} && exists($ofield{"area"}); delete($field{"grenzfeld"}) unless ($ofield{"grenzfeld"}); $mapfields{$field{"x"}}{$field{"y"}} = {%ofield, %field}; } else { $mapfields{$field{"x"}}{$field{"y"}} = $_; $mapfields{$field{"x"}}{$field{"y"}}{"area"} = $area; } }
}
}
foreach my $x (keys(%mapfields)) {
foreach my $y (keys(%{$mapfields{$x}})) {
my %field = %{$mapfields{$x}{$y}}; push (@{$field{"npcs"}}, "") if (!exists($field{"npcs"})); push (@{$field{"passages"}}, "") if (!exists($field{"passages"})); print "$field{area};$field{accessible};$x;$y;" . join("/", @{$field{"npcs"}}) . ";$field{img};" . join("/", @{$field{"passages"}}) . "\n";
}
}
sub fetchMap {
my ($gebiet, $href) = @_; my $request = HTTP::Request->new("GET", $href."?action=edit"); my $response = $ua->simple_request($request); my $c = $response->content();
my $firstx; my $curx; my $cury; my $opened; my $firstline = 1; my @fields; my $lastfield;
while ($c =~ /\{\{Karte\/([^|{}\/]+)(\/([^|{}]+))?(\|([^{}]*))?\}\}?/ig) { my ($vorlage, $sub, $argl) = ($1, $3, $5); my @args = split(/\|/, $argl);
if (!$opened) { $opened = 1 if ($vorlage eq "Beginn"); next; } elsif ($vorlage eq "Ende") {
last;
} elsif ($vorlage eq "NeueZeile") { $firstline = 0; $curx = $firstx;
undef($lastfield);
} elsif ($vorlage eq "Koord") { if (($firstline) && (!defined($firstx))) { $firstx = $args[0]; } else { $cury = $args[0]; }
undef($lastfield);
} elsif ($vorlage =~ /^(Feld\d*|Grenzfeld)$/) {
my %field;
my $img = shift(@args);
$field{"x"} = $curx; $field{"y"} = $cury; $field{"grenzfeld"} = $vorlage eq "Grenzfeld"; $field{"img"} = $img;
if ($img =~ m"") {
$field{"accessible"} = 0; } elsif ($vorlage ne "Grenzfeld") { $field{"accessible"} = 1; foreach (@args) { push(@{$field{"npcs"}}, $_) if ($_ !~ "^(Alt=|none)"); } }
$curx++;
$lastfield = \%field; push(@fields, $lastfield);
} elsif ($vorlage eq "Berg") {
my %field; my $img = "";
$field{"x"} = $curx; $field{"y"} = $cury;
$field{"img"} = $img; $field{"accessible"} = 0;
$curx++; undef($lastfield); push(@fields, \%field); } elsif ($vorlage eq "Leer") { $curx++; undef($lastfield); } elsif ($vorlage eq "Passage" && $sub ne "Zufall") { if (!$lastfield) { print "Fehler: Passage ohne zugehoeriges Feld spezifiziert"; next; } my ($x, $y); foreach (@args) { $x = $1 if (/X\s*?=\s*?(.*)/i); $y = $1 if (/Y\s*?=\s*?(.*)/i); } if (!$x || !$y) { print STDERR "Warnung: Keine Koordinatenangabe in Passage von $gebiet nach $argl\n"; next;
}
push(@{$lastfield->{"passages"}}, "$x,$y"); }
}
return @fields;
}