Radreise-Wiki:Ini.pl
Aus Radreise-Wiki
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 = "../";
my $outDir = '../out';
my $encoding = 'utf-8'; # Unicode
my $encAnsi = 'cp1252'; # Windows Ansi
my $encOut = 'cp850' ; # DOS Shell
#======================================================
# sub getIni
# sub saveFileIfChangedOrNew
# sub encodePlaceNameURL
# sub encodeRouteNameURL
# sub get_routeFileName
# sub get_trackfile
# sub get_routefile
# sub get_placemarks
# sub get_placemarkData
# sub get_lastPlacemarkData
# sub get_geodaten
# sub get_kilometrierung
# sub getDistance {
# sub getClosestPoint {
#======================================================
#======================================================
# 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 $routeFilePath = shift;
my $routeFileName = shift;
print encode $encOut, "\nReading Trackfile: $routeFilePath/$routeFileName\n\n";
my $routeFileName_e = encode $encAnsi, $routeFileName;
my $rawTrack;
unless (open FILE, "$routeFilePath/$routeFileName_e.txt") {
return "WARNING: No $routeFilePath/$routeFileName_e.txt";
} else {
$rawTrack = <FILE>;
close FILE;
}
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 $routeFilePath = shift;
my $routeFileName = shift;
print encode $encOut, "\nReading Routefile: $routeFilePath/$routeFileName\n\n";
my $routeFileName_e = encode $encAnsi, $routeFileName;
my $ucontent = "";
unless (open FILE, "$routeFilePath/$routeFileName_e.txt") {
return "WARNING: No $routeFilePath/$routeFileName_e.txt";
} else {
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 = shift;
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\|([^\|]+)\|([^\|]+)\|([^\|]+)\|([^\|]+)\|([^\|]+)\|([^\|]+)$/) {
$km = $1;
$hmup = $2;
$hmdn = $3;
$km_sum = $4;
$hmup_sum = $5;
$hmdn_sum = $6;
} elsif ($kilometrierung =~ /^KilometrierungHm\|([^\|]+)\|([^\|]+)\|([^\|]+)\|([^\|]+)$/) {
$km = $1;
$km_sum = $2;
$hmup = $3;
$hmdn = $4;
$hmup_sum = "";
$hmdn_sum = "";
} elsif ($kilometrierung =~ /^Kilometrierung\|([^\|]+)\|([^\|]+)$/) {
$km = $1;
$km_sum = $2;
$hmup = "";
$hmdn = "";
$hmup_sum = "";
$hmdn_sum = "";
} else {
print "ERROR Wrong Format in Kilometrierung:\n$kilometrierung\n";
return ("x");
}
return ($km, $km_sum, $hmup, $hmdn, $hmup_sum, $hmdn_sum);
}
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_lat,$tp1_lon !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n";
}
if ($val < -1) {
$val = -1;
#print " ACOS-Error: $tp1_lat,$tp1_lon !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n";
}
my $dist = acos($val) * 6378.137; # radius of the equator in km
#if (Double.isNaN(dist)) dist = 0;
return $dist*1000;
}
#==========================================================
sub getClosestPoint {
my ($tp_lat, $tp_lon, $track) = @_;
my @track = @$track;
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;
}
}
my $dist_s = sprintf "%.0f", $minDist;
return ($point, $dist_s);
}
