-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
Tom Lane wrote:
> Somehow, "prevent infinite loops" doesn't seem like justification for
> "refuse to deal with a situation that the software creates automatically".
> They ought to be willing to burrow more than one level ... see any Unix
> kernel's treatment of symlinks for behavior that has actually stood the
> test of usability over time.
Having faced similar problems in another wiki some month ago, I wrote the
attached script to automate some tasks in a wiki. Maybe it will be of use.
Unfortunately I wrote it for a german wiki, some of the special pages
are named differently. Hence to use it in the Postgres-Wiki, something needs
to be done probably. (Not much though).
In particular it includes a function to "execute" a redirect in all pages
referencing a redirect page, i.e. change the links within all incoming pages.
Regards,
Jens-W. Schicke
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.9 (GNU/Linux)
iEYEARECAAYFAkkOxRYACgkQzhchXT4RR5CJQQCghUUCLO+e0QtZOTD7sALCPv0p
masAn1FfB786qM9QIbQXlOokK+4R7x7I
=HWF8
-----END PGP SIGNATURE-----
#!/usr/bin/perl
use strict;
use warnings;
use MediaWiki;
use Data::Dumper;
use LWP;
use LWP::UserAgent;
my $wiki = MediaWiki->new() or die "Wiki init failed";
my $lwp = LWP::UserAgent->new();
$lwp->agent("Drahflow's Wiki Bot");
my $WIKINAME = $ARGV[0] or die "usage: ./bot.pl <Wiki>";
my $conf;
if($WIKINAME eq "AK") {
$conf = {
'wiki' => { 'host' => 'wiki.vorratsdatenspeicherung.de', 'path' => '/' },
'bot' => { 'user' => 'Drahflow\'s Bot', 'pass' => 'secret' },
};
} else {
die "Unknown wiki: $WIKINAME";
}
$wiki->setup($conf);
$wiki->login();
while(my $command = <STDIN>) {
chomp $command;
last if($command eq "q" or $command eq "quit");
eval {
dumpContent($1) if($command =~ /^DUMP ([^|]*)$/);
execTest() if($command eq 'TEST');
cleanupRedirect($1, $2) if($command =~ /^CREDIR ([^|]*)\|?(del)?$/);
checkout($1) if($command =~ /^MVOUT ([^|]*)$/);
checkin($1, $2) if($command =~ /^MVIN ([^|]*)\|?([^|]*)$/);
copyout($1) if($command =~ /^GET ([^|]*)$/);
checkToDoUsage() if($command =~ /^QTODO$/);
checkLanguageSync() if($command =~ /^QLANG$/);
moveCategory($1, $2) if($command =~ /^CMV ([^|]*)\|?([^|]*)$/);
addCategories($1, $2) if($command =~ /^CADD (.*)\|\|(.*)$/);
};
print STDERR $@ if $@;
}
$wiki->logout();
sub loadSure {
my ($name, $mode) = @_;
die "no mode given" unless $mode;
my $page = $wiki->get($name, $mode);
unless($page and $page->load()) {
die "could not load $name";
}
print "Page $name loaded.\n";
return $page;
}
sub loadCategorySure {
my ($name) = @_;
unless($name =~ /Kategorie:|Category:/) {
die "category name must be given with prefix";
}
my $req = HTTP::Request->new(
'GET' => 'http://' . $conf->{'wiki'}->{'host'} . '/' . $name);
my $res = $lwp->request($req);
if(not $res->is_success()) {
die "could not load $name";
}
my ($subcatsPart) = $res->content() =~ /\n<h2>Unterkategorien(.*?)\n<h2/s;
my ($articlesPart) = $res->content() =~ /\n<h2>Seiten in der Kategorie(.*?)\nVon/s;
my $subcats = [];
my $articles = [];
while(defined $subcatsPart and $subcatsPart =~ s/.*?<a href="\/([^"]+)" title="([^"]+)">//) {
push @$subcats, $2;
}
while(defined $articlesPart and $articlesPart =~ s/.*?<a href="\/([^"]+)" title="([^"]+)">//) {
push @$articles, $2;
}
print "Category $name loaded.\n";
return $articles, $subcats;
}
sub saveSure {
my ($page, $summary, $minor) = @_;
if($page->{'title'} =~ /Ortsgruppe/) {
askConfirmation("Page " . $page->{'title'} . " looks like it should be left alone");
}
die "no summary given" unless $summary;
if($minor) {
$page->{'minor'} = 1;
} else {
$page->{'minor'} = 0;
}
$page->{'summary'} = $summary;
unless($page->save()) {
die "could not save " . $page->{'title'};
}
print "Page " . $page->{'title'} . " saved.\n";
return $page;
}
sub askConfirmation {
my ($message) = @_;
while(1) {
print "==> $message, continue [N/y]\n";
my $answer = <STDIN>;
chomp $answer;
if($answer eq '' or $answer eq 'n') {
die "User confirmation failed.";
}
if($answer eq 'y') {
last;
}
}
}
sub dumpContent {
my ($name) = @_;
die "no name given" unless $name;
my $page = loadSure($name, "r");
my $text = $page->content();
print Dumper($text);
}
sub execTest {
my $page = loadSure('Benutzer:Drahflow/Sandkasten', "rw");
my $text = $page->content();
print Dumper($text);
$page->{'content'} .= 'Minimaler Testlauf';
saveSure($page, 'Testing [[Benutzer:Drahflow]]\'s Bot');
}
sub cleanupRedirect {
my ($name, $del) = @_;
die "no name given" unless $name;
my @incoming;
my $page = loadSure("Spezial:Linkliste/$name", "r");
my $content = $page->content();
while($content =~ s!<a href="/([^"]+)" title="([^"]+)">\2</a>[^<]*<span class="mw-whatlinkshere-tools">!!) {
my ($url, $title) = ($1, $2);
push @incoming, $title;
}
print "Incoming links:\n";
print Dumper(\@incoming);
$page = loadSure($name, "r");
$content = $page->content();
$content =~ m!#redirect ?\[\[([^\]]+)\]\]!i or die "could not find redirect";
my $redirect = $1;
print "Redirect to: $redirect\n";
foreach my $in (@incoming) {
$page = loadSure($in, "rw");
my $any = 0;
my $mask = $name;
$mask =~ s/ /[ _]/g;
while($page->{'content'} =~ m!\[\[$mask(#[^ ]*)?( ?\|([^\]]+))?\]\]!s) {
my ($anchor, undef, $display) = ($1, $2, $3);
if(not defined $anchor) {
$anchor = '';
}
if(not defined $display) {
$display = $name;
}
print "Displayname: $display\n";
$page->{'content'} =~ s!\[\[$mask(#[^ ]*)?( ?(\|[^\]]+)?)\]\]![[$redirect$anchor\|$display]]!;
print "Link on $in fixed.\n";
++$any;
}
die "incoming link not found" if(not $any);
askConfirmation("Page $in will be saved");
saveSure($page, "Weiterleitungs-Cleanup, Link von $name auf $redirect verbogen");
}
if($del) {
$page = loadSure($name, "rw");
$content = $page->content();
if($content =~ m!^#redirect ?\[\[$redirect\]\]$!si) {
$page->{'content'} .= "\n{{Vorlage:Drahflow/Löschen/Weiterleitung}}";
print "Inserted deletion remark.\n";
}
askConfirmation("Page $name will be saved");
saveSure($page, "Weiterleitungs-Cleanup, Weiterleitung zum Löschen eingetragen");
}
print "Done.\n";
}
sub sanitizeFilename {
my ($name) = @_;
$name =~ s/-/--/g;
$name =~ s!/!-+!g;
return "checkout/$name";
}
sub checkout {
my ($name) = @_;
die "no name given" unless $name;
my $page = loadSure($name, "rw");
if($page->content() =~ /{{ *InArbeit/ or
$page->content() =~ /{{ *Vorlage: *InArbeit/) {
askConfirmation("Page $name is tagged with {{Vorlage:InArbeit}}");
}
my $origContent = $page->{'content'};
$page->{'content'} =
"{{Vorlage:InArbeit|[[Benutzer:Drahflow]]}}\n" . $page->{'content'};
saveSure($page, "{{:Vorlage:InArbeit}} gesetzt", 1);
my $filename = sanitizeFilename($name);
open PAGE, '>', $filename or die "cannot open $filename: $!";
print PAGE $origContent;
close PAGE;
print "Done.\n";
}
sub copyout {
my ($name) = @_;
die "no name given" unless $name;
my $page = loadSure($name, "rw");
my $filename = sanitizeFilename($name);
open PAGE, '>', $filename or die "cannot open $filename: $!";
print PAGE $page->content();
close PAGE;
print "Done.\n";
}
sub checkin {
my ($name, $reason) = @_;
die "no name given" unless $name;
die "no reason given" unless $reason;
my $filename = sanitizeFilename($name);
open PAGE, '<', $filename or die "cannot open $filename: $!";
my $origContent = join('', <PAGE>);
close PAGE;
my $page = loadSure($name, "rw");
if($page->content() !~ /^{{Vorlage:InArbeit|\[\[Benutzer:Drahflow\]\]}}/s) {
askConfirmation("Page $name is not tagged as being edited by you");
}
$page->{'content'} = $origContent;
saveSure($page, $reason);
unlink $filename;
print "Done.\n";
}
sub getTemplateUsers {
my ($name) = @_;
die "no template name given" unless $name;
my $page = loadSure("Spezial:Linkliste/$name", "r");
my @users;
my $content = $page->content();
while($content =~ s!<a href="/([^"]+)" title="([^"]+)">\2</a> *\(Vorlageneinbindung\) *<span
class="mw-whatlinkshere-tools">!!){
my ($url, $title) = ($1, $2);
push @users, $title;
}
return @users;
}
sub checkToDoUsage {
my @users = getTemplateUsers("Vorlage:ToDo");
my @problems;
foreach my $user (@users) {
my $page = loadSure($user, "r");
if($page->content() =~ /{{Vorlage: *ToDo/) {
push @problems, $user;
}
}
foreach my $user (@problems) {
print "Problematic usage: $user\n";
}
print "Done.\n";
}
sub moveCategory {
my ($from, $to) = @_;
die "no from category given" unless $from;
die "no to category given" unless $to;
my ($articles, $subcats) = loadCategorySure($from);
my @problems;
foreach my $entry (@$articles, @$subcats) {
my $page = loadSure($entry, "rw");
my $success = 0;
if($page->{'content'} =~ /\[\[$to\]\]/) {
if($page->{'content'} =~ s/\[\[$from\]\]//) {
$success = 1;
}
} else {
if($page->{'content'} =~ s/\[\[$from\]\]/[[$to]]/) {
$success = 1;
}
}
if($success) {
saveSure($page, "Kategorie-Umbenennung: von $from nach $to");
} else {
push @problems, $entry;
}
}
foreach my $entry (@problems) {
print "Problematic usage: $entry\n";
}
print "Done.\n";
}
sub checkLanguageSync {
my %users = map { ($_, $_) } getTemplateUsers("Vorlage:Mehrsprachig");
my @problems;
while(%users) {
my ($first) = keys %users;
my $page = loadSure($first, "r");
unless($page->content() =~ /{{(Vorlage:)? *Mehrsprachig\b(.*)}}/s) {
delete $users{$first};
push @problems, "Could not find template call: $first";
next;
}
my $parameters = $2;
unless($parameters =~ /\bsynchronisiert *= *1/) {
delete $users{$first};
next;
}
my @otherPages;
push @otherPages, $1 if($parameters =~ /\bde *= *([^|{}]*)/s);
push @otherPages, $1 if($parameters =~ /\ben *= *([^|{}]*)/s);
@otherPages = grep { $_ ne $first } map { chomp; $_ } @otherPages;
if(@otherPages < 1) {
delete $users{$first};
push @problems, "Synchronization group of less than 2 on $first";
next;
}
OTHERS: foreach my $other (@otherPages) {
my @firstLines = split /\n/, $page->content();
my @otherLines = split /\n/, loadSure($other, "r")->content();
if(@firstLines != @otherLines) {
push @problems, "Line counts differ between $first and $other";
last OTHERS;
}
@firstLines = map { length($_)? 1: 0; } @firstLines;
@otherLines = map { length($_)? 1: 0; } @otherLines;
for(my $i = 0; $i < @firstLines; ++$i) {
if($firstLines[$i] ne $otherLines[$i]) {
push @problems, "Line " . ($i + 1) .
" differs between $first and $other";
last OTHERS;
}
}
}
delete $users{$first};
foreach my $page (@otherPages) {
delete $users{$page};
}
}
foreach my $entry (@problems) {
print "$entry\n";
}
print "Done.\n";
}
sub addCategories {
my ($categories, $names) = @_;
my @categories = split(/\|/, $categories);
my @names = split(/\|/, $names);
die "no categories given" unless @categories;
die "no pages given" unless @names;
my %pagesInCat;
foreach my $cat (@categories) {
my $correctPages = loadCategorySure($cat);
$pagesInCat{$cat} = $correctPages;
}
foreach my $name (@names) {
my $page = loadSure($name, "rw");
my $changes = 0;
foreach my $cat (@categories) {
next if(grep { $_ eq $name } @{$pagesInCat{$cat}});
$page->{'content'} .= "\n[[$cat]]";
print "$cat added.\n";
$changes = 1;
}
if($changes) {
saveSure($page, "Kategorie hinzugefügt");
}
}
print "Done.\n";
}
#TODO: Something within a directory which is also a name of a category should
# belong to said category
#TODO: Nothing should belong to a category and also directly to some category
# above it.
#TODO: Everything should have a category
#TODO: Categories should not be cyclic
