FreewarWiki:Bot/Skripts/npclist.pl

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

}