FreewarWiki:Bot/Skripts/npclist.pl

#!/usr/bin/perl

use strict;
use LWP::UserAgent;
use URI::Escape;
use HTTP::Request;
use constant CUnknown => "?";

my $ua = LWP::UserAgent->new();
my $host = "http://www.fwwiki.de";
my $url = $host . "/index.php/Kategorie:NPCs";
my @urllist;




push(@urllist, $url);


# als erstes die URLs aufsammeln, die auf die aufeinanderfolgenden Kategorieseiten verweisen:
while($url ne "")  {
    my $request = HTTP::Request->new("GET", $url);
    my $response = $ua->simple_request($request);
    my $c = $response->content();


    $url = "";
    if ($c =~ /(<a [^>]*Kategorie:NPCs[^<]*)(n[^<]*chste \d+)/im) { # Zeichenkette mit der Angabe "nächste n" ermitteln
        # $1 enthält jetzt die URL im Format <a ... href="..." ... >
        $c = $1;
        # print "HTML-URL: " . $c . "\n";
        if ($c =~ /href=\"([^\"]*)/im) { # ... aus href="..." rausfummeln
             $url = $host . $1;
             $url =~ s/&/&/g;
             push(@urllist, $url);
        }
    }
}

# Nun die Kategorieseiten abarbeiten:

foreach (@urllist) {
    my $request = HTTP::Request->new("GET", $_);
    my $response = $ua->simple_request($request);
    my $c = $response->content();

    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*"([^"]*)"/);
        next if ($href eq "");
        registerNpc($text, $host.$href) if ($title eq $text);
    }
}

sub trim($) {
    my $string = shift;
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;
    return $string;
}


sub registerNpc {
  my ($text, $href) = @_;
  my $request = HTTP::Request->new("GET", $href."?action=edit");
  my $response = $ua->simple_request($request);
  my $c = $response->content();
  $c =~ tr/\n/ /;

  my $atk = CUnknown;
  my $xp = CUnknown;
  my $lp = CUnknown;
  my $gm = CUnknown;
  my $drops;
  my @vklist;
  my @itemlist;
  my $bild;
  my $bildautor;


  if ($c =~ /\|\s*St..?rke\s*=\s*([0-9.]+)/i) {
    $atk = $1;
    $atk =~ s/\.//g;
  }
  
  if ($c =~ /\|\s*Lebenspunkte\s*=\s*([0-9.]+)/i) {
    $lp = $1;
    $lp =~ s/\.//g;
  }

  $xp = $1 if ($c =~ /\|\s*XP\s*=\s*(\d+)/i);
  $gm = $1 if ($c =~ /\|\s*Gold\s*=\s*(\d+)/i);
  $bild = trim($1) if ($c =~ /\|\s*Bild\s*=\s*([^|}]*)/i);
  $bildautor = trim($1) if ($c =~ /\|\s*Bildautor\s*=\s*([^|}]*)/i);

  if ($c=~ /\|Vorkommen\s*=\s([^=]*)/) {
      my $vk=$1;
      while ($vk =~ /\*\s*\[\[([^\]]+)\]\]/ogm)
      {
          my $area = $1;
          $area = $1 if ($area =~ /(.*)\|/);
          push(@vklist, $area);
      }
  }
  if ($c=~ /\|Items\s*=\s([^=]*)/) {
      my $it=$1;
      while ($it =~ /\*\s*\[\[([^\]]+)\]\]/og) 
      {
          push(@itemlist, $1);
      }
  }
  while ($c=~/\{\{Feld\|[^|]+\|[^|]+\|(\d+)\|(\d+)\}\}/ogm) {
      push(@vklist, "$1,$2");
  }
  # nur ausgeben, wenn mindestens eine Eigenschaft erkannt wurde:
  if (($atk ne CUnknown) || $xp ne CUnknown || $lp ne CUnknown || $gm ne CUnknown) {
    print "$text;$atk;$lp;$xp;$gm;";
    print join("/", @vklist);
    print ";";
    print join("/", @itemlist);
    print ";$bild;$bildautor";
    print "\n";
  }

}