Kategorien
Benutzer:Count Ypsilon/Skript:maplist.pl
Zur Navigation springen
Zur Suche springen
Skript zur Erzeugung einer einfachen, semikolon-separierten Liste aller Felder.
Spalte 1=Gebietsname (leer, falls es sich um ein nicht begehbares Grenzfeld handelt) Spalte 2=0, wenn das Feld unbegehbar ist, 1, wenn es begehbar ist Spalten 3/4=x und y Spalte 5=NPC-Name (Feld ist mehrfach in Liste, wenn mehrere NPCs, und einfach mit "none" in Spalte 4, wenn kein NPC) Spalte 6=URL des Kartenfeld-Bildes
Achtung - Grenzfelder zwischen zwei Gebieten können mehrfach in der Liste auftauchen, einmal mit gesetzten Gebietsnamen beim Gebiet, zu dem sie gehören, und vorher/nachher noch einmal mit leeren Gebietsnamen im Kontext des Gebiets, bei dem sie als Grenzfeld gelistet sind.
#!/usr/bin/perl use strict; use LWP::UserAgent; use URI::Escape; use HTTP::Request; my $ua = LWP::UserAgent->new(); my $host = "http://www.fwwiki.de"; my $url = $host . "/index.php/Kategorie:Karten"; my $unbegehbar = { "119;105" => 1, "120;105" => 1, "121;105" => 1, "119;106" => 1, "120;106" => 1, "119;107" => 1, "120;107" => 1, "119;108" => 1, "120;108" => 1, "115;109" => 1, "116;109" => 1, "117;109" => 1, "118;109" => 1, "119;109" => 1, "120;109" => 1, "113;110" => 1, "114;110" => 1, "115;110" => 1, "116;110" => 1, "117;110" => 1, "118;110" => 1, "119;110" => 1, "113;111" => 1, "114;111" => 1, "115;111" => 1, "116;111" => 1, "117;111" => 1, "115;112" => 1, "116;112" => 1, "116;113" => 1, "123;112" => 1, "123;113" => 1, "123;115" => 1, "123;116" => 1, "123;117" => 1, "72;81" => 1, "73;81" => 1, "74;81" => 1, "75;81" => 1, "70;82" => 1, "71;82" => 1, "72;82" => 1, "73;82" => 1, "74;82" => 1, "75;82" => 1, "70;83" => 1, "71;83" => 1, "72;83" => 1, "73;83" => 1, "-308;-194" => 1, "98;99" => 1, "57;98" => 1, "59;98" => 1, "81;86" => 1, "81;85" => 1, "82;85" => 1, "83;85" => 1, "80;86" => 1, "-314;-195" => 1, "-313;-195" => 1, "-314;-194" => 1, "-313;-194" => 1, "-828;-809" => 1, "-827;-809" => 1, "-828;-808" => 1, "-827;-808" => 1, }; while($url ne "") { #print "GET $url\n"; my $request = HTTP::Request->new("GET", $url); my $response = $ua->simple_request($request); my $c = $response->content(); $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+/); fetchMap($1, $host.$href) if ($text =~ /Karte:\s*(.*)/); } } sub fetchMap { my ($text, $href) = @_; my $request = HTTP::Request->new("GET", $href."?action=edit"); my $response = $ua->simple_request($request); my $c = $response->content(); my @lines = split(/\n/, $c); my $firstx; my $curx; my $cury; my $opened; my $firstline = 1; foreach my $line(@lines) { next unless ($line =~ /\{\{Karte\/([^|{}\/]+)(\/([^|{}]+))?(\|([^{}]*))?\}\}(\{\{.*\}\})?/); my ($vorlage, $sub, $argl, $more) = ($1, $3, $5, $6); my @args = split(/\|/, $argl); if (!$opened) { $opened = 1 if ($vorlage eq "Beginn"); next; } if ($vorlage eq "Ort" || $vorlage eq "Passage") # falls zusaetzliche Vorlagen in einer neuen Zeile notiert sind, naechste Zeile einlesen { next; } if ($vorlage eq "Ende") { last; } elsif ($vorlage eq "NeueZeile") { $firstline = 0; $curx = $firstx; } elsif ($vorlage eq "Koord") { if (($firstline) && (!defined($firstx))) { $firstx = $args[0]; } else { $cury = $args[0]; } } elsif ($vorlage =~ /^Feld\d*$/) { my $img = shift(@args); if ($img eq "http://welt1.freewar.de/freewar/images/map/black.jpg") { print "$text;0;$curx;$cury;;$img\n"; } else { push(@args, "none") if (scalar(@args) == 0); my $begehbar = ($unbegehbar->{"$curx;$cury"}) ? 0 : 1; foreach my $npc(@args) { if (lc($npc) eq "none") { $npc = "" }; print "$text;$begehbar;$curx;$cury;$npc;$img\n" unless ($npc =~ /^Alt=/); } } $curx++; } else { if ($vorlage eq "Berg") { my $img = "http://welt1.freewar.de/freewar/images/map/std.jpg"; print "$text;0;$curx;$cury;;$img\n"; } elsif ($vorlage eq "Grenzfeld") { my $img = shift(@args); print "$text;0;$curx;$cury;;$img\n"; } elsif ($vorlage ne "Leer") { print STDERR "unbekannt: Vorlage '$vorlage' in '$text'\n"; next; } $curx++; } } }