Projet:Liens vers les pages d'homonymie/Scripts

Un article de Wikipédia, l'encyclopédie libre.

< Projet:Liens vers les pages d'homonymie

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. Sauver le code ci-dessous dans un fichier nommé "dabalyze" et suivre les instructions plus bas.

#! /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__);
Homonymie
Paronymie
Arrondissements homonymes
Batailles homonymes
Cantons homonymes
Homonymie de clubs sportifs
Homonymie de comtés
Homonymie dynastique
Internationalisation
Patronyme
Personnes homonymes
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();

Entrée: Le script s'attend à trouver un fichier du type "frwiki-20060430-pages-articles" dans le répertoire courant. Il faut télécharger et décompresser le fichier frwiki-latest-pages-articles.xml.bz2.
Sortie: 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: Une exécution correcte du script renvoie les informations suivantes :

Analyse : 1er passage
    9406 pages d'homonymie

Analyse : 2me passage
    7348 liens vers les pages d'homonymie
    7344 dans l'espace de nom article
    242 dans l'espace de nom modèle

Génération du rapport
    2204 entrées ajoutées à articles.txt
    242 entrées ajoutées à templates.txt
    41 entrées ajoutées à circular.txt

Les temps nécessaire est de :

3 minutes sur PC équipé d'un processeur AMD Athlon 64 cadencé à 1,8 GHz (à partir du dump français datant du 5 novembre 2005) ;
32 minutes sur un PowerPC G4 à 867 MHz (à partir du dump anglais datant du 20 octobre 2005).

Projet:Liens vers les pages d'homonymie/Scripts

Un article de Wikipédia, l'encyclopédie libre.

Views

Navigation

Contribuer

Rechercher

Autres langues