Benutzer:Jah/Hauptautoren

Um den Anteil der Autoren eines Artikel an dessen aktueller Version zu bestimmen, muss man zunächst den Artikel exportieren, wobei man das Häkchen bei der Option "Nur die aktuelle Version der Seite exportieren" entfernen muss. Bei Seiten mit einer sehr langen Versionsgeschichte funktioniert der Export leider häufig nicht, v.a. wenn der Server langsam ist.

Dann lässt man folgendes Perl-Script auf die XML-Datei los. Ausgegeben wird ein Wikiquelltext mit je nach Autor unterschiedlich farbig markiertem Text und im Anschluss die Anzahl der Wörter, die die Autoren beigetragen haben, und der Anteil an der Gesamtzahl der Wörter. Bilder, Tabellen und Weblinks werden z.Z. nicht mit berücksichtigt. Den Wikiquelltext kann man auf einer beliebigen Seite zur Vorschau bringen (aber nicht abspeichern!).

Beispielseite: Wikipedia:Hauptautoren/Lorentz-Transformation (von Lorentz-Transformation in der Version vom 27.2.2005)

#!/usr/bin/perl

$wgl = 5; # Wortgruppenlänge

while(<>) { $xml .= $_; }

for($id=1; $xml =~ /<revision>(.*?)<\/revision>/sg; $id++) {
	$version = $1;
	$version =~ /<contributor>(?:<ip>|<username>)(.*?)(?:<\/ip>|<\/username>)<\/contributor>/s;
	$autor[$id] = $1;
	$version =~ /<text>(.*?)<\/text>/s;
	$text = $1;

	# escapete Zeichen <,>,& rückumwandeln und (Inter-)Wikilinks entfernen:
	$text =~ s/\</</sg; $text =~ s/>/>/sg; $text =~ s/&/&/sg;
	$text =~ s/\[\[(.{2,3}|minnan|simple):(.+?)\]\]//sg;
	$text =~ s/\[\[(?!(?:Kategorie|Bild):)([^\]\|]*?\|)?([^\|]+?)\]\]/$2/sg;
	$text =~ s/\n{3,}/\n\n/sg;
	$text0 = $text;

	# Elemente entfernen, die nicht erkannt werden sollen
	$text =~ s/\{\{.*?\}\}//sg;
	$text =~ s/\{\|.*?\|\}//sg;
	$text =~ s/\[\[(Kategorie|Bild):.*?\]\]//isg;
	$text =~ s/\*? ?\[(http|mailto).*?\]//isg;
	$text =~ s/\*? ?(http|mailto):\S*//isg;
	$text =~ s/<math>.*?<\/math>//sg;
	$text =~ s/<.{1,10}?>//sg;
	$text =~ s/&(\w+|#(\d+|x[0-9A-Fa-f]+));//sg;

	@woerter = ();
	while($text =~ /[a-zA-ZäöüßÄÖÜÉéÀàÈèÙùÂâÊêÎîËëÆæÅåØøÇç]+/sg) {
	    push @woerter, $&;
	}
	for($i=0; $i<@woerter; $i++) {
		$id[$i] = 0;
	}
	for($i=0; $i<@woerter-$wgl+1; $i++) {
		$seq = join(" ", @woerter[$i..$i+$wgl-1]);
		if(defined $id{$seq}) {
			for($j=$i; $j<$i+$wgl; $j++) {
			    if($id[$j]==0||$id[$j]>$id{$seq}[$j-$i]) {
				$id[$j] = $id{$seq}[$j-$i];
			    }
			}
		}
	}
	for($i=0; $i<@woerter-$wgl+1; $i++) {
		$seq = join(" ", @woerter[$i..$i+$wgl-1]);
		for($j=$i; $j<$i+$wgl; $j++) {
			$id{$seq}[$j-$i] = $id[$j]==0?$id:$id[$j];
		}
	}
}

# nochmal die aktuelle Version auswerten:
for($i=0; $i<@woerter-$wgl+1; $i++) {
	$seq = join(" ", @woerter[$i..$i+$wgl-1]);
	for($j=$i; $j<$i+$wgl; $j++) {
		$id[$j] = $id{$seq}[$j-$i];
	}
}

for($i=0; $i<@woerter; $i++) {
	$woerter{$autor[$id[$i]]}++ if $id[$i]>0;
}
@autoren = sort {$woerter{$b} <=> $woerter{$a}} keys %woerter;
for($i=0; $i<@autoren; $i++) {
    if($i>5) {
	$farbe{$autoren[$i]} = "#000000";
    } else {
	$farbe{$autoren[$i]} = ("#bf0000", "#00bf00", "#0000bf", "#007f7f", "#7f007f", "#7f7f00")[$i];
    }
}

sub ersetze {
  $ersatz = "___".$ersatzNr++."___";
  $ersetzterBlock{$ersatz} = $_[0];
  $ersatz;
}

# die gleichen Elemente, die oben entfernt wurden, ersetzen:
$text0 =~ s/\{\{.*?\}\}/ersetze($&)/esg;
$text0 =~ s/\{\|.*?\|\}/ersetze($&)/esg;
$text0 =~ s/\[\[(Kategorie|Bild):.*?\]\]/ersetze($&)/iesg;
$text0 =~ s/\*? ?\[(http|mailto).*?\]/ersetze($&)/iesg;
$text0 =~ s/\*? ?(http|mailto):\S*/ersetze($&)/iesg;
$text0 =~ s/<math>.*?<\/math>/ersetze($&)/esg;
$text0 =~ s/<.{1,10}?>/ersetze($&)/esg;
$text0 =~ s/&(\w+|#(\d+|x[0-9A-Fa-f]+));/ersetze($&)/esg;

for($i=0; $i<@woerter; $i++) {
    $text0 =~ s/^(.*?)$woerter[$i]//sg;
    $markiertertext .= "$1<font color=\"$farbe{$autor[$id[$i]]}\">$woerter[$i]</font>"
}
$markiertertext .= $text0;

# ersetzte Elemente wieder zurückholen:
$markiertertext =~ s/___\d+___/$ersetzterBlock{$&}/sg;

print "$markiertertext\n----\n==Autoren dieses Artikels==\n";
print "{| cellspacing=\"0\" border=\"1\"\n";
print "! Wörter || Anteil || Benutzer\n";
print "|-\n";
foreach $autor (@autoren) {
	printf "| %5i || %4.1f\% || <font color=\"$farbe{$autor}\">%s</font>\n", $woerter{$autor}, 100*$woerter{$autor}/@woerter, $autor;
	print "|-\n";
}
print "|}\n";