Bearbeiten von „FreewarWiki:Bot/Skripts/loclist.pl“

{{Scriptquelltextverwendung}}
<pre>
#!/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 = "https://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";
  }
}
</pre>