Re: Where to point CommitFestOpen?

-----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