Radreise-Wiki:MakeKML.pl
Aus Radreise-Wiki
Version vom 7. September 2011, 12:32 Uhr von Jmages (Diskussion | Beiträge)
Das Perl-Skript makeKML.pl wird mit dem Streckennamen als Parameter aufgerufen. Die zugehörige Streckendatei muss bereits im text- und die Trackdatei im track-Verzeichnis vorhanden sein. Beispiel für einen Aufruf:
perl makeKML.pl Donau
Das Skript fasst die Informationen aus dem Roadbook und dem Track zusammen und generiert eine GoogleEarth kompatible KML-Datei. Diese wird im kml-Verzeichnis gespeichert. Zusätzlich wird eine kmz-Datei im Output-Verzeichis (siehe ini.pl) gespeichert. Diese Datei kann manuell ins Wiki hochgeladen werden.
use strict;
# Encoding Stuff
use Encode qw(encode decode);
my $encoding = 'utf-8';
my $encOut;
$encOut = 'cp1252'; # Windows Ansi
$encOut = 'cp850' ; # DOS Fenster
use URI::Escape qw( uri_escape_utf8 );
use CGI;
my $cgi = new CGI;
# Default Directories
require "ini.pl";
my ($baseDir, $outDir, $username, $password) = getIni();
my $routeFileName = "";
my $routeURL = "";
if ($#ARGV != -1) {
$routeFileName = join " ", @ARGV;
if ($routeFileName =~ / \($/) {
$routeFileName .= "retour)";
}
my $urlstring = uri_escape_utf8($routeFileName);
$urlstring =~ s/%20/\_/g;
$urlstring =~ s/\(/%28/g;
$urlstring =~ s/\)/%29/g;
$urlstring =~ s/\'/%27/g;
$routeURL = $urlstring;
} else {
my @content;
open FIN, "$baseDir/RouteList.txt" or die "$! : $baseDir/RouteList.txt";
while (<FIN>) { push @content, decode $encoding, $_; }
close (FIN);
my @content_s = reverse sort @content;
my ($dateTXT, $dateKML, $type, $name, $url) = split " :: ", $content_s[0];
$routeFileName = $name;
$url =~ s/\n//;
$routeURL = $url;
}
my $routeFileName_e = encode 'cp1252', $routeFileName;
print encode $encOut, "\n>$routeFileName<\n";
print encode $encOut, ">$routeURL<\n";
#=================
# Reading Trackfile
open FIN, "$baseDir/tracks/$routeFileName_e.txt" or die "$! : $baseDir/tracks/$routeFileName_e.txt";
my $track = <FIN>;
close (FIN);
open FIN, "$baseDir/text/$routeFileName_e.txt" or die "$! : $baseDir/text/$routeFileName_e.txt";
my $ucontent = "";
while (<FIN>) { $ucontent .= $_; }
close FIN;
my $content = decode ($encoding, $ucontent);
if ($content !~ /
{{TOC_Radfernweg}}\n
.*
\n==\ Roadbook\ ==\n
.*
\n==\ GPS-Tracks\ ==\n
.*
\[\[Kategorie:\s*(
Fluss-Radfernweg|
Anderer\ Radfernweg|
Querverbindung|
Direktverbindung|
Fernroute|
Regionaler\ Radwanderweg|
Routenplaner\ Testroute|
Streckenvorschlag|
Stadtrundfahrt
)\]\]
/xs) {
print encode $encOut, "Chapters in $routeFileName are not correct!\n";
exit(1);
}
my @content = split "\n", $content;
my @routeFile = ();
push @routeFile, "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
push @routeFile, "<kml xmlns=\"http://www.opengis.net/kml/2.2\">\n";
push @routeFile, "<Document>\n";
push @routeFile, " <name>$routeFileName</name>\n";
push @routeFile, " <Metadata>\n";
push @routeFile, " <![CDATA[<!--$routeURL-->]]>\n";
push @routeFile, " </Metadata>\n";
push @routeFile, " <open>0</open>\n";
push @routeFile, " <Placemark>\n";
push @routeFile, " <name>$routeFileName GPS-Track</name>\n";
push @routeFile, " <description>\n";
push @routeFile, " <![CDATA[<a href=\"http://radreise-wiki.de/$routeURL\">Wiki</a>]]> \n";
push @routeFile, " </description>\n";
push @routeFile, " <Style>\n";
push @routeFile, " <LineStyle>\n";
push @routeFile, " <color>ffff00ff</color>\n";
push @routeFile, " <width>2</width>\n";
push @routeFile, " </LineStyle>\n";
push @routeFile, " </Style>\n";
push @routeFile, " <LineString>\n";
push @routeFile, " <tessellate>1</tessellate>\n";
push @routeFile, " <coordinates>\n";
push @routeFile, " $track\n";
push @routeFile, " </coordinates>\n";
push @routeFile, " </LineString>\n";
push @routeFile, " </Placemark>\n";
push @routeFile, " <Folder>\n";
push @routeFile, " <name>Orte</name>\n";
push @routeFile, " <open>0</open>\n";
my $roadBook = 0;
my $place = 0;
my $touri = 0;
my $geo = 0;
my $lon = 0;
my $lat = 0;
my $alt = 0;
my $road = 0;
my $kilo = 0;
my $placeName = "";
my %placeName = ();
my $touriInfo = "";
my $geoData = "";
my $roadInfo = "";
my $kilometer = "";
foreach my $line (@content) {
# Last Placemark is finished, Roadbook is finished
if (($roadBook) and ($line =~ /^== .* ==$/)) {
# Status-Übersicht
if ($touriInfo ne "") { $touri = 1; }
if ($roadInfo ne "") { $road = 1; }
my $placeNameURL = $cgi->escape($placeName);
$placeNameURL =~ s/\%20/\_/g;
$placeNameURL =~ s/\%/\./g;
if ($placeName{$placeName} > 1) {
$placeNameURL .= "_$placeName{$placeName}";
}
push @routeFile, " <Placemark>\n";
push @routeFile, " <name>$placeName</name>\n";
push @routeFile, " <visibility>0</visibility>\n";
push @routeFile, " <description>\n";
push @routeFile, " <![CDATA[<a href=\"http://radreise-wiki.de/$routeURL#$placeNameURL\">$routeFileName</a>]]> \n";
push @routeFile, " </description>\n";
push @routeFile, " <Point>\n";
push @routeFile, " <coordinates>\n";
push @routeFile, " $lon,$lat,$alt\n";
push @routeFile, " </coordinates>\n";
push @routeFile, " </Point>\n";
push @routeFile, " </Placemark>\n";
$roadBook = 0;
$place = 0;
$touri = 0;
$geo = 0;
$lon = 0;
$lat = 0;
$alt = 0;
$road = 0;
$kilo = 0;
$placeName = "";
%placeName = ();
$touriInfo = "";
$geoData = "";
$roadInfo = "";
$kilometer = "";
# Start of Roadbook
} elsif ($line =~ /^== Roadbook ==$/) {
$roadBook = 1;
# A new Place within the Roadbook
} elsif ($roadBook and ($line =~ /^=== (.*) ===$/)) {
if ($place and not $kilo) {
print " No Kilometers: $routeFileName :: $placeName\n";
#exit;
}
# Save previous place
if ($place) {
# Status-Übersicht
if ($touriInfo ne "") { $touri = 1; }
if ($roadInfo ne "") { $road = 1; }
my $placeNameURL = $cgi->escape($placeName);
$placeNameURL =~ s/\%20/\_/g;
$placeNameURL =~ s/\%/\./g;
if ($placeName{$placeName} > 1) {
$placeNameURL .= "_$placeName{$placeName}";
}
push @routeFile, " <Placemark>\n";
push @routeFile, " <name>$placeName</name>\n";
push @routeFile, " <visibility>0</visibility>\n";
push @routeFile, " <description>\n";
push @routeFile, " <![CDATA[<a href=\"http://radreise-wiki.de/$routeURL#$placeNameURL\">$routeFileName</a>]]> \n";
push @routeFile, " </description>\n";
push @routeFile, " <Point>\n";
push @routeFile, " <coordinates>\n";
push @routeFile, " $lon,$lat,$alt\n";
push @routeFile, " </coordinates>\n";
push @routeFile, " </Point>\n";
push @routeFile, " </Placemark>\n";
}
$place = 1;
$touri = 0;
$geo = 0;
$lon = 0;
$lat = 0;
$alt = 0;
$road = 0;
$kilo = 0;
$placeName = $1;
if (defined $placeName{$placeName}) {
$placeName{$placeName}++;
} else {
$placeName{$placeName} = 1;
}
$touriInfo = "";
$geoData = "";
$roadInfo = "";
$kilometer = "";
#print "$routeFileName :: $placeName\n";
# Geodata within the Placemark
} elsif ($place and ($line =~ /^{{Geodaten\|(.*)}}$/)) {
$geo = 1;
$geoData = $1;
if ($geoData =~ /^([-]?\d+\.\d+)\|([-]?\d+\.\d+)\|([-]?\d+)\|([^\|]+)$/) {
$lat = $1;
$lon = $2;
$alt = $3;
} else {
print "Error in Geodata: $geoData\n";
exit;
}
#print " $geoData\n";
# Kilometrierung within Placemark
} elsif ($place and ($line =~ /^{{Kilometrierung\|(.*)}}$/)) {
if (not $geo) {
print "No Coordinates: $routeFileName :: $placeName\n";
exit;
}
if ($kilo) {
print " Multiple Kilometers: $routeFileName :: $placeName\n";
#exit;
}
$kilo = 1;
$kilometer = $1;
#print " $kilometer\n";
# KilometrierungHm within Placemark
} elsif ($place and ($line =~ /^{{KilometrierungHm\|(.*)}}$/)) {
if (not $geo) {
print "No Coordinates: $routeFileName :: $placeName\n";
exit;
}
if ($kilo) {
print " Multiple Kilometers: $routeFileName :: $placeName\n";
#exit;
}
$kilo = 1;
$kilometer = $1;
#print " $kilometer\n";
# Empty Line
} elsif ($line =~ /^\s*$/) {
} elsif ($line =~ /<br style="clear:both" \/>/) {
} elsif ($line =~ /\[\[Bild/) {
} elsif ($place and not $geo and not $kilo) {
$touriInfo .= "$line\n";
#print " $line\n";
} elsif ($place and $geo and not $kilo) {
$roadInfo .= "$line\n";
#print " $line\n";
}
}
push @routeFile, " </Folder>\n";
push @routeFile, "</Document>\n";
push @routeFile, "</kml>\n";
my $content = "";
foreach my $line (@routeFile) {
$content .= $line;
}
my $exitCode =0;
&saveFileIfChangedOrNew ("$baseDir/kml/", "$routeFileName_e.kml", encode ($encoding, $content), 1);
print "\n";
exit($exitCode);
#==========================================================
#==========================================================
use Digest::MD5;
qw(md5_hex);
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
sub saveFileIfChangedOrNew {
(my $path, my $fileName, my $file, my $kmz) = @_;
if (open(FILE, "< $path$fileName")) {
my $md5 = Digest::MD5->new;
while (<FILE>) {
$md5->add($_);
}
close(FILE);
my $md5_old = $md5->hexdigest;
$md5 = Digest::MD5->new;
$md5->add($file);
my $md5_new = $md5->hexdigest;
unless ($md5_old eq $md5_new) {
print encode $encOut, "****************** Overwriting file $fileName ******************\n";
open FT,"> $path$fileName";
print FT $file;
close FT;
$exitCode = 1;
if ($kmz) {
my $zip = Archive::Zip->new();
$zip->addFile("$path$fileName","doc.kml");
$fileName =~ s/\.kml/\.kmz/;
unless ( $zip->writeToFileNamed("$outDir/$fileName") == AZ_OK ) {
die 'write error';
}
}
}
} else {
print encode $encOut, "****************** Creating new file $fileName ******************\n";
open FT,"> $path$fileName";
print FT $file;
close FT;
$exitCode = 1;
if ($kmz) {
my $zip = Archive::Zip->new();
$zip->addFile("$path$fileName","doc.kml");
$fileName =~ s/\.kml/\.kmz/;
unless ( $zip->writeToFileNamed("$outDir/$fileName") == AZ_OK ) {
die 'write error';
}
}
}
}
# =========================================================
