Utilisateur:Jmfayard/TraductionLiensInternes.pl

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

Voir Projet:Traduction/Outils

#!/bin/perl 
if ($#ARGV<3) {
        print "Usage : perl interwikilinks.pl Code_langue_origine Code_Langue_destination Article_origine\n\n";
        print "Exemple : perl interwikilinks.pl de fr Georg_Philipp_Telemann \n";
}
($origin_LANG,$dest_LANG,$ARTICLE) = @ARGV;


sub what_links_here() {
        ($LANG, $NAME) = @_ ;
        my ($ligne, $link, @result);
        @result=();
        open( IN, "wget 'http://$LANG.wikipedia.org/w/index.php?title=$NAME&action=raw' -O - 2>/dev/null |") ;
        while( $ligne=<IN> ) {
                while ( $ligne =~ m/\[\[([^\]:]+)\]\]/g ) {
                        $link = $1;
                        $link =~ s/\|.*$// ; 
                        #print "$link\n";
                        push @result, $link;
                }
        }
        close( IN );
        return @result;
}
sub interwiki() {
        my ($origin_LANG, $dest_LANG, $ARTICLE) =@_ ;
        my ($link, $ligne);
        open( IN, "wget 'http://$origin_LANG.wikipedia.org/w/index.php?title=$ARTICLE&action=raw' -O - 2>/dev/null |") ;
        while( $ligne=<IN> ) {
                while ( $ligne =~ m/\[\[$dest_LANG:([^\]:]+)\]\]/g ) {
                        $link = $1;
                        $link =~ s/\|.*$// ; 
                        #print "$link\n";
                        return "$link";
                }
        }
        return "AUCUN INTERWIKI";
}
@l_ARTICLE=&what_links_here( $origin_LANG, $ARTICLE ) ;
foreach $link (@l_ARTICLE) {
        $interwiki = &interwiki( $origin_LANG, $dest_LANG, $link );
        print "* [[:$origin_LANG:$link]] == [[$interwiki]]\n";
}