Projet:Liens vers les pages d'homonymie/Scripts
Voici les explications du script perl permettant de trouver les liens vers les pages d'homonymie en analysant les dumps au format XML de la base de données.
Description du script modifier
Entrée modifier
Le script s'attend à trouver un fichier du type "frwiki-20060430-pages-articles" dans le répertoire courant (ne pas oublier de modifier la ligne 314 du script en conséquence). Il faut télécharger et décompresser le fichier frwiki-latest-pages-articles.xml.bz2.
Décompression modifier
Pour décompresser une archive .bz2 de plus de 4Gb sous Windows, vous pouvez utiliser Bzip2 for windows disponible ici.
Lancer l'invite de commandes de Windows, aller dans le répertoire d'installation de Bzip2 cd "C:\Program Files (x86)\GnuWin32\bin" (exemple sous windows 10)
et taper la commande bunzip2 -k c:\...\frwiki-latest-pages-articles.xml.bz2
-k indique de ne pas supprimer le fichier d'entrée.
... doit être remplacé par le chemin d'accès au fichier téléchargé.
Exécution modifier
Sous Windows modifier
Pour une exécution sous Windows, vous pouvez installer Strawberry Perl disponible ici.
Le fichier d'entrée et le fichier Dabalyze doivent être dans le même répertoire.
Lancer le programme Perl, aller dans le répertoire contenant ces deux fichiers.
Sous Linux modifier
Lancement modifier
Le script se lance avec la commande suivante : perl Dabalyze
Nota : le temps d'exécution du script est de 27 minutes sur un PC équipé d'un Intel Core 2 Duo 2Ghz - 1 Go de RAM (à partir du dump français du 4 février 2010). Attention, le dump faisant désormais plus de 5 Go, le script utilise beaucoup de RAM...
Nota : le temps d'exécution du script est de 17 minutes sur un PC équipé d'un Intel Core i5 2,9Ghz - 8 Go de RAM (à partir du dump français du 1er août 2020). Le dump fait maintenant plus de 20 Go.
Sortie modifier
Le script génère deux fichiers texte ("articles.txt" et "templates.txt"). Le premier contient un liste des pages d'homonymies pour lesquelles des liens sont issus d'articles, prête à être insérée dans Projet:Liens vers les pages d'homonymie. Le second contient un liste des pages d'homonymies pour lesquelles des liens sont issus de modèles, dans l'hypothèse ou un projet du même genre existerait pour l'espace de nom modèle. Il est à noter que ces fichiers sont encodés en UTF-8, tout éditeur de texte habituellement utilisé pour copier/coller dans Wikipédia devrait faire l'affaire.
Comme le script a besoin de connaître les redirections circulaires, leur liste est sauvegardée dans le fichier "circular.txt".
Diagnostique modifier
Une exécution correcte du script renvoie les informations suivantes :
Analyse : 1er passage
54532 pages d'homonymie
Analyse : 2me passage
39590 liens vers les pages d'homonymie
39590 dans l'espace de nom article
0 dans l'espace de nom modèle
Génération du rapport
39590 entrées ajoutées à articles.txt
0 entrées ajoutées à templates.txt
6 entrées ajoutées à circular.txt
Script modifier
- Sauver le code ci-dessous dans un fichier nommé "dabalyze" et suivre les instructions ci-dessus.
#! /usr/bin/perl
use strict;
my %interesting=
('' => {
name => 'article',
filename => 'articles.txt',
cutoff => 1},
'Modèle' => {
name => 'modèle',
filename => 'templates.txt',
cutoff => 0,
list => 1});
my $exp_re=qr/\(homonymie\)$/;
my @templates=split(/\n/,<<__EOT__);
Arrondissements homonymes
Bandeau standard pour page d'homonymie
Batailles homonymes
Cantons homonymes
Communes françaises homonymes
Disambig
Édifices religieux homonymes
Films homonymes
Gouvernements homonymes
Guerres homonymes
Homonymie
Homonymie bateau
Homonymie de clubs sportifs
Homonymie de comtés
Homonymie édifice religieux
Homonymie de monument
Homonymie de nom romain
Homonymie de parti politique
Homonymie de route
Homonymie d'établissements scolaires ou universitaires
Homonymie d'îles
Homonymie dynastique
Homonymie vidéoludique
Internationalisation
Isomérie
Lieux homonymes
Paronymie
Patronyme
Patronymie
Patronyme basque
Patronyme italien
Personnes homonymes
Saints homonymes
Titres homonymes
Toponymie
Unités homonymes
Villes homonymes
__EOT__
foreach my $template (@templates) {
$template =~ s/^([[:alpha:]])/[$1\L$1]/;
}
my $tmpl_re=join('|',reverse(sort(@templates)));
my $dab_re=qr/{{(?i:msg:)?\s*(?i:modèle\s*:\s*)?($tmpl_re)\s*(?i:\||}})/;
my($ns_re,%ns_canon);
my $want_progress=@ARGV>0 && $ARGV[0] eq '-p';
my $last_progress=-1;
sub pageloop (&)
{
my($handler)=@_;
my($size);
local $/="</page>\x0A";
$size=-s PAGES;
while (defined(my $page=<PAGES>)) {
my($nstitle,$ns,$title);
$page =~ /^\s*<page>/ or last;
($nstitle)=($page =~ m{<title>([^<]+)</title>})
or die "Impossible de trouver le titre de la page";
if ($nstitle =~ /^($ns_re):(.+)$/) {
$ns=$1;
$title=$2;
} else {
$ns='';
$title=$nstitle;
}
$page =~ m{</text>} or next;
substr($page,$-[0])='';
$page =~ /<text .*xml:space="preserve"/
or die "Impossible de trouver le début du texte pour la page $nstitle";
substr($page,0,$+[0])='';
$handler->($nstitle,$ns,$title,$page);
if ($want_progress) {
my $progress=int(tell(PAGES)/$size*1000);
if ($progress!=$last_progress) {
$last_progress=$progress;
printf STDERR "\r0.%.3u",$progress;
}
}
}
if ($want_progress) {
print STDERR "\r";
}
}
sub mungtarget ($$$ )
{
my(undef,$source,$sub)=@_;
for my $target ($_[0]) {
$target =~ tr/\t\n\r/ /;
$target =~ s/^ +//;
$target =~ s/ +$//;
$target =~ s/ {2,}/ /g;
if ($sub && $target =~ m{^/}) {
$target=$source.$target;
} elsif ($target =~ /^:*($ns_re) *: *(.+)$/i) {
$target=$2;
utf8::decode($target);
$target=ucfirst($target);
utf8::encode($target);
$target=$ns_canon{lc($1)}.":".$target;
} elsif ($target =~ /^:*(.+)$/i) {
$target=$1;
utf8::decode($target);
$target=ucfirst($target);
utf8::encode($target);
} else {
# a malformed link, usually empty brackets
}
}
}
my(%dab,%redir,@circular);
sub pass1 ()
{
print STDERR "Analyse : 1er passage\n";
{
my($siteinfo,@namespaces);
local $/="</siteinfo>\x0A";
$siteinfo=<PAGES>;
@namespaces=
$siteinfo =~ m{<namespace key="-?\d+">([^<]+)</namespace>}g;
$ns_re=join('|',map(quotemeta($_),reverse(sort(@namespaces))));
foreach my $ns (@namespaces) {
$ns_canon{lc($ns)}=$ns;
}
}
pageloop {
my($nstitle,$ns,$title)=splice(@_,0,3);
for my $text ($_[0]) {
my $sub=$interesting{$ns}->{subpages};
if ($ns eq '' && $text =~ $dab_re) {
$dab{$nstitle}=1;
}
if ($text =~ /^#redirect.*\[\[([^\]\|]+)/i) {
my($target,$back);
$target=$1;
mungtarget($target,$nstitle,$sub);
while ($target ne $nstitle) {
my($newtarget);
$newtarget=$redir{$target};
last unless defined($newtarget);
$target=$newtarget;
}
if ($target eq $nstitle) {
push(@circular,$nstitle);
} else {
$redir{$nstitle}=$target;
}
}
}
};
foreach my $target (keys(%redir)) {
my(@chain);
for (;;) {
my $newtarget=$redir{$target};
last unless defined($newtarget);
push(@chain,$target);
$target=$newtarget;
}
pop(@chain);
foreach my $source (@chain) {
$redir{$source}=$target;
}
}
print STDERR " ".keys(%dab)." pages d'homonymie\n";
print STDERR "\n";
}
my %stats=map {
($_,{});
} keys(%interesting);
my %lists=map {
($_,{});
} grep {
$interesting{$_}->{list};
} keys(%interesting);
sub pass2 ()
{
my(%linked);
print STDERR "Analyse : 2me passage\n";
{
local $/="</siteinfo>\x0A";
<PAGES>;
}
pageloop {
my($nstitle,$ns,$title)=splice(@_,0,3);
for my $text ($_[0]) {
my($stats,$lists,$sub);
$stats=$stats{$ns};
$lists=$lists{$ns};
$sub=$interesting{$ns}->{subpages};
if ($stats) {
my(%seen);
while ($text =~ /\[\[([^\]\|]+)/g) {
my($target,$final);
$target=$1;
mungtarget($target,$nstitle,$sub);
next if $target =~ $exp_re;
$final=$redir{$target};
$final=$target unless defined($final);
if ($dab{$final} && !$seen{$final}++) {
$linked{$final}=1;
$stats->{$final}++;
if ($lists) {
push(@{$lists->{$final}},$nstitle);
}
}
}
}
}
};
print STDERR " ".keys(%linked)." liens vers les pages d'homonymie\n";
foreach my $ns (sort(keys(%stats))) {
print STDERR (" ".keys(%{$stats{$ns}})." dans l'espace de nom ".
$interesting{$ns}->{name}."\n");
}
print STDERR "\n";
}
sub wikilink ($ )
{
my($target)=@_;
if (exists($redir{$target})) {
"[{{SERVER}}{{localurl:$target|redirect=no}} $target]";
} elsif ($target =~ m{/\.{1,2}(?:$|/)}) {
"[{{SERVER}}{{localurl:$target}} $target]";
} elsif ($target =~ m{^/}) {
"[[:$target]]";
} else {
"[[$target]]";
}
}
sub report ()
{
print STDERR "Génération du rapport\n";
foreach my $target (@circular) {
$redir{$target}=$target;
}
while (my($ns,$stats)=each(%stats)) {
my($filename,$cutoff)=@{$interesting{$ns}}{qw(filename cutoff)};
my $lists=$lists{$ns};
my @nstitles=sort {
$stats->{$b}<=>$stats->{$a} || $a cmp $b;
} grep {
$stats->{$_}>=$cutoff;
} keys(%{$stats});
my $total=0;
open(REPORT,'>',$filename)
or die "Impossible de créer $filename: $!";
binmode(REPORT);
print REPORT "\xEF\xBB\xBF";
foreach my $nstitle (@nstitles) {
$total+=$stats->{$nstitle};
}
print REPORT "Nombre total de liens : $total\n";
foreach my $nstitle (@nstitles) {
print REPORT ("# ",wikilink($nstitle),": ",$stats->{$nstitle},
" [[Special:Whatlinkshere/",$nstitle,"|liens]]\n");
if ($lists) {
foreach my $source (sort(@{$lists->{$nstitle}})) {
print REPORT "#* ",wikilink($source),"\n";
}
}
}
close(REPORT);
print STDERR " ".@nstitles." entrées ajoutées à $filename\n";
}
if (@circular) {
@circular=sort(@circular);
open(REPORT,'>','circular.txt')
or die "Impossible de créer circular.txt: $!";
binmode(REPORT);
print REPORT "\xEF\xBB\xBF";
foreach my $target (@circular) {
print REPORT "* ",wikilink($target),"\n";
}
close(REPORT);
print STDERR " ".@circular." entrées ajoutées à circular.txt\n";
} else {
unlink('circular.txt');
}
}
open(PAGES,'<','pages-articles.xml')
or die "Impossible d'ouvrir pages-articles.xml: $!";
binmode(PAGES);
pass1();
seek(PAGES,0,0);
pass2();
close(PAGES);
report();