Radreise-Wiki:Km.pl

Das Perl-Skript km.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 km.pl Donau

Das Skript berechnet die Kilometrierung und speichert das Ergebnis als Datei im Output-Verzeichnis (siehe ini.pl). Die Datei "Donau_new.tx" enthält das neue Roadbook und kann mit einem UTF8-fähigen Texteditor geöffnet und direkt in das Edit-Fenster des Streckenartikels kopiert werden. Die Datei "Donau_ret.tx" beinhaltet ein neues Retour-Roadbook und wird nur gebraucht, wenn ein neues Retour-Roadbook erstellt werden soll.

 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 );
 
 # Default Directories
 require "ini.pl";
 my ($baseDir, $outDir, $username, $password) = getIni();
 
 my $routeFileName = "";
 
 if ($#ARGV != -1) {
 
 	$routeFileName = join " ", @ARGV;
 
 	if ($routeFileName =~ / \($/) { 
 	
 		$routeFileName .= "retour)";
 	}
 
 } 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;
 }
 
 my $routeFileName_e = encode 'cp1252', $routeFileName;
 
 #===================
 # Reading Trackfile
 
 print encode $encOut, "\nReading $routeFileName:\n\n";
 
 open FIN, "$baseDir/tracks/$routeFileName_e.txt" or die "$! : $baseDir/tracks/$routeFileName_e.txt";
 my $rawTrack = <FIN>;
 close (FIN);
 
 my @rawTrack = split " ", $rawTrack;
 my @track = ();
 
 foreach (@rawTrack) {
 
 	my ($lon, $lat, $alt) = split ",";
 
 	my @zeile     = ( $lat, $lon, $alt );
 	my $ref_zeile = \@zeile;
 
 	push @track, $ref_zeile;
 }
 
 #==========================
 # x-fache Glättung der Höhen
 
 for (my $j = 1; $j <= 12; $j++) {
 	for (my $i = 1; $i < $#track ; $i++) {	
 
 		my $avgAlt = ($track[$i-1][2] + $track[$i][2] + $track[$i+1][2]) / 3;
 		
 		$track[$i][2] = $avgAlt;
 
 	}
 }
 
 #=====================
 # Tracklänge berechnen
 
 my $length_0 = getDistance (
 
 	$track[0][0],           # Erster Punkt : lat
 	$track[0][1],           # Erster Punkt : lon
 	$track[$#rawTrack][0],  # Letzter Punkt: lat
 	$track[$#rawTrack][1]   # Letzter Punkt: lon
 );
 	
 my $length_1 = 0;
 
 for (my $i = 0; $i < $#track ; $i++) {	
 
 	my $dist = getDistance ( 
 	
 		$track[$i][0], 
 		$track[$i][1], 
 		$track[$i+1][0], 
 		$track[$i+1][1] 
 	);
 		
 	$length_1 += $dist;
 }
 
 #=============================
 # Gesamt-Höhenmeter berechnen
 
 my ($HmSumUp, $HmSumDn) = getHmSum (0, $#track);
 
 #=============================
 # Ausgabe der Track-Statistik
 
 print  "Trackpunkte : ", $#track + 1, "\n";
 printf "Luftlinie   : %4.0f km\n", $length_0;
 printf "Strecke     : %4.0f km\n", $length_1;
 #unless ($length_0) { printf "Ratio       : %6.1f\n",    $length_1 / $length_0; }
 printf "Hm auf      : %4.0f m\n",  $HmSumUp;
 printf "Hm ab       : %4.0f m\n\n",$HmSumDn;
 
 # ============================
 # Get $routeFileName Textfile
 
 my $ucontent = "";
 open FILE, "$baseDir/text/$routeFileName_e.txt" or die "$baseDir/text/$routeFileName_e.txt: $!";
 while (<FILE>) { $ucontent .= $_; }
 close FILE;
 my $fileContent = decode ($encoding, $ucontent);
 
 # ============
 # Get Infobox
 
 if ( $fileContent =~ /(\{\{Infobox.*?\}\})/s ) {
 
 	my $infobox  = $1;
 
 	print encode $encOut, "$infobox\n\n";
 
 }
 
 # =============
 # Get Roadbook
 
 my $pre_Roadbook;
 my $Roadbook;
 my $post_Roadbook;
 
 if ( $fileContent =~ /(.*?== Roadbook ==.*?)(===.*?)(\n== .*)/s ) {
 
 	$pre_Roadbook  = $1;
 	$Roadbook      = $2;
 	$post_Roadbook = $3;
 
 } else { die "Wrong Roadbook Format\n"; }
 
 my @Roadbook = split "\n", $Roadbook;
 
 # ===============
 # Get Placemarks
 
 my @Placemarks    = ();
 my $placemark     = "";
 my @PlacemarksRaw = ();
 my $placemarkRaw  = "";
 
 foreach my $line (@Roadbook) {
 
 	if ($line =~ /^=== .* ===$/) {
 
 		if ($placemark ne "") {
 			
 			push @Placemarks   , $placemark; 
 			push @PlacemarksRaw, $placemarkRaw;
 		}
 
 		$placemarkRaw  = "$line\n";
 		$placemark     =  $line   ;
 
 	} else {
 
 		$placemarkRaw .= "$line\n";
 		$placemark    .=  $line   ;
 	}
 }
 
 push @Placemarks   , $placemark;
 push @PlacemarksRaw, $placemarkRaw;
 
 # =================
 # Check Placemarks
 
 my @PlaceName ;
 my @TouriInfo ;
 my @GeoData   ;
 my @TrackPoint;
 my @Distance  ;
 my @RoadInfo  ;
 my @Kilometer ;
 my @RealKilo  ;
 
 for (my $i=0; $i<=$#Placemarks; $i++) {
 
 	my $placeName;
 	my $touriInfo;
 	my $geoData  ;
 	my $roadInfo ;
 	my $kilometer;
 	my $rest;
 
 	my $lat;
 	my $lon;
 	my $alt;
 	my $info;
 
 	my $deltaKilo;
 	my $sumKilo;
 
 	if ( $Placemarks[$i] =~ /
 		
 			^===\ (.*)\ ===                # placeName
 			(.*)                           # touriInfo
 			{{Geodaten\|(.*)}}             # geoData
 			(.*)                           # roadInfo
 			{{Kilometrierung[Hm]*\|(.*)}}(.*)$  # kilometer
 			/x ) {
 		
 		$placeName = $1;
 		$touriInfo = $2;
 		$geoData   = $3;
 		$roadInfo  = $4;
 		$kilometer = $5;
 		$rest      = $6;
 
 		# ===============
 		# Check: geoData
 
 		if ($geoData =~ /^([-]?\d+\.\d+)\|([-]?\d+\.\d+)\|([-]?\d+)\|([^\|]+)$/) {
 
 			$lat  = $1;
 			$lon  = $2;
 			$alt  = $3;
 			$info = $4;
 
 		} else {
 			print "Error in geoData: $geoData\n";
 			exit;
 		}
 
 		# =================
 		# Check: Kilometer
 
 		if ($kilometer =~ /([\d,]+)\|([\d]+)/) {
 
 			$deltaKilo = $1;
 			$sumKilo   = $2;
 
 		} else {
 			print "Error in kilometer: $kilometer\n";
 			exit;
 		}
 
 	} elsif (( $i == $#Placemarks ) and ( $Placemarks[$i] =~ /
 		
 			^===\ (.*)\ ===              # placeName
 			(.*)                         # touriInfo
 			{{Geodaten\|(.*)}}           # geoData
 			(.*)                         # roadInfo
 			/x )) {
 
 		$placeName = $1;
 		$touriInfo = $2;
 		$geoData   = $3;
 		$roadInfo  = $4;
 	
 		# ===============
 		# Check: geoData
 
 		if ($geoData =~ /(.*)\|(.*)\|(.*)\|(.*)/) {
 
 			$lat  = $1;
 			$lon  = $2;
 			$alt  = $3;
 			$info = $4;
 
 		} else {
 			print "Error in geoData: $geoData\n";
 			exit;
 		}
 
 		# ==================
 		# Kilometer Dummies
 
 		$deltaKilo = "   ";
 		$sumKilo   = " ";
 
 	} elsif ( $Placemarks[$i] =~ /
 		
 			^===\ (.*)\ ===              # placeName
 			(.*)                         # touriInfo
 			{{Geodaten\|(.*)}}           # geoData
 			(.*)                         # roadInfo
 			/x ) {
 
 		$placeName = $1;
 		$touriInfo = $2;
 		$geoData   = $3;
 		$roadInfo  = $4;
 	
 		# ===============
 		# Check: geoData
 
 		if ($geoData =~ /(.*)\|(.*)\|(.*)\|(.*)/) {
 
 			$lat  = $1;
 			$lon  = $2;
 			$alt  = $3;
 			$info = $4;
 
 		} else {
 			print "Error in geoData: $geoData\n";
 			exit;
 		}
 
 		# ==================
 		# Kilometer Dummies
 
 		$deltaKilo = "x,x";
 		$sumKilo   = "x";
 
 	} else {
 
 		print encode $encoding, "Untreated Error: $Placemarks[$i]\n";
 		exit;
 	}
 
 	my ($trackPoint, $distance) = getClosestPoint ( $lat, $lon );
 
 	if ($distance < 200) { 
 		
 		#$distance = "   ";
 		
 	} else { $distance .= "!!!"; }
 
 	push @PlaceName , $placeName;
 	push @TouriInfo , $touriInfo;
 	push @GeoData   , sprintf "%10.7f %10.7f", $lat, $lon;
 	push @TrackPoint, sprintf "%5d", $trackPoint;
 	push @Distance  , sprintf "%3.0f m", $distance;
 	push @RoadInfo  , $roadInfo;
 	push @Kilometer , sprintf "%4s %4s", $deltaKilo, $sumKilo;
 }
 
 # =========================
 # Calculate real Distances
 
 my $sum;
 my $HmTotSumUp;
 my $HmTotSumDn;
 
 for (my $i=0; $i < $#Placemarks; $i++) {
 
 	my $length;
 
 	for (my $j = $TrackPoint[$i]; $j < $TrackPoint[$i+1] ; $j++) {
 
 		my $dist = getDistance ( $track[$j][0], $track[$j][1], $track[$j+1][0], $track[$j+1][1] );
 
 		$length += $dist;
 	}
 
 	$sum += $length;
 
 	my $realKilo = sprintf "%4.1f %4.0f", $length, $sum;
 
 	$realKilo =~ s/\./,/;
 
 	if ($Kilometer[$i] eq $realKilo) { 
 		$realKilo      = "         ";
 		$Kilometer[$i] = "         ";
 	}
 
 	push @RealKilo, $realKilo;
 
 	my ($HmSumUp, $HmSumDn) = getHmSum ($TrackPoint[$i], $TrackPoint[$i+1]);
 
 	printf "%s;%0.0f;%0.0f;%0.0f;%0.0f\n", encode ($encOut, $PlaceName[$i]),$length,$HmSumUp,$HmSumDn,$track[$TrackPoint[$i]][2];
 
 	$HmTotSumUp += $HmSumUp;
 	$HmTotSumDn += $HmSumDn;
 }
 
 push @RealKilo, "         ";
 
 printf "GesamtHm: %0.0f;%0.0f\n", $HmTotSumUp,$HmTotSumDn;
 
 print "\n";
 
 # =====================================
 # Check ascending order of TrackPoints
 
 for (my $i=0; $i<$#Placemarks; $i++) {
 
 	if ( $TrackPoint[$i] <= $TrackPoint[$i+1] ) {
 
 		#ok
 
 	} else {
 
 		print encode $encOut, "Error: Wrong TrackPoint Order in:\n";
 		print encode $encOut, "$PlaceName[$i] :: $GeoData[$i] :: $TrackPoint[$i]\n";
 		print encode $encOut, "$PlaceName[$i+1] :: $GeoData[$i+1] :: $TrackPoint[$i+1]\n";
 
 		#exit(1);
 	}
 }
 
 # =====================
 # Show Change Overview
 
 for (my $i=0; $i<=$#Placemarks; $i++) {
 
 	my $s = sprintf "%s %s %s %s %s\n", 
 		$TrackPoint[$i], $Distance[$i], $Kilometer[$i], 
 		$RealKilo[$i], substr($PlaceName[$i], 0, 52);
 
 	print encode $encOut, $s;
 }
 print "\n";
 
 # ======================
 # Perform Changes on File
 
 my $change = 0;
 
 for (my $i=0; $i<=$#Placemarks; $i++) {
 
 	if ( $RealKilo[$i] !~ /^\s*$/ ) {
 		
 		print encode $encOut, "Change: $PlaceName[$i]\n";
 
 		my $deltaKiloNew;
 		my $sumKiloNew;
 
 		if ( $RealKilo[$i] =~ /^\s*([0-9,]+)\s+([0-9]+)$/ ) {
 
 			$deltaKiloNew = $1;
 			$sumKiloNew   = $2;
 
 		} else {
 
 			print "   No Match: >$RealKilo[$i]<\n";
 			exit;
 		}
 
 		my $deltaKiloOld;
 		my $sumKiloOld;
 
 		if ( $Kilometer[$i] =~ /^\s*([0-9,]+)\s+([0-9]+)$/ ) {
 
 			$deltaKiloOld = $1;
 			$sumKiloOld   = $2;
 
 			if ($fileContent =~ 
 				s/{{Kilometrierung\|$deltaKiloOld\|$sumKiloOld}}/{{Kilometrierung\|$deltaKiloNew\|$sumKiloNew}}/s) {
 
 				print "   $deltaKiloOld->$deltaKiloNew\n";
 				print "   $sumKiloOld->$sumKiloNew\n";
 
 				$change = 1;
 
 			} else {
 
 				print "   No Match in km!\n";
 				exit;
 			}
 
 		} elsif ( $Kilometer[$i] =~ /^\s*x,x\s+x$/ ) {
 
 			if ($fileContent =~ 
 				s/=== $PlaceName[$i+1] ===/{{Kilometrierung\|$deltaKiloNew\|$sumKiloNew}}\n\n=== $PlaceName[$i+1] ===/s) {
 
 				print "   No Kilometrierung ->$deltaKiloNew\n";
 				print "   No Kilometrierung ->$sumKiloNew\n";
 
 				$change = 1;
 
 			} else {
 
 				print "   No Match! $PlaceName[$i+1]\n{{Kilometrierung\|$deltaKiloNew\|$sumKiloNew}}\n";
 				#exit;
 			}
 
 		} else {
 
 			print "   No Match: >$Kilometer[$i]<\n";
 			exit;
 		}
 
 	}
 }
 
 if ($change) {
 
 	open  FOUT, "> $outDir/${routeFileName_e}_new.tx" or die $!;
 	print FOUT encode ($encoding, $fileContent);
 	close FOUT;
 
 }
 
 # ==================================
 # Generate Retour-Roadbook with Track
 
 my $content;
 
 $content .= "{{Tour|$routeFileName}}\n\n";
 $content .= $pre_Roadbook;
 
 for (my $i=$#Placemarks; $i>=0; $i--) {
 
 	my $placemark = $PlacemarksRaw[$i];
 
 	if ( $placemark =~ /(.+{{Geodaten.*?}})/s ) {
 
 		$placemark = $1;
 
 	} else {
 		
 		print "No match in Placemark: $placemark\n";
 		exit; 
 	}
 
 	if ($i > 0) { $placemark .= "\n\n{{Kilometrierung|0,0|0}}\n"; }
 
 	$content .= "$placemark\n";
 }
 
 $content .= $post_Roadbook;
 
 $content =~ s/\n\n\n/\n\n/g;
 
 $rawTrack = join " ", reverse @rawTrack;
 
 $content .= "\n$routeFileName (retour) :: $routeFileName\_%28retour%29 :: $rawTrack\n";
 
 open  FOUT, "> $outDir/${routeFileName_e}_ret.tx" or die $!;
 print FOUT encode ($encoding, $content);
 close FOUT;
 
 exit;
 
 #==========================================================
 #==========================================================
 
 sub getDistance {
 
 	use POSIX qw(acos);
 
 	my ($tp1_lat, $tp1_lon, $tp2_lat, $tp2_lon) = @_;
 
 	my $PI = 3.1415926;
 
 	my $lat1 = $tp1_lat / 180 * $PI;
 	my $lon1 = $tp1_lon / 180 * $PI;
 	my $lat2 = $tp2_lat / 180 * $PI;
 	my $lon2 = $tp2_lon / 180 * $PI;
 	
 	my $val = sin($lat1) * sin($lat2) + 
 			  cos($lat1) * cos($lat2) *
 			  cos($lon2-$lon1);
 
 	if ($val > +1) { 
 		$val = +1; 
 		#print "   ACOS-Error: $tp1_lon,$tp1_lat !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n";
 	}
 	if ($val < -1) { 
 		$val = -1; 
 		#print "   ACOS-Error: $tp1_lon,$tp1_lat !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n";
 	}
 
 	my $dist = acos($val) * 6378.137;      # radius of the equator in km
 
 	#if (Double.isNaN(dist)) dist = 0;
 	
 	return $dist;
 }
 
 #==========================================================
 
 sub getClosestPoint {
 
 	my ($tp_lat, $tp_lon) = @_;
 	
 	my $minDist = 111111111;
 	my $point   = -1;
 
 	for (my $i = 0; $i <= $#track ; $i++) {
 
 		my $dist = getDistance ( $track[$i][0], $track[$i][1], $tp_lat, $tp_lon );
 
 		if ($dist < $minDist) {
 
 			$minDist = $dist;
 			$point   = $i;
 		}
 	}
 
 	return ($point, $minDist*1000);
 }
 
 #==========================================================
 
 sub getHmSum {
 
 	my ($tp_begin, $tp_end) = @_;
 
 	if ($tp_end >= $#track) { $tp_end = $#track-1; }
 
 	my $HmSumUp = 0;
 	my $HmSumDn = 0;
 	
 	for (my $i = $tp_begin; $i <= $tp_end ; $i++) {
 
 		my $alt_0 = $track[$i][2];
 		my $alt_1 = $track[$i+1][2];
 		
 		my $diff  = $alt_1 - $alt_0;
 
 		if ($diff < 0) { $HmSumDn += $diff * (-1); }
 		if ($diff > 0) { $HmSumUp += $diff * (+1); }
 
 	}
 
 	return ($HmSumUp, $HmSumDn);
 }