Radreise-Wiki:Route-Management.pl
Aus Radreise-Wiki
Version vom 26. Mai 2011, 06:42 Uhr von Jmages (Diskussion | Beiträge)
Das Perl-Skript Route-Management.pl enthält eine Vielzahl von Funktionen zur Wiki-Verwaltung. Beim Aufruf muss eine 6-stellige Binärzahl übergeben werden, die diese Funktionen kodiert. Die wichtigsten Anwendungen sind:
- 0101000 Aktualisiere die kürzlich geänderten Streckendateien
- 0011000 Lade alle Streckendateien herunter
- 0010100 Lade alle Trackdateien herunter
Für die Einrichtung der Verwaltungssoftware sind die letzten zwei Funktionen wichtig. Im laufenden Betrieb ist es die erste Funktion.
Beispiel für einen Programmstart zum Update der Streckendateien:
perl Route-Management.pl 0101000
use strict;
my $flags;
if ($ARGV[0]) {
$flags = $ARGV[0];
} else {
$flags = "0101000";
}
my @flags = split //, $flags;
#=========================
# Control-Flags
# 0101000 Update only recently changed Routefiles
# 0011000 Download all Routefiles
# 0010100 Download all Trackfiles
# 0010010 Modify all Routefiles
# 0010011 Modify and upload all Routefiles
my $updateDates = $flags[0]; # 1 = Read all Route- and KMZ-History Pages and update Listfile Dates
my $updateRecent = $flags[1]; # 1 = Only update Routefiles from Wiki Recent Changes Page
# 0 = Update all Routefiles
my $updateAllRoutes = $flags[2]; # 1 = Treat all Routefiles
# 0 = Only treat touched Routefiles
my $updateRoutes = $flags[3]; # 1 = Update Routefiles from Wiki
# 0 = Do not update Routefiles
my $updateAllKMZ = $flags[4]; # 1 = Update KMZ Files from Wiki and extract the KML content
my $modify = $flags[5]; # 1 = Modify Routefiles
my $upload = $flags[6]; # 1 = Upload modified Routefiles to Wiki
#=====================
# Import Date Library
use Date::Calc qw (Date_to_Time Time_to_Date);
#=====================================
# MD5 Checksum und Zip-Funktionalität
use Digest::MD5 qw(md5_hex);
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
#================
# Encoding Stuff
use Encode qw(encode decode);
my $encoding = 'utf-8';
my $encOut;
$encOut = 'cp1252'; # Windows Ansi
$encOut = 'cp850' ; # DOS Fenster
#=================
# Hash for Months
my %month = qw (Jan 01 Feb 02 Mär 03 Apr 04 Mai 05 Jun 06 Jul 07 Aug 08 Sep 09 Okt 10 Nov 11 Dez 12);
#===========================
# Important Paths and Files
require "ini.pl";
my ($baseDir, $outDir, $username, $password) = getIni();
my $dir_txt = "$baseDir/text";
my $dir_kmz = "$baseDir/kmz";
my $savePath = "$baseDir/upload";
my $listFile = "RouteList.txt";
my $mech; # Handle for mechanize-Browser
my $changesTxt = 0; # One or more Routefiles have changed
my $changesKmz = 0; # One or more KMZfiles have changed
my @route = (); # Stores all Infos about Routes
my @routeNew = (); # Keeps all new Infos for Saving
if ($updateDates or $updateRecent or $updateRoutes or $upload or $updateAllKMZ) {
#=====================================================
# Initialisieren von Mechanize-Browser und Cookie-Jar
use WWW::Mechanize;
use HTTP::Cookies;
$mech = WWW::Mechanize->new( autocheck => 1 );
$mech->agent_alias( 'Windows Mozilla' );
my $cookie_jar = HTTP::Cookies->new( file => "cookies.txt", autosave => 1 );
$mech->cookie_jar($cookie_jar);
#============================================================
# Einloggen ins Radreise-Wiki um in den Edit-Modus zu kommen
$mech->get("http://www.radreise-wiki.de/Spezial:Userlogin");
$mech->form_number('1');
$mech->field("wpName", $username);
$mech->field("wpPassword", $password);
$mech->tick('wpRemember', '1');
$mech->click();
}
#==========================
# Load Routelist from File
print "\nGetting Content from File: $listFile\n";
my $content;
open FIN, "$baseDir/$listFile" or die $!;
while (<FIN>) {
my $line = decode $encoding, $_;
if ($line =~ /^
(\d{4})-(\d{2})-(\d{2})\ (\d{2}):(\d{2}):(\d{2}) # mtime of txt-File
\ ::\
(\d{4})-(\d{2})-(\d{2})\ (\d{2}):(\d{2}):(\d{2}) # mtime of kmz-File
\ ::\
([H|h|R])# Type
\ ::\
(.*) # Routename
\ ::\
(.*) # RouteURL
$/x) {
my $year = $1;
my $month = $2;
my $day = $3;
my $hour = $4;
my $min = $5;
my $sec = $6;
my $year_kmz = $7;
my $month_kmz = $8;
my $day_kmz = $9;
my $hour_kmz = $10;
my $min_kmz = $11;
my $sec_kmz = $12;
my $type = $13;
my $routeName = $14;
my $routeURL = $15;
my $touch = 0;
if ( $updateDates ) {
#============================================
# Check Route- and KMZ-History Sites in Wiki
$mech->get("http://radreise-wiki.de/index.php?title=$routeURL&action=history");
my $website = $mech->content;
my @website = split "\n", $website;
foreach my $l (@website) {
if ($l =~ />(\d{2}):(\d{2}), (\d{1,2})\. (\w{3}) (\d{4})</) {
$hour = $1;
$min = $2;
$sec = 0;
$day = $3;
$month = $month{$4};
$year = $5;
last;
}
}
$mech->get("http://radreise-wiki.de/Bild:$routeURL.kmz");
my $website = $mech->content;
my @website = split "\n", $website;
foreach my $l (@website) {
if ($l =~ />(\d{2}):(\d{2}), (\d{1,2})\. (\w{3}) (\d{4}).*?\"Benutzer:(.*?)\"/) {
$hour_kmz = $1;
$min_kmz = $2;
$sec_kmz = 0;
$day_kmz = $3;
$month_kmz = $month{$4};
$year_kmz = $5;
my $user = $6;
print encode $encOut, " $user : $routeName.kmz\n";
last;
}
}
}
my $routeNew = sprintf "%s-%s-%02d %s:%s:%02d :: %s-%02d-%02d %02d:%02d:%02d :: %s :: %s :: %s\n",
$year, $month, $day, $hour, $min, $sec,
$year_kmz,$month_kmz,$day_kmz, $hour_kmz,$min_kmz,$sec_kmz,
$type,
$routeName, $routeURL;
my $mtime_txt = Date_to_Time ($year,$month,$day, $hour,$min,$sec);
my $mtime_kmz = Date_to_Time ($year_kmz,$month_kmz,$day_kmz, $hour_kmz,$min_kmz,$sec_kmz);
my @zeile = ( $routeName, $routeURL, $mtime_txt, $mtime_kmz, $touch, $type );
my $ref_zeile = \@zeile;
push @route , $ref_zeile;
push @routeNew, $routeNew;
} else {
die "No Match in Line: $line\n";
}
}
close (FIN);
print "\n ", $#route + 1, " Routes in List\n\n";
if ( $updateRecent ) {
#======================================
# Checking for recently changed Routes
print "Checking for recently changed Routes\n\n";
$mech->get("http://radreise-wiki.de/index.php?limit=250&title=Spezial%3ARecentchanges&namespace=0&limit=500&days=30");
my $website = $mech->content;
my @website = split "\n", $website;
my $day;
my $month;
my $year;
foreach my $line (@website) {
if ($line =~ /<h4>(\d{1,2})\. (\w+) (\d{4})<\/h4>/) {
$day = $1;
$month = $month{$2};
$year = $3;
} elsif ($line =~ /<li>.*? title=\"([^\"]*)\".*?<\/a>; (\d{2}):(\d{2}) \. \. .*?title=\"Benutzer:(.*?)\".*?<\/li>/) {
my $title = $1;
my $hour = $2;
my $min = $3;
my $sec = 0;
my $usr = $4;
my $mtime = Date_to_Time ($year,$month,$day, $hour,$min,$sec);
for (my $j=0; $j<=$#route; $j++) {
if ( ! $route[$j][4] and ($route[$j][0] eq $title) and ($mtime > $route[$j][2]) ) {
$route[$j][4] = 1;
$changesTxt = 1;
print encode $encOut, "$year-$month-$day $hour:$min : Update for $title ($usr)\n";
my ($year_kmz,$month_kmz,$day_kmz, $hour_kmz,$min_kmz,$sec_kmz) = Time_to_Date($route[$j][3]);
my $routeNew = sprintf "%s-%02d-%02d %02d:%02d:%02d :: %s-%02d-%02d %02d:%02d:%02d :: %s :: %s :: %s\n",
$year, $month, $day, $hour, $min, $sec,
$year_kmz,$month_kmz,$day_kmz, $hour_kmz,$min_kmz,$sec_kmz,
$route[$j][5],
$route[$j][0], $route[$j][1];
$routeNew[$j] = $routeNew;
}
}
}
}
if ($changesTxt) {
print "\n";
} else {
print " No Changes\n\n";
}
#=========================================
# Checking for recently changed KMZ-Files
print "Checking for recently changed KMZ-Files\n\n";
$mech->get("http://radreise-wiki.de/index.php?title=Spezial:Log&type=upload&user=&page=&limit=250&offset=0");
my $website = $mech->content;
my @website = split "\n", $website;
foreach my $line (@website) {
if ($line =~ /
<li>
(\d{2}):(\d{2}),\ (\d{1,2})\.\ (\w{3})\ (\d{4})
.*?
title=\"Benutzer:(.*?)\"
.*?
title=\"Bild:(.*?)\.kmz
\".*
<\/li>
/x) {
my $hour_kmz = $1;
my $min_kmz = $2;
my $sec_kmz = 0;
my $day_kmz = $3;
my $month_kmz = $month{$4};
my $year_kmz = $5;
my $user = $6;
my $route = $7;
my $mtime = Date_to_Time ($year_kmz,$month_kmz,$day_kmz, $hour_kmz,$min_kmz,$sec_kmz);
for (my $j=0; $j<=$#route; $j++) {
if ( ! $route[$j][4] and ($route[$j][0] eq $route) and ($mtime > $route[$j][3]) ) {
#$route[$j][4] = 1;
$changesKmz = 1;
print encode $encOut, "$year_kmz-$month_kmz-$day_kmz $hour_kmz:$min_kmz : Update for $route.kmz ($user)\n";
my ($year,$month,$day, $hour,$min,$sec) = Time_to_Date($route[$j][2]);
my $routeNew = sprintf "%s-%02d-%02d %02d:%02d:%02d :: %s-%02d-%02d %02d:%02d:%02d :: %s :: %s :: %s\n",
$year, $month, $day, $hour, $min, $sec,
$year_kmz,$month_kmz,$day_kmz, $hour_kmz,$min_kmz,$sec_kmz,
$route[$j][5],
$route[$j][0], $route[$j][1];
$routeNew[$j] = $routeNew;
}
}
}
}
if ($changesTxt or $changesKmz or $updateDates) {
#====================================
# Saving the new Listfile if changed
print "\n";
my $routeNew = join "", @routeNew;
saveFileIfChangedOrNew ("$baseDir/", $listFile, encode $encoding, $routeNew, 0);
print "\n";
} else {
print " No Changes\n\n";
}
}
if ($updateAllRoutes) {
#=======================
# Update all Routefiles
print "Updating all Routefiles\n\n";
for (my $i=0; $i<=$#route; $i++) {
$route[$i][4] = 1;
}
}
#====================================================
# Parsing of all Files in List and modify, if wanted
for (my $i=0; $i<=$#route; $i++) {
my $routeName = $route[$i][0];
my $routeOut = encode $encOut, $routeName;
my $routeFile = encode 'cp1252', $routeName;
my $routeURL = $route[$i][1];
my $touch = $route[$i][4];
my $type = $route[$i][5];
if ($updateAllKMZ) {
#=================================
# Update alle KMZ Files from Wiki
printf "%3d: Saving %s.kmz\n", $i+1, $routeOut;
$mech->get("http://www.radreise-wiki.de/images/$routeURL.kmz", ":content_file" => "$dir_kmz/$routeFile.kmz");
my $zip = Archive::Zip->new();
my $status = $zip->read("$dir_kmz/$routeFile.kmz");
if ($status != AZ_OK) {
die "Error while reading KMZ file! $!";
} else {
my @members = $zip->memberNames();
if ($#members != 0) { die "Error: More than one File within kmz!\n"; }
print encode $encOut, " Renaming $members[0] -> $routeFile.kml\n";
$zip->extractTree(undef, "$dir_kmz/");
rename("$dir_kmz/$members[0]","$dir_kmz/$routeFile.kml") || die "Error while Renaming File: $!";
my $ucontent = "";
open FILE, encode 'cp1252', "$dir_kmz/$routeFile\.kml" or die $!;
while (<FILE>) { $ucontent .= $_; }
close FILE;
my $content = decode $encoding, $ucontent;
if ($content =~ /<\/tessellate>\s*<coordinates>\s*(.*?)\s*<\/coordinates>/s) {
my $track = $1;
if ($track =~ /\n/) {
die "Error: Linebreak within Track\n";
}
print encode $encOut, " Saving $routeFile.txt\n";
open FILE, ">$dir_kmz/$routeFile\.txt" or die $!;
print FILE $track;
close FILE;
} else {
print " Error: No Match in $routeName\n";
die;
}
}
}
if ($updateRoutes and $touch) {
#========================================================
# Update local Routefiles from Wiki if touch-Flag is set
printf "%3d: Saving %s\n", $i+1, $routeOut;
$mech->get("http://www.radreise-wiki.de/$routeURL");
my $website = $mech->content;
# Gehe zum Editieren der Route
$mech->follow_link( url => "/index.php?title=$routeURL&action=edit" );
$website = $mech->content;
$website =~ /<textarea.*>(.*)<\/textarea>/s;
my $wikiText = $1;
$wikiText =~ s/</</g;
$wikiText =~ s/>/>/g;
$wikiText =~ s/"/\"/g;
$wikiText =~ s/&/\&/g;
if (length $wikiText > 1) {
&saveFileIfChangedOrNew ("$dir_txt/", "$routeFile.txt", encode $encoding, $wikiText, 0);
# External Call. Exit Code : 0 - No Change, 1 - KML-File Changed
my $result = system("perl makeKML.pl $routeFile");
} else {
die "URL is not existent: $routeURL\n";
}
}
my $newContent;
if ($modify) {
#=====================================================
# Modify Routefile and save it to different directory
my $ucontent = "";
open FILE, encode 'cp1252', "$dir_txt/$routeName\.txt" or die $!;
while (<FILE>) { $ucontent .= $_; }
close FILE;
my $content = decode $encoding, $ucontent;
my $match_1 = "";
if ($content =~ /(Höhenmeter \(ab\) = [ 0-9\.]*\n)\}\}\n/) {
$match_1 = $1;
} else {
print " Error: No Match in $routeName\n";
die;
}
my $match_2 = "";
my $gegenrichtung = "Bild:Ohne Gegenrichtung.png";
if ($content =~ /(\n\{\{[RetT]+our\|[^\}].*\}\}\n)/) {
$match_2 = $1;
if ($match_2 =~ /\n\{\{[RetT]+our\|([^\}].*)\}\}\n/) {
$gegenrichtung = $1;
} else {
print " Error: No Match in $routeName\n";
die;
}
}
my $replace_1 = "$match_1\| Tour-/Retour-Link = $gegenrichtung\n";
$replace_1 =~ s/ / /;
$replace_1 =~ s/Höhenmeter/Höhenmexer/;
if ($content =~ s/\Q$match_1/$replace_1/) {
} else {
print "No Match\n";
die;
}
$content =~ s/\Q$match_2//;
$content =~ s/ \n/\n/g;
$content =~ s/ \n/\n/g;
$content =~ s/ \n/\n/g;
$content =~ s/Höhenmexer/Höhenmeter/;
$newContent = $content;
#print encode 'cp850', " Saving $routeName\n";
open FOUT, encode 'cp1252', "> $savePath/$routeName.txt" or die $!;
print FOUT encode ($encoding, $newContent);
close FOUT;
}
if ($upload) {
#==========================================
# UPLOAD CHANGED TEXTFILES TO THE WIKI !!!
print encode ('cp850', " Uploading $routeName to $routeURL\n");
$mech->get("http://www.radreise-wiki.de/$routeURL");
$mech->follow_link( url => "/index.php?title=$routeURL&action=edit" );
$mech->field( 'wpTextbox1', $newContent);
$mech->field( 'wpSummary' , "Test Wiki-Bot: Infobox Tour-/Retour-Link hinzugefügt" );
$mech->submit;
}
}
if ($changesTxt) {
exit(1);
} else {
exit(0);
}
#=======================================================
#=======================================================
sub saveFileIfChangedOrNew {
(my $path, my $fileName, my $file, my $kmz) = @_;
my $change = 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) {
$change = 1;
print encode 'cp850', "****************** Overwriting File $fileName ******************\n";
open FT,"> $path$fileName";
print FT $file;
close FT;
if ($kmz) {
my $zip = Archive::Zip->new();
$zip->addFile("$path$fileName",$fileName);
$fileName =~ s/\.kml/\.kmz/;
unless ( $zip->writeToFileNamed("$path$fileName") == AZ_OK ) {
die 'write error';
}
}
}
} else {
$change = 1;
print encode 'cp850', "****************** Creating new file $fileName ******************\n";
open FT,"> $path$fileName";
print FT $file;
close FT;
if ($kmz) {
my $zip = Archive::Zip->new();
$zip->addFile("$path$fileName",$fileName);
$fileName =~ s/\.kml/\.kmz/;
unless ( $zip->writeToFileNamed("$path$fileName") == AZ_OK ) {
die 'write error';
}
}
}
return $change;
}
