各種スペルチェック用の辞書ファイルをくっつける

GNU Aspell と Firefox と TortoiseSVN のスペルチェック用ユーザ辞書をマージする Perl スクリプト。

ついでに NTEmacs の ddskk と skkime のユーザ辞書から abbrev モードで使う単語も抜き出してくっつけます。

Windows の ActivePerl 5.10.1 と Cygwin の Perl 5.10.1 で動くようにしてあります。

こんなの需要があるか分かりませんが、あのムカつく赤波アンダーラインが嫌いな人向けです。ファイルのバックアップとかしませんので必要なら手動でどぞ…。

#!/usr/bin/perl

##
## 各種スペルチェック用の辞書ファイルをくっつける
## $Id: merge_dic.pl 651 2010-02-26 10:16:47Z yu-ji $
##

use utf8;
use strict;
use warnings;

use Config;
use Encode;
use IO::File;

my $filename_encoding;
for ($Config{osname}) {
    m/MSWin32/ and do {
        binmode $_, ':encoding(cp932)' for qw(STDIN STDOUT STDERR);
        $filename_encoding = 'cp932';
        last;
    };
    m/cygwin/ and do {
        binmode $_, ':utf8' for qw(STDIN STDOUT STDERR);
        $filename_encoding = 'utf8';
        last;
    };
    # ActivePerl on Windows does not support ':locale' tag.
    #use open IO => ':locale';
    #use open ':std';
}


# くっつける辞書ファイルのファイル名
my %source =
  (# NTEmacs ddskk
   $ENV{'HOME'} . '\.skk-jisyo' =>
   {
    encoding => ':encoding(euc-jp):crlf',
    proc => sub {
        my($lines_ref) = @_;
        my @entries = ();

        # アルファベットのエントリだけ抜き出し
        @entries = grep {
            m!\A ([a-zA-Z]{2,}?) [ ] /!msx && ($_ = $1);
        } @$lines_ref;

        return \@entries;
    },
    read => 1,
    write => 0, ### DO NOT SET THIS TO 1
   },
   # Windows skkime
   $ENV{'HOME'} . '\.skkime-jisyo' =>
   {
    encoding => ':encoding(UTF-16LE)',
    proc => sub {
        my($lines_ref) = @_;
        my @entries = ();

        # アルファベットのエントリだけ抜き出し
        @entries = grep {
            m!\A ([a-zA-Z]{2,}?) [ ] /!msx && ($_ = $1);
        } @$lines_ref;

        return \@entries;
    },
    read => 1,
    write => 0, ### DO NOT SET THIS TO 1
   },
   # Cygwin GNU Aspell
   $ENV{'HOME'} . '\.aspell.en.pws' =>
   {
    encoding => ':encoding(ascii):unix',
    proc => sub {
        my($lines_ref) = @_;

        # 1行目は捨て
        # 'personal_ws-1.1 en 113'
        shift @$lines_ref;

        return $lines_ref;
    },
    header => sub {
        my($lines_ref) = @_;
        my @header = ();

        push @header, sprintf('personal_ws-1.1 en %d', scalar(@$lines_ref));

        return \@header;
    },
    read => 1,
    write => 1,
   },
   # Windows Firefox
   $ENV{'HOME'} . '\.mozilla\firefox\firefox35\persdict.dat' =>
   {
    encoding => ':encoding(ascii):unix',
    read => 1,
    write => 1,
   },
   # Windows TortoiseSVN en-US (LCID)
   $ENV{'HOME'} . '\..\AppData\Roaming\TortoiseSVN\1033.dic' =>
   {
    encoding => ':encoding(ascii):unix',
    read => 1,
    write => 1,
   },
  );


sub slurp_file {
    my($filename, $mode) = @_;

    $filename = encode($filename_encoding, $filename)
      if $filename_encoding;
    my $f = IO::File->new($filename, '<' . $mode);
    if (! defined $f) {
        die "Cannot open for read($filename): $!";
    }

    return map { chomp $_; $_; } <$f>;
}


sub burp_file {
    my($filename, $mode, $entries) = @_;

    $filename = encode($filename_encoding, $filename)
      if $filename_encoding;
    my $f = IO::File->new($filename, '>' . $mode);
    if (! defined $f) {
        die "Cannot open for write($filename): $!";
    }
    $f->print("$_\n")
      for @{ $entries };
    $f->close;

    return;
}


#
# read
#
my @entries = ();
for my $filename (sort keys %source) {
    next
      unless $source{$filename}{read};
    print "Read: $filename\n";

    my @lines = slurp_file($filename, $source{$filename}{encoding});
    @lines = @{ $source{$filename}{proc}->(\@lines) }
      if $source{$filename}{proc};

    print sprintf("%d entries.\n", scalar(@lines));
    push @entries, @lines;
}

#
# sort, uniq
#
{
    my %seen = ();
    @entries = sort grep { ! m/^\s*$/ && ! $seen{$_}++ } @entries;
}

#
# write
#
for my $filename (sort keys %source) {
    next
      unless $source{$filename}{write};
    print "Write: $filename\n";

    my @lines = ();
    push @lines, @{ $source{$filename}{header}->(\@entries) }
      if $source{$filename}{header};
    push @lines, @entries;

    burp_file($filename, $source{$filename}{encoding}, \@lines);
}

print sprintf("Merged %d entries.\n", scalar(@entries));

以下いいわけ

スクリプトの冒頭で標準入出力に対してぐちゃぐちゃやっていますが、これはっきり言っていらないと思う。(ファイル名に日本語が含まれていなければ本当にいらない)

open プラグマを使って、locale サポートの無い環境でのエンコーディング決め打ちするのと、locale によって設定させるのは、どうやったら共存できるように書けるのかなぁ。

Cygwin は locale サポートがあるので use open IO=>':locale' を使えるのですが、Windows の ActivePerl では locale タグは使えないんですね。

open は lexical pragma ではないので、BEGIN ブロックで環境を見て require & import すれば良いと思うんだけど…。上手く書けなくて、結局 binmode 使って済ませてしまった…。

あと、skkime のユーザ辞書の文字エンコーディングは skkime を使い始めた時期によって違う気がします。

関連

• u-ch: SKK-JISYO.L.cdb を最新にする