fetchinterwiki.pl

来自「php 开发的内容管理系统」· PL 代码 · 共 103 行

#!/usr/bin/env perl
# Copyright (C) 2005 脝var Arnfj枚r冒 Bjarmason
use strict;
use warnings;
use Socket;

# Conf
my $map = &get(&url('http://usemod.com/intermap.txt'));

# --- #
my $cont;
my @map = split /\n/, $map;

$cont .= '<?php
# Note: this file is generated by maintenance/fetchInterwiki.pl
# Edit and rerun that script rather than modifying this directly.

/* private */ $wgValidInterwikis = array(
';

$cont .= "\t# The usemod interwiki map\n";
for (my $i=0;$i<=$#map;++$i) {
	my ($name, $url) = $map[$i] =~ m#^([^ ]+) (.+)#i;
	$cont .= "\t'$name' => '$url\$1',\n";
}

my @iso = qw(
aa ab af als am ar as ay az ba be bg bh bi bn bo bs ca chr co cs csb cy da de dk:da dz el en eo
es et eu fa fi fj fo fr fy ga gd gl gn gu gv ha he hi hr hu hy ia id ik io is it iu ja jv ka kk
kl km kn ko ks ku ky la lo lt lv mg mi mk ml mn mo mr ms my na nah nb nds ne nl no oc om or pa
pl ps pt qu rm rn ro ru rw sa sd sg sh si sk sl sm sn so sq sr ss st su sv sw ta te tg th ti tk
tl tn to tp tpi tr ts tt tw ug uk ur uz vi vo wa wo xh yi yo za zh zh-cn zh-tw zu);

$cont .= '
	# Some custom additions:
	"ReVo"	=>	"http://purl.org/NET/voko/revo/art/$1.html",
	  # eg [[ReVo:cerami]], [[ReVo:astero]] - note X-sensitive!
	"EcheI"	=>	"http://www.ikso.net/cgi-bin/wiki.pl?$1",
	"E\\xc4\\x89eI" =>	"http://www.ikso.net/cgi-bin/wiki.pl?$1",
	"UnuMondo"	=>	"http://unumondo.com/cgi-bin/wiki.pl?$1", # X-sensitive!
	"JEFO"	=>	"http://esperanto.jeunes.free.fr/vikio/index.php?$1",
	"PMEG"	=>	"http://www.bertilow.com/pmeg/$1.php",
		# ekz [[PMEG:gramatiko/kunligaj vortetoj/au]]
	"EnciclopediaLibre" => "http://enciclopedia.us.es/wiki.phtml?title=$1",

	# Wikipedia-specific stuff:
	# Special cases
	"w"		=> "http://www.wikipedia.org/wiki/$1",
	"m"		=> "http://meta.wikipedia.org/wiki/$1",
	"meta"		=> "http://meta.wikipedia.org/wiki/$1",
	"sep11"		=> "http://sep11.wikipedia.org/wiki/$1",
	"simple"=> "http://simple.wikipedia.com/wiki.cgi?$1",
	"wiktionary"	=> "http://wiktionary.wikipedia.org/wiki/$1",
	"PageHistory" => "http://www.wikipedia.org/w/wiki.phtml?title=$1&action=history",
	"UserContributions" => "http://www.wikipedia.org/w/wiki.phtml?title=Special:Contributions&target=$1",
	"BackLinks" => "http://www.wikipedia.org/w/wiki.phtml?title=Special:Whatlinkshere&target=$1",

	# ISO 639 2-letter language codes
';

for(my $i=0; $i<=$#iso;++$i) {
	my @arr = split /:/, $iso[$i];
	$cont .= "\t";
	$cont .= "'$arr[0]' => 'http://";
	
	if ($arr[1]) {
		$cont .= $arr[1];
	} else {
		$cont .= $arr[0];
	}
	$cont .= ".wikipedia.org/wiki/\$1',\n";
}

$cont .= '
);
?>
';

open IW, ">Interwiki.php";
print IW $cont;
close IW;

sub get {
	my ($host, $url) = @_;
	my $cont;
	my $eat;

	my $proto = getprotobyname('tcp');
	socket(Socket, AF_INET, SOCK_STREAM, $proto);
	my $iaddr = inet_aton("$host");
	my $port = getservbyname('http', 'tcp');
	my $sin = sockaddr_in($port, $iaddr);
	connect(Socket, $sin);
	send Socket, "GET $url HTTP/1.0\r\nHost: $host\r\n\r\n",0;
	while (<Socket>) {
		$cont .= $_ if $eat; # mmm, food
		++$eat if ($_ =~ /^(\n|\r\n|)$/);
	}
	return $cont;
}

sub url {my ($server, $path) = $_[0] =~ m#.*(?=//)//([^/]*)(.*)#g;}