Radreise-Wiki:Ini.pl

ini.pl enthält die Pfade des Hauptverzeichnisses Wiki-Content ($baseDir) und des Output-Verzeichnisses ($outDir). In letzterem landen alle generierten Dateien (kmz-Files, Imagemaps und Kilometrierungen). Ebenso müssen $username und $password an die lokalen Gegebenheiten angepasst werden. Das Output-Verzeichnis wird nicht automatisch angelegt. Des weiteren sind ein paar globale Encoding-Routinen und ein Filewriter im Skript enthalten.

Quellcode des Skripts:

 use strict;
 
 my $baseDir   = "D:/a/data/Radfernwege-Wiki/Wiki-Content";
 my $outDir    = "D:/Eigene Dateien";
 
 my $encoding = 'utf-8';  # Unicode
 my $encAnsi  = 'cp1252'; # Windows Ansi
 my $encOut   = 'cp850' ; # DOS Shell
 
 #======================================================
 # sub getIni
 #======================================================
 
 sub getIni {
 
 	my $username  = "username";
 	my $password  = "password";
 
 	return ($baseDir, $outDir, $username, $password, $encoding, $encAnsi, $encOut); 
 }
 
 #======================================================
 # sub saveFileIfChangedOrNew
 #======================================================
 
 use Digest::MD5 qw(md5_hex);
 use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
 
 sub saveFileIfChangedOrNew {
 
 	my ($path, $fileName, $file, $kmz) = @_;
 
 	my $exitCode = 0;
 
 	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';
 			}
 		}
 	}
 
 	return $exitCode;
 }
 
 #======================================================
 # sub encodePlaceNameURL
 # sub encodeRouteNameURL
 #======================================================
 
 use URI::Escape qw( uri_escape_utf8 );
 use CGI; my $cgi = new CGI;
 
 sub encodePlaceNameURL {
 
 	my $placeNameURL = $cgi->escape($_[0]);
 	$placeNameURL    =~ s/\%20/\_/g;
 	$placeNameURL    =~ s/\%/\./g;
 
 	return $placeNameURL;
 }
 
 sub encodeRouteNameURL {
 
 	my $urlstring  = uri_escape_utf8($_[0]);
 	$urlstring =~ s/%20/\_/g;
 	$urlstring =~ s/\(/%28/g;
 	$urlstring =~ s/\)/%29/g;
 	$urlstring =~ s/\'/%27/g;
 
 	return $urlstring;
 }
 
 return 1;
 
 #======================================================
 # sub get_routeFileName
 #======================================================
 
 sub get_routeFileName {
 
 	my $routeFileName = "";
 	my @parameters    = @_;
 
 	if ($#parameters != -1) {
 
 		$routeFileName = join " ", @parameters;
 
 		if ($routeFileName =~ / \($/) { 
 		
 			$routeFileName .= "retour)";
 		}
 
 	} else {
 
 		my @content;
 
 		open FIN, "$baseDir/RouteList.txt" or die "\n$! : $baseDir/RouteList.txt";
 		while (<FIN>) { push @content, decode $encoding, $_; }
 		close (FIN);
 		
 		my @content_s = reverse sort @content;
 		
 		my ($dateTXT, $dateKML, $type, $name) = split " :: ", $content_s[0];
 
 		chomp $name;
 		
 		$routeFileName = $name;
 	}
 
 	my $routeFileName_e = encode $encAnsi, $routeFileName;
 
 	return ($routeFileName, $routeFileName_e); 
 }
 
 #======================================================
 # sub get_trackfile
 #======================================================
 
 sub get_trackfile {
 
 	my $routeFileName = $_[0];
 
 	print encode $encOut, "\nReading Trackfile: $routeFileName\n\n";
 
 	my $routeFileName_e = encode $encAnsi, $routeFileName;
 
 	open FIN, "$baseDir/tracks/$routeFileName_e.txt" or die "\n$! : $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;
 	}
 
 	return (\@track, \@rawTrack); 
 }
 
 #======================================================
 # sub get_routefile
 #======================================================
 
 sub get_routefile {
 
 	my $routeFileName = $_[0];
 
 	print encode $encOut, "\nReading Routefile: $routeFileName\n\n";
 
 	my $routeFileName_e = encode $encAnsi, $routeFileName;
 
 	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);
 
 	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"; }
 
 	return ($fileContent, $pre_Roadbook, $Roadbook, $post_Roadbook); 
 }
 
 #======================================================
 # sub get_placemarks
 #======================================================
 
 sub get_placemarks {
 
 	my @Roadbook = @_;
 
 	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;
 
 	return (\@PlacemarksRaw, \@Placemarks); 
 }
 
 #======================================================
 # sub get_placemarkData
 #======================================================
 
 sub get_placemarkData {
 
 	my $placemark = @_[0];
 
 	my $placeName;
 	my $touriInfo;
 	my $geodaten;
 	my $roadInfo;
 	my $kilometrierung;
 	my $rest;
 
 	if ($placemark =~ /
 
 		^===\ (.*)\ ===\n
 		(.*)$
 		/xs) {
 		
 		$placeName = $1;
 		$rest      = $2;
 
 	} else {
 		print "ERROR Wrong Format in PlaceName:\n$placemark\n";
 		return ("0");
 	}
 
 	if ($rest =~ /
 
 		^(.*)\n
 		{{Geodaten\|([^\n]*)}}\n
 		(.*)$
 		/xs) {
 		
 		$touriInfo = $1;
 		$geodaten  = $2;
 		$rest      = $3;
 
 	} else {
 		print "ERROR Wrong Format in Geodaten:\n$rest\n";
 		return ("0");
 	}
 
 	if ($rest =~ /
 
 		^(.*)\n
 		{{(Kilometrierung[^\n]*)}}\n
 		(.*)$
 		/xs) {
 		
 		$roadInfo       = $1;
 		$kilometrierung = $2;
 		$rest           = $3;
 
 	} else {
 		print "ERROR Wrong Format in Kilometrierung:\n$rest\n";
 		return ("0");
 	}
 
 	return ($placeName, $touriInfo, $geodaten, $roadInfo, $kilometrierung, $rest);
 }
 
 #======================================================
 # sub get_lastPlacemarkData
 #======================================================
 
 sub get_lastPlacemarkData {
 
 	my $placemark = @_[0];
 
 	my $placeName;
 	my $touriInfo;
 	my $geodaten;
 	my $roadInfo;
 	my $rest;
 
 	if ($placemark =~ /
 
 		^===\ (.*)\ ===\n
 		(.*)$
 		/xs) {
 		
 		$placeName = $1;
 		$rest      = $2;
 
 	} else {
 		print "ERROR Wrong Format in PlaceName:\n$placemark\n";
 		return ("0");
 	}
 
 	if ($rest =~ /
 
 		^(.*)\n
 		{{Geodaten\|([^\n]*)}}\n
 		(.*)$
 		/xs) {
 		
 		$touriInfo = $1;
 		$geodaten  = $2;
 		$roadInfo  = $3;
 
 	} else {
 		print "ERROR Wrong Format in Geodaten:\n$rest\n";
 		return ("0");
 	}
 
 	return ($placeName, $touriInfo, $geodaten, $roadInfo);
 }
 
 
 #======================================================
 # sub get_geodaten
 #======================================================
 
 sub get_geodaten {
 
 	my $geodaten =  @_[0];
 
 	my $lat;
 	my $lon;
 	my $alt;
 	my $info;
 
 	if ($geodaten =~ /^([-]?\d+\.\d+)\|([-]?\d+\.\d+)\|([-]?\d+)\|([^\|]+)$/) {
 
 		$lat  = $1;
 		$lon  = $2;
 		$alt  = $3;
 		$info = $4;
 
 	} else {
 		print "ERROR Wrong Format in Geodaten:\n$geodaten\n";
 		return ("0");
 	}
 
 	return ($lat, $lon, $alt, $info);
 }
 
 #======================================================
 # sub get_kilometrierung
 #======================================================
 
 sub get_kilometrierung {
 
 	my $kilometrierung =  @_[0];
 
 	my $km;
 	my $km_sum;
 	my $hmup;
 	my $hmup_sum;
 	my $hmdn;
 	my $hmdn_sum;
 
 	if ($kilometrierung =~ /^KilometrierungHm6\|([\d,]+)\|([\d]+)\|([\d]+)\|([\d]+)\|([\d]+)\|([\d]+)$/) {
 
 		$km   = $1;
 		$hmup = $2;
 		$hmdn = $3;
 		$km_sum    = $4;
 		$hmup_sum  = $5;
 		$hmdn_sum  = $6;
 
 	} elsif ($kilometrierung =~ /^KilometrierungHm\|([\d,]+)\|([\d]+)\|([\d]+)\|([\d]+)$/) {
 
 		$km      = $1;
 		$km_sum  = $2;
 		$hmup    = $3;
 		$hmdn    = $4;
 		$hmup_sum  = "";
 		$hmdn_sum  = "";
 
 	} elsif ($kilometrierung =~ /^Kilometrierung\|([\d,]+)\|([\d]+)$/) {
 
 		$km      = $1;
 		$km_sum  = $2;
 		$hmup      = "";
 		$hmdn      = "";
 		$hmup_sum  = "";
 		$hmdn_sum  = "";
 
 	} else {
 		print "ERROR Wrong Format in Kilometrierung:\n$kilometrierung\n";
 		return ("0");
 	}
 
 	return ($km, $km_sum, $hmup, $hmdn, $hmup_sum, $hmdn_sum);
 }