FreewarWiki:Bot/Skripts/loclist.pl

Dieses Script ist hier lediglich archiviert und nicht direkt lauffähig. Wenn Du es benutzen möchtest, musst Du es lokal abspeichern und mit einem geeigneten Interpreter ausführen lassen. Zum Übernehmen solltest Du nicht den unten angezeigten Text verwenden, sondern den Quelltext des Wiki-Artikels: Dazu wählst Du Bearbeiten und kopierst den (meist zwischen PRE-Tags eingefassten) Scripttext.

Sofern Du die Scripte dauerhaft lokal abgespeichert hältst, solltest Du sie vor der nächsten Ausführung darauf prüfen, ob sie noch aktuell sind.

Letzter Bearbeiter: Zabuza — Zuletzt bearbeitet: 16.07.2012

#!/usr/bin/perl

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

#Zur Verwendung in http://www.fwwiki.de/index.php/Orte_%28Liste%29
#Dieses Skript geht alle Unterkategorien in der Kategorie:Orte im FreewarWiki durch und sucht dort nach Ortsartikeln.
#Da es nur die Unterkategorien durchsucht, findet es keine Ortsartikel welche z.B. nur der Kategorie:Orte hinzugefügt
#sind aber keiner weiteren Unterkategorie, wie z.B. Bombenkreater.
#Die Ausgabe erfolgt über print und kann weitergeleitet werden.

my $ua = LWP::UserAgent->new();
my @locationList;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
my $date = sprintf("%d.%d.%04d", $mday, $mon+1, $year+1900);
my $host = "http://www.fwwiki.de";
my $url = $host . "/index.php/Kategorie:Orte";
my $intro = "<!-- ACHTUNG: Diese Seite wird von einem Bot aktualisiert. Wenn Du Veraenderungen am Aufbau dieser Seite vornimmst, hinterlasse bitte eine Nachricht auf der Diskussionsseite, sonst werden die Aenderungen vom Bot ueberschrieben. -->Diese Seite listet, nach [[Gebiet]]en geordnet, alle im Wiki eingetragenen [[Ort]]e mit deren Koordinatenangaben. (Stand $date)\n";
my $preLocation = "{{Ueberschriftensimulation 2|1={{Gebietslink|";
my $endLocation = "}}}}";
my $prePlace = "[[";
my $preX = "]]: ";
my $preY = ",";
my $seperator = "; ";
my $end = "[[Kategorie:Orte|!Orte (Liste)]]";

my $request = HTTP::Request->new("GET", $url);
my $response = $ua->simple_request($request);
my $c = $response->content();


print "$intro";


#Hole alle Links welche (Orte) im Namen enthalten
while($c =~ /<a([^>]*)>([^<]*\(Orte\))<\/a>/gm) {
	#$anchor enthält alle Attribute des a-Tags, $text enthält den Inhalt zwischen dem a-Tag
	my ($anchor, $text) = ($1, $2);
	my $href;
	#$href enthält nun den Link des Ankers
	$href = $1 if ($anchor =~ /href\s*=\s*"([^"]*)"/);
	$href =~ s/\N{U+0026}amp;/&/g;
	my $title;
	#$title enthält den Wert des title-Attributes
	$title = $1 if ($anchor =~ /title\s*=\s*"([^"]*)"/);
	#Brich ab wenn $href nicht ermittelt werden konnte
	next if ($href eq "");
	#Gehe in die Unterkategorien welche die Ortsartikel zu den Gebieten enthalten
	getUrl($text, $host.$href) if ($title eq "Kategorie:" . $text);
}


print "$end";


#Entfernt Leerzeichen vor und hinter dem String
sub trim($) {
    my $string = shift;
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;
    return $string;
}


#Sucht die Ortsartikel in den Unterkategorien
sub getUrl {
	#$location beinhaltet den Gebietsnamen
	my ($location, $href) = @_;
	$location =~ s/\(Orte\)//;
	$location = trim($location);
	#@filter beinhaltet Strings welche nicht im $title des vermeintlichen Ortsartikels enthalten sein dürfen
	my @filter = ("", "Gebiet", $location);
	#@excFilter beinhaltet alle Ausnahmen, welche durch die Filter als kein Ortsartikel markiert wurden aber doch welche sein sollen
	my @excFilter = ("Dummyplace");
	my $request = HTTP::Request->new("GET", $href);
	my $response = $ua->simple_request($request);
	my $c = $response->content();
	#Hole alle Links aus der Unterkategorie
	while($c =~ /<li><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*"([^"]*)"/);
		#$flag gibt Auskunft ob ein Link ein Ortsartikel ist, 1 für ja
		my $flag = 1;
		 if (($title eq $text)) {
			#Gehe den Filter durch, bei einem Treffer ist der Link kein Ortsartikel
			foreach(@filter) {
				if($title eq $_) {
					$flag = 0;
					#Gehe den Ausnahme Filter durch, bei einem Treffer ist der Link doch ein Ortsartikel
					foreach(@excFilter) {
						if($title eq $_) {
							$flag = 1;
						}
					}
				}
			}
			#Prüfe nochmals auf verschiedene Zeichenketten in $title
			if(($href =~ /FreewarWiki:/gm) or ($href =~ /Felder:/gm)) {
				$flag = 0;
			}
			#Wenn der Link ein Ortsartikel ist, hole seine Daten
			if($flag eq 1) {
				registerLocation($text, $host.$href, $location);
			}
		 }
	}
}


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

  my $x = CUnknown;
  my $y = CUnknown;


  #Suche die X-Koordinate aus dem Edit-Fenster
  if ($c =~ /\|\s*X\s*=\s*([\-0-9.]+)/i) {
    $x = $1;
    $x =~ s/\.//g;
  }
  
  #Suche die Y-Koordinate aus dem Edit-Fenster
  if ($c =~ /\|\s*Y\s*=\s*([\-0-9.]+)/i) {
    $y = $1;
    $y =~ s/\.//g;
  }
  # Nur ausgeben, wenn mindestens eine Eigenschaft erkannt wurde
  if (($x ne CUnknown) || $y ne CUnknown) {
  #$flag bestimmt ob ein Gebiet noch nicht aufgetreten ist, 1 für ja
  my $flag = 1;
	#Gehe alle bekannten Gebiete durch und setze ggf. $flag
	foreach(@locationList) {
		if($location eq $_) {
			$flag = 0;
		}
	}
	#Ist ein Gebiet noch nicht aufgetreten, drucke es
	if($flag eq 1) {
		print "$preLocation$location$endLocation";
		push(@locationList, $location);
	}
	#Drucke alle Daten des Ortes
	print "$prePlace$text$preX$x$preY$y$seperator";
  }
}