Radreise-Wiki:MakeKML.pl

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';
 			}
 		}
 	}
 }