Radreise-Wiki:Campingplatz.pl

Folgendes Perl-Skript erstellt eine Übersichtskarte aller Campingplätze, soweit diese mit Geokoordinaten versehen sind. Es benutzt eine Konfigurationsdatei (siehe unten, deren Name zu Beginn in die Variable $configfile einzutragen ist. Aufrufsyntax:

• ohne weitere Parameter: lädt die konfigurierten Wiki-Seiten herunter und erzeugt lokal die Zieldatei mit allen Campingplatz-Koordinaten.
• -l sorgt für automatischen Login ins Wiki, dafür müssen Username und Passwort in die Konfigurationsdatei eingetragen werden. Ist aber nur zum automatisierten Hochladen notwendig (und nur, wenn der lokal gespeicherte Cookie dafür abgelaufen ist).
• -u lädt die lokal erzeugte Zieldatei ins Wiki hoch.

Skript und Konfigurationsdatei sollten UTF-8-kodiert abgespeichert sein.

Skript

#!/usr/bin/perl -w

use utf8;
use WWW::Mechanize;
use HTTP::Cookies;
use URI::Escape;
$| = 1;

############################################################################

$configfile = "/pfad/zu/campingplatz.rc";

############################################################################

binmode STDOUT,":encoding(UTF-8)";

# Optionen
$login = $upload = 0;
$generate = 1;

while ($arg = shift @ARGV)
{
	$login = 1 if $arg eq "-l";
	$upload = 1 if $arg eq "-u";
	$generate = 0 if $arg eq "-u";
}

# Settings
read_config($configfile);

# Initialisieren von Mechanize-Browser und Cookie-Jar
my $mech = WWW::Mechanize->new(autocheck => 1);
$mech->agent_alias('Windows Mozilla');
my $cookie_jar = HTTP::Cookies->new(file => "cookies.txt", autosave => 1);
$mech->cookie_jar($cookie_jar);

# Einloggen ins Radreise-Wiki (falls verlangt)
if ($login)
{
	print STDOUT "logging in...";
	$mech->get("http://www.radreise-wiki.de/Spezial:Userlogin");
	$mech->form_number('1');
	$mech->field("wpName",$config_username);
	$mech->field("wpPassword",$config_password);
	$mech->tick('wpRemember','1');
	$mech->click();
}

# Dateien lesen und CP-Verzeichnis generieren
if ($generate)
{
	@pl = ();
	for my $page (@config_pages) { read_page($page); }
	genkml($config_targetdir."/".$config_kmz) if $config_kmz;
}

# Hochladen (bei Fehlschlag mit -l versuchen)
if ($upload)
{
	upload_file($config_kmz) if $config_kmz;
}

print STDOUT "done.\n";

exit 0;

############################################################################

sub read_config
{
	my $filename = shift;

	$config_username = "";
	$config_password = "";
	$config_targetdir = "";
	$config_kmz = "";
	@config_pages = ();
	$pagesection = 0;

	open FD,$filename or die "configuration file $filename not found";
	binmode FD,':encoding(UTF-8)';
	while (<FD>)
	{
		tr/\015\012//d;
		next if /^#/;		# Kommentar
		next if /^\s*$/;	# leere Zeile

		if ($pagesection)
		{
			s/^\s+|\s+$//g;
			push @config_pages,$_;
			next;
		}

		if (/(.*?)=(.*)/)
		{
			my ($field,$data) = ($1,$2);
			$field =~ s/^\s+|\s+$//g;
			$data =~ s/^\s+|\s+$//g;
			$config_username = $data if $field eq "username";
			$config_password = $data if $field eq "password";
			$config_targetdir = $data if $field eq "targetdir";
			$config_kmz = $data if $field eq "kmz";
			next;
		}

		if (/^\s*\[pages\]\s*$/) { $pagesection = 1; }
	}
}

sub read_page
{
	my $page = shift;

	print STDOUT "downloading ($page)...";
	my $url = "http://radreise-wiki.de/".uri_escape_utf8($page);
	$mech->get($url);

	print STDOUT " parsing...";
	my $website = $mech->content;
	my @lines = split(/\n/,$website);
	my $loc = 0;
	my $target = $url;

	while (defined(my $line = shift @lines))
	{
		$line =~ tr/\015\012//d;

		if ($line =~ /<span class="mw-headline" id="(.*?)">/) {
			$target = $url."#".$1;
		}
		next unless $line =~ /^(<ul>)?<li>(.*mlat.*mlon.*)<\/li>/;

		$loc += readcp($2,$target);
	}
	printf " found %d placemark%s\n",$loc,(($loc == 1)? "" : "s");
}

sub readcp
{
	my ($inhalt,$target) = @_;

	my ($long) = ($inhalt =~ /mlon=(-?[\d.]*)/);
	my ($lat) = ($inhalt =~ /mlat=(-?[\d.]*)/);
	return 0 unless defined($long) && $long;
	return 0 unless defined($lat) && $lat;
	my ($name) = ($inhalt =~ /<b>(.*?)<\/b>/);
	$name = "" unless defined($name);
	$inhalt =~ s,<a rel="nofollow" class="external text" href="http://www.openstreetmap.org.*?>Karte</a>,,;
	$inhalt =~ s,<a href="/,<a href="http://radreise-wiki.de/,g;
	$inhalt .= "<p><a href=\"$target\">Zur Beschreibungsseite</a>";

	my $plm={ name => $name, long => $long, lat => $lat, text => $inhalt };
	push @pl,$plm;
	return 1;
}

sub upload_file
{
	my $filename = shift;
	my $path = $config_targetdir . "/" . $filename;

	print STDOUT "uploading $path...\n";
	$mech->get("http://www.radreise-wiki.de/Spezial:Upload");
	$mech->form_id('mw-upload-form');
	$mech->field("wpUploadFile",$path);
	$mech->field("wpDestFile",$filename);
	$mech->field("wpUploadDescription","Automatischer Upload");
	$mech->current_form->find_input('wpIgnoreWarning')->value("on");
	$mech->click();
}

############################################################################

sub genkml
{
	my $filename = shift;

	my $kml = new Kml("Campingplätze");
	my $style = new Style("campground","ffffffff",0.6);
	my $cnt = 0;

	for my $p (@pl)
	{
		my $name = $p->{'name'};
		my $long = $p->{'long'};
		my $lat = $p->{'lat'};
		my $inhalt = $p->{'text'};
		my $plm = new Placemark($kml,$kml,$name,$style,$long,$lat);
		$plm->text($inhalt);
		$cnt++;
	}

	print STDOUT "writing kmz file with $cnt placemarks...\n";
	$kml->write_kmz($filename);
}

############################################################################

package Kml;

use Archive::Zip qw(:CONSTANTS);
use File::Temp;

sub new
{
	my $class = shift;
	my $self = {};
	$self->{NAME} = shift;
	%{$self->{STYLES}} = ();
	@{$self->{OBJECTS}} = ();
	bless ($self,$class);
	return $self;
}

sub add
{
	my $self = shift;
	push @{ $self->{OBJECTS} }, shift;
}

sub regStyle
{
	my $self = shift;
	my $style = shift;
	$self->{STYLES}{$style} = $style;
}

sub write
{
	my $self = shift;
	my $io = shift;
	print $io "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n",
		"<kml xmlns=\"http://www.opengis.net/kml/2.2\"",
		" xmlns:gx=\"http://www.google.com/kml/ext/2.2\"",
		" xmlns:kml=\"http://www.opengis.net/kml/2.2\"",
		" xmlns:atom=\"http://www.w3.org/2005/Atom\">\n",
		"<Document>\n","\t<name>",$self->{NAME},"</name>\n";

	for my $s (keys %{$self->{STYLES}})
	{
		my $style = $self->{STYLES}{$s};
		$style->write($io);
	}

	for my $o (@{$self->{OBJECTS}}) { $o->write($io); }

	print $io "</Document>\n";
	print $io "</kml>\n";
}

sub write_kmz
{
	my $self = shift;
        my $tgt = shift;
	my $cont;
	my $io = File::Temp->new;

	binmode $io,':encoding(UTF-8)';
	$self->write($io);
	binmode $io;

	my $len = tell $io;
	seek $io,0,SEEK_SET;
	read $io,$cont,$len;
	close $io;

	my $zip = Archive::Zip->new();
	$zip->addString($cont,'doc.kml')
		->desiredCompressionMethod(COMPRESSION_DEFLATED);
	$zip->writeToFileNamed($tgt);
}

############################################################################

package Placemark;

sub new
{
	my $class = shift;
	my $kml = shift;
	my $parent = shift;
	my $self = {};
	$self->{KML} = $kml;
	$self->{NAME} = shift;
	$self->{STYLE} = shift;
	$self->{LONG} = shift;
	$self->{LAT} = shift;
	$self->{TEXT} = undef;
	bless ($self,$class);
	$parent->add($self);
	$kml->regStyle($self->{STYLE});
	return $self;
}

sub text
{
	my $self = shift;
	$self->{TEXT} = shift;
}

sub write
{
	my $self = shift;
	my $io = shift;
	my $style = $self->{STYLE};

	print $io "\t\t<Placemark>\n",
		"\t\t\t<name>",$self->{NAME},"</name>\n";
	print $io "\t\t\t<description><![CDATA[",$self->{TEXT},
		"]]></description>\n" if defined($self->{TEXT});
	print $io "\t\t\t<styleUrl>#",$style->name,"</styleUrl>\n",
		"\t\t\t<Point><coordinates>",$self->{LONG},",",$self->{LAT},
			",0</coordinates></Point>\n",
		"\t\t</Placemark>\n";
}

###########################################################################

package Style;

$stylecount = 0;

sub new
{
	my $class = shift;
	my $self = {};
	$self->{NAME} = sprintf "style%03d",++$stylecount;
	$self->{IMAGE} = shift;
	$self->{COLOR} = shift;
	$self->{SIZE} = shift;
	bless ($self,$class);
	return $self;
}

sub name { shift->{NAME}; }

sub write {
	my $self = shift;
	my $io = shift;
	my $bigsize = sprintf "%.3f",$self->{SIZE}*1.3;
	print $io "\t<StyleMap id=\"",$self->{NAME},"\">\n",
		"\t\t<Pair>\n",
		"\t\t\t<key>normal</key><styleUrl>#",$self->{NAME},
				"_normal</styleUrl>\n",
		"\t\t</Pair>\n",
		"\t\t<Pair>\n",
		"\t\t\t<key>highlight</key><styleUrl>#",$self->{NAME},
				"_highlight</styleUrl>\n",
		"\t\t</Pair>\n",
		"\t</StyleMap>\n",
		"\t<Style id=\"",$self->{NAME},"_normal\">\n",
		"\t\t<IconStyle>\n",
		"\t\t\t<color>",$self->{COLOR},"</color>\n",
		"\t\t\t<scale>",$self->{SIZE},"</scale>\n",
		"\t\t\t<Icon><href>http://maps.google.com/mapfiles/kml/shapes/",
				$self->{IMAGE},".png</href></Icon>\n",
		"\t\t</IconStyle>\n",
		"\t\t<LabelStyle><scale>0</scale></LabelStyle>\n",
		"\t</Style>\n",
		"\t<Style id=\"",$self->{NAME},"_highlight\">\n",
		"\t\t<IconStyle>\n",
		"\t\t\t<color>",$self->{COLOR},"</color>\n",
		"\t\t\t<scale>",$bigsize,"</scale>\n",
		"\t\t\t<Icon><href>http://maps.google.com/mapfiles/kml/shapes/",
				$self->{IMAGE},".png</href></Icon>\n",
		"\t\t</IconStyle>\n",
		"\t</Style>\n";
}

Konfigurationsdatei

Diese Datei heißt typischerweise campingplatz.rc, ihr Pfad ist in $configfile einzutragen.

# Nur nötig zum automatisierten Hochladen
username = ...
password = ...

# Zieldateien (Dateien relativ zu targetdir)
targetdir = /pfad/wo/die/Zieldateien/hin/sollen
kmz = Campingplatz.kmz

# Zu durchsuchende Wiki-Seiten, bei Bedarf erweitern
[pages]
Empfehlenswerte Campingplätze

Auvergne
Bretagne
Burgund
Elsass
Franche-Comté
Haute-Normandie
Île-de-France
Korsika
Languedoc-Roussillon
Lothringen
Provence-Alpes-Côte d'Azur
Rhône-Alpes