FreewarWiki:Bot/Skripts/npclist.pl: Unterschied zwischen den Versionen

aus FreewarWiki, der Referenz für Freewar
Zur Navigation springen Zur Suche springen
Keine Bearbeitungszusammenfassung
 
Keine Bearbeitungszusammenfassung
Zeile 1: Zeile 1:
<pre>
#!/usr/bin/perl
#!/usr/bin/perl


Zeile 84: Zeile 85:
     }
     }
}
}
</pre>

Version vom 16. Februar 2009, 01:13 Uhr

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