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"http://\d+.\d+.\d+.\d+/freewar/images/map/black.jpg") {
		$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 = "http://85.10.193.197/freewar/images/map/std.jpg";

            $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;

}