FreewarWiki:Bot/Skripts/maplist.pl

1. !/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;

}