W45TからiPhoneへの電話帳データ移行

自分が今まで使っていたAUケータイW45Tは、電話帳データの入力項目は

名前
フリガナ(半角カタカナ)

という形式だった。この半角カタカナのフリガナをもとに五十音順に並べ替えたり検索したりしていた。
ところがiPhoneでは、

姓
姓のふりがな(全角ひらがな)
名
名のふりがな(全角ひらがな)

という入力項目になっている。

W45Tのアドレス帳データバックアップ
できたvcfファイルをMacのAddress Book.Appでインポート
インポートした連絡先データをiPhoneと同期

という手順でデータを移行させると、もともと姓と名を分けたり全角ひらがなのふりがなを振ったりなんてしていないので、フルネームが「姓」の欄に突っ込まれて他は空欄、という状態になってしまっていた。ふりがなが無いので並び順も漢字の順番で探しにくい。これは困る。

ただ、自分はW45Tでも基本的に姓と名の間にスペースを入れていたので(漢字、フリガナ両方とも)、なんとか自動で分けて入力しなおすことができるんじゃないか、と思い立ったわけです。
というか手入力が途中でイヤになったｗ
なので、途中まで編集したAddress Book.Appのデータをもう一度vcfデータで書き出し、それとW45Tのバックアップデータを照らし合わせて名前の欄を編集して新しくvcfデータを作成する、というスクリプトを書いた。

#!/usr/bin/perl
use strict;
use warnings;

use Encode;
use Encode::JP::H2Z;
use Unicode::Japanese;

print "usage: $0 <target_file> <src_file>\n" and exit 1 if @ARGV < 2;
my $target_file = shift;
my $src_file = shift;

# ターゲットのデータ読み込み
my @array = ();
if (open my $fh, '<', $target_file) {
    my %data = ();
    while (my $line = readline $fh) {
        chomp $line;
        $line =~ s/\r//;
        if ($line =~ /^(BEGIN|END):VCARD/) {
            %data = () if $1 eq 'BEGIN';
            push @array, {%data} if $1 eq 'END';
            next;
        }
        (my $key, my @value) = split(/:/, $line);
        $data{$key} = \@value;
    }
    close $fh;
} else {
    die qq/"$target_file" $!/;
}

# 元データ読み込み
my @src_array = ();
if (open my $fh, '<', $src_file) {
    my %src_data;
    while (my $line = readline $fh) {
        chomp $line;
        if ($line =~ /^(BEGIN|END):VCARD/) {
            %src_data = () if $1 eq 'BEGIN';
            push @src_array, {%src_data} if $1 eq 'END';
            next;
        }
        (my $key, my $value) = split(/:/, $line);
        next unless defined $value;
        Encode::from_to($value, 'shift-jis', 'utf-8');
        $src_data{$key} = $value;
    }
} else {
    die qq/"$src_file" $!/;
}

# 元データからふりがなデータを作成
for my $data (@src_array) {
    my $name = $data->{'SORT-STRING'};
    Encode::from_to($name, "utf-8", "euc-jp");
    Encode::JP::H2Z::h2z(\$name);
    Encode::from_to($name, "euc-jp", "utf-8");
    my $uj = Unicode::Japanese->new($name, 'utf8');
    my $hira = $uj->kata2hira->get;
    (my $family_hira, my $first_hira) = split(/ +/, $hira);
    # 新しい領域へ格納
    $data->{'family_hira'} = $family_hira;
    $data->{'first_hira'} = $first_hira;
}

# ターゲットデータから新しく情報を生成
for my $data (@array) {
    print "BEGIN:VCARD\r\n";
    print "VERSION:", $data->{VERSION}->[0], "\r\n";
    # ふりがなが振られていない連絡先
    unless (defined $data->{'X-PHONETIC-FIRST-NAME'} &&
              defined $data->{'X-PHONETIC-LAST-NAME'}) {
        (my $family_name, my $first_name) = split / +/, $data->{'FN'}->[0];
        # 姓と名が分けられている場合のみ対応する
        if (defined $family_name && defined $first_name) {
            for my $src_data (@src_array) {
                # 同じ名前の人物を探す
                if ($src_data->{'FN'} eq $data->{'FN'}->[0]) {
                    if (defined $src_data->{'family_hira'} &&
                          defined $src_data->{'first_hira'}) {
                        print 'X-PHONETIC-FIRST-NAME:', $src_data->{'first_hira'}, "\r\n";
                        print 'X-PHONETIC-LAST-NAME:', $src_data->{'family_hira'}, "\r\n";
                    }
                }
            }
            $data->{'N'}->[0] = "$family_name;$first_name;;;";
            $data->{'FN'}->[0] = "$family_name $first_name";
        }
    }
    # その他の情報はそのまま書き出す
    for my $key (keys %$data) {
        next if $key eq 'VERSION';
        print "$key:", join(':', @{$data->{$key}}), "\r\n";
    }
    print "END:VCARD\r\n";
}

何件か漏れはあったけど、200件くらい残っていた未処理連絡先が一気に片付けることができたので自分としては満足。
同じような状況になる人はそういないと思うけど、一応記録に残しておく。