Wikipedia(MediaWiki)からPukiWikiへ

Wikipediaの記事(編集ページ)をダウンロードして、
MediaWiki記法で書かれた文章をPukiWiki用の記法で書かれたソースに変換するスクリプトを書きました。

目的はPerlの学習と某先輩へのおせっかい？です。

大学のワークステーションで動かしたら
一週間近くずっど動かすことになってしまった。
その間ログアウトできなかった・・・

昨日辺りに「nohup」というログアウトしたままでもプログラムを走らせる事ができる
コマンドを知った。もう少し早く知っておけばよかったと思った。

不安要素としては、MediaWiki記法からPukiWikiへの変換。
あと、文字コード関連で警告が出る。出力されるPukiWiki用のテキストは
特に問題ないみたいだから気にしなかった。

そんな駄目駄目なスクリプトですが、使いたい人がいたら「こちら」からダウンロードしてください
動作させるにははLWPモジュールが必要です。

手順は

1. Wikipedia特別ページの全ページの取得
2. ある程度の区間の記事へのリンクの取得 (例えば!(感嘆符)から)
3. 各記事の取得 (例えば!!!)
4. 編集ページのリンクの取得 (例えば!!!を編集中)
5. textareaからMediaWiki記法で書かれたテキストの取得
6. MediaWiki記法をPukiWiki記法へ

こんな感じ

ソースコードを張り付けておきます

#!/usr/local/bin/perl -w
use strict;

use Encode;
use LWP;

# ファイル名を決める
sub getFilename {
  my ($filename) = @_;

  $filename =~ s/.*<title>(.*) .* - Wikipedia<\/title>.*/$1/s;

  # 他にも必要かも
  $filename =~ s/&amp;/&/;

  $filename =~ s/(.?)/sprintf("%02X", ord($1))/eg; # 16進数に直す
  $filename =~ s/00//;                             # NULL文字を消す
  $filename .= ".txt";

  return $filename;
}

# Wikiを解析してファイルに書く
sub Wiki {
  my ($ua, $url) = @_;
  my $req = HTTP::Request->new(GET => $url);
  my $res = $ua->request($req);

  if ($res->is_success) {
    my $text = $res->content;
    Encode::from_to($text, "utf8", "euc-jp");

    my $filename = getFilename($text);
    $text =~ s/.*<textarea.*>(.*)<\/textarea>.*/$1/s; # textarea内のデータのみにする

    # ** ここでMediaWiki記法をPukiWiki記法に変えたい **
    my @text = split("\n", $text);
    foreach(@text) {
        s/<br.*?>/\n/;
        s/^\*(.*)/-$1/;
        s/^\*\*(.*)/--$1/;
        s/^\*\*\*(.*)/---$1/;
        s/^===(.*)===\s*$/***$1/g;
        s/^==(.*)==\s*$/**$1/g;
        s/^=(.*)=\s*$/*$1/g;
        s/^###(.*?[^=]+$)/+++$1/;
        s/^##(.*?[^=]+$)/++$1/;
        s/^#(.*?[^=]+$)/+$1/;
        s/^:::(.*?)/>>>$1/;
        s/^::(.*?)/>>$1/;
        s/^:(.*?)/>$1/;
        s/^; (.*?) : (.*?)/; $1 \| $2/;
        s/<center>(.*?)<\/center>/CENTER:$1/g;
    }
    $text = join("\n", @text);

    # ここでファイルに書く
    open(FILE, ">wiki/$filename");
    print FILE $text;
    close(FILE);
  }
}

# 本文から編集ページのリンクを取得する
sub toEdit {
  my($ua, $url) = @_;
  my $req = HTTP::Request->new(GET => $url);
  my $res = $ua->request($req);
  my $text = $res->content;
  $text =~ s/.*<div class="editsection".*?href="(.*?)&amp;action=edit.*/$1/s;
  $text = "http://ja.wikipedia.org" . $text . "&action=edit";
  return $text;
}

# 表示開始ページが指定された全ページのところから各ページのリンクを取得
sub allPageStep2 {
  my($ua, $url) = @_;
  my @urls;

  my $req = HTTP::Request->new(GET => $url);
  my $res = $ua->request($req);
  my $text = $res->content;
  $text =~ s/.*<hr \/><table(.*?)<\/table>.*/$1/s;

  foreach (split(" ", $text)) {
    if (/href=/) {
      s/href="(.*)"/$1/;
      push(@urls, "http://ja.wikipedia.org/$_");
    }
  }

  return @urls;
}

# 全ページから表示開始ページを指定したページへのリンクを取得
sub allPageStep1 {
  my($ua, $url) = @_;
  my @urls;

  my $req = HTTP::Request->new(GET => $url);
  my $res = $ua->request($req);
  my $text = $res->content;
  $text =~ s/.*<table class='allpageslist'(.*?)<\/table>.*/$1/s;

  foreach (split(" ", $text)) {
    if (/href=/) {
      s/href="(.*)".*/$1/;
      push(@urls, "http://ja.wikipedia.org/$_");
    }
  }

  # 重複の削除
  my %tmp;
  @urls = grep( !$tmp{$_}++, @urls );

  return @urls;
}

#
# MAIN
#

my $ua = LWP::UserAgent->new;
$ua->timeout(10);
$ua->agent('Mozilla');

foreach (allPageStep1($ua, 'http://ja.wikipedia.org/wiki/%E7%89%B9%E5%88%A5:Allpages')) {
  my @url = allPageStep2($ua, $_);
  foreach(@url) {
  print "$_\n";
    my $url = toEdit($ua, $_);
    Wiki($ua, $url);
  }
}