Radreise-Wiki:Ini.pl: Unterschied zwischen den Versionen

Aus Radreise-Wiki
 
(3 dazwischenliegende Versionen desselben Benutzers werden nicht angezeigt)
Zeile 4: Zeile 4:


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

Aktuelle Version vom 12. Januar 2018, 18:30 Uhr

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);
}
Abgerufen von „http://radreise-wiki.de/index.php?title=Radreise-Wiki:Ini.pl&oldid=97663“