Radreise-Wiki:Route-Management.pl
Aus Radreise-Wiki
Version vom 25. Mai 2011, 08:27 Uhr von Jmages (Diskussion | Beiträge)
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;
}
