Benutzer:Count Ypsilon/Skript:maplist.pl

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++;
        }
    }
}