Kategorien
FreewarWiki:Bot/Skripts/maplist.pl: Unterschied zwischen den Versionen
< FreewarWiki:Bot | Skripts
(Anpassung wegen brennendem Pensal --Three) |
Zabuza (Diskussion | Beiträge) (analog, skript repariert, ersetzte && durch &, gedacht war sicherlich & durch & ersetzen) |
||
(3 dazwischenliegende Versionen von 3 Benutzern werden nicht angezeigt) | |||
Zeile 1: | Zeile 1: | ||
{{Scriptquelltextverwendung}} | |||
<pre> | <pre> | ||
#!/usr/bin/perl | #!/usr/bin/perl | ||
Zeile 33: | Zeile 34: | ||
my $href; | my $href; | ||
$href = $1 if ($anchor =~ /href\s*=\s*"([^"]*)"/); | $href = $1 if ($anchor =~ /href\s*=\s*"([^"]*)"/); | ||
$href =~ s/ | $href =~ s/\N{U+0026}amp;/&/g; | ||
my $title; | my $title; | ||
Zeile 129: | Zeile 130: | ||
} elsif ($vorlage eq "Berg") { | } elsif ($vorlage eq "Berg") { | ||
my %field; | my %field; | ||
my $img = "http:// | my $img = "http://welt1.freewar.de/freewar/images/map/std.jpg"; | ||
$field{"x"} = $curx; | $field{"x"} = $curx; |
Aktuelle Version vom 20. März 2012, 16:37 Uhr
#!/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/\N{U+0026}amp;/&/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) { if ($vorlage eq "Beginn") { $opened = 1; return () if $argl =~ /(^|\|)(Veraltete Karte|Alternative)=/; } 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"http://\d+.\d+.\d+.\d+/freewar/images/map/black.jpg") { $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 = "http://welt1.freewar.de/freewar/images/map/std.jpg"; $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; }