Benutzer:Count Ypsilon/Skript:npclist.pl

Dieses Skript erzeugt eine Liste aller im Wiki verzeichneten NPCs. In der Ausgabedatei steht jede Zeile für ein NPC und hat den Inhalt

NPC-Name;Angriffsstärke;LP;XP;GM;Vorkommen;Drops

Vorkommen ist dabei eine durch / separierte Liste der unter "Vorkommen" gelisteten Gebiete. Falls explizite Felder gelistet sind, werden diese im Vorkommen in der Form X,Y verzeichnet.

Das Skript arbietet nun mit dem Source der Wiki-Seiten, ist dafür allerdings auf die Verwendung der NPC-Vorlagen angewiesen. Für NPCs, die die Vorlage emulieren, muss ein Extra-Datenblock eingebaut werden, siehe z.B. Quelltext von Windgeist (Quest).

 #!/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:NPCs";
 
 while($url ne "")
 {
     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+/);
         next if ($href eq "");
         registerNpc($text, $host.$href) if ($title eq $text);
     }
 }
 
 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;
     my $xp;
     my $lp;
     my $gm;
     my $drops;
     my @vklist;
     my @itemlist;
 
     $atk = $1 if ($c =~ /\|\s*St..?rke\s*=\s*(\d+)/);
     $lp = $1.$3 if ($c =~ /\|\s*Lebenspunkte\s*=\s*(\d+)(\.(\d+))?/);
     $xp = $1 if ($c =~ /\|\s*XP\s*=\s*(\d+)/);
     $gm = $1 if ($c =~ /\|\s*Gold\s*=\s*(\d+)/);
 
     if ($c=~ /\|Vorkommen\s*=\s([^=]*)/)
     {
         my $vk=$1;
         while ($vk =~ /\[\[([^\]]+)\]\]/ogm)
         { 
             my $area = $1;
             $area = $1 if ($area =~ /(.*)\|/);
             push(@vklist, $area);
         }
     }
     if ($c=~ /\|Items\s*=\s([^=]*)/)
     {
         my $it=$1;
         while ($it =~ /\[\[([^\]]+)\]\]/ogm)
         {
             push(@itemlist, $1);
         }
     }
     while ($c=~/\{\{Feld\|[^|]+\|[^|]+\|(\d+)\|(\d+)\}\}/ogm)
     {
         push(@vklist, "$1,$2");
     }
 
     if ($atk>0)
     {
         print "$text;$atk;$lp;$xp;$gm;";
         print join("/", @vklist);
         print ";";
         print join("/", @itemlist);
         print "\n";
     }
 }