読者です 読者をやめる 読者になる 読者になる

アルパカDiary Pro

はてなブログProではありません

半々自動化

地震

sugyanさんに影響されて。


Google避難所名簿をクロールしてテキスト部分を抽出/zip化してサイトに置いてみました。*1
ttp://www2125u.sakura.ne.jp/jisin/*2


さらに、anpiレポートcsvが提供されたので
ダウンロードしたanpiレポートCSVの名前から
あらかじめクロールしておいたテキスト(またはその他避難者名簿のテキスト)をgrepするスクリプトを組んでみました。
書き捨てなので酷いスクリプトですが。

スクリプト(anpi.pl)

use strict;
use Text::CSV_XS;
use Encode qw/decode_utf8 encode_utf8/;
use Lingua::JA::Regular::Unicode qw/katakana2hiragana hiragana2katakana/;
use feature ':5.10';
use Log::Minimal;

#$ENV{LM_DEBUG} = 1;

sub main {
    my $filename = ($ENV{LM_DEBUG}) ? 'anpilist_test.csv' : 'anpilist.csv';
    open my $fh, '<', $filename;
    my $csv = Text::CSV_XS->new({ binary => 1 }) or
    die "Cannot use CSV: ".Text::CSV->error_diag ();

    # 1行目は捨てる
    $csv->getline ($fh);

    $DB::single = 1;
    while (my $line = $csv->getline ($fh)) {
        my ($check,$name_kanji,$name_kana) = @$line[0..2];
        my ($address) = $line->[3];
        next if $check eq '確認済み';

        my @search_str=();
        $name_kanji = trim($name_kanji);
        if($name_kanji && $name_kanji ne '' && !check_exclude($name_kanji)) {
            my $kanji = $name_kanji;
            push @search_str, spreg($kanji);
        }
        $name_kana = trim($name_kana);
        if($name_kana && $name_kana ne '' && !check_exclude($name_kana)) {
            my $hiragana = katakana2hiragana(decode_utf8($name_kana));
            my $katakana = hiragana2katakana(decode_utf8($name_kana));
            utf8::encode($hiragana) if utf8::is_utf8($hiragana);
            utf8::encode($katakana) if utf8::is_utf8($katakana);
            push @search_str, spreg($hiragana);
            push @search_str, spreg($katakana);
        }
        if(ack(\@search_str) ==0 ){
            #hit
            infof("<<< $name_kanji : $name_kana : $address >>>");
            say;
        }
    }
    $csv->eof or $csv->error_diag ();
    close $fh;
}

sub trim {
    my $str = shift;
    $str =~ s/\?+//g;
    $str =~ s/\s+//g;
    return $str;
}

sub check_exclude {
    my $str = shift;
    # 苗字だけのレコードは除外
    my @list = qw/
       高橋 たかはし タカハシ
       佐々木 ささき ササキ
       斎藤 サイトウ さいとう
       吉田 よしだ ヨシダ
       今野 こんの コンノ
       山本 ヤマモト やまもと
       小松 こまつ コマツ
       佐藤 さとう サトウ
       鈴木 すずき スズキ
       藤田 ふじた フジタ
       村上 むらかみ ムラカミ
       菊池 きくち キクチ
       門馬 もんま モンマ
       伊藤 伊東 いとう イトウ
       後藤 ごとう ゴトウ
       及川 おいかわ オイカワ
       植木 うえき ウエキ
       三浦 みうら ミウラ
       岩崎 いわさき イワサキ
       池田 いけだ イケダ
       大山 おおやま オオヤマ
       とが トガ
    /;
    for (@list){
        return 1 if decode_utf8($_) eq decode_utf8($str);
    }
    return 0;
}

sub spreg {
    my $str = shift;
    my $decode_str = decode_utf8($str);
    my $zen = decode_utf8(' ');
    # スペース部分は若干ゆらぎをもたせる
    $decode_str =~ s/(\s|$zen)/(\\s|$zen)?/;
    return encode_utf8($decode_str);
}

sub ack {
    my $searchs = shift;
    my $str = join('|', @$searchs);
    return 1 unless $str;

    my $cmd = "ack --nopager --all '$str' plain";
    debugf "cmd : $cmd";
    my $ret = system($cmd);
    die 'ack die [$ret]' if $ret < 0;
    return $ret;
}

main();

1;

仕様

1カラム目が「確認済み」以外のレコードのみを対象にして、
「漢字」「ひらがな」「カタカナ」
のパターンで文字列検索します。

使い方

スクリプト直下に plain というディレクトリを掘って、そこに生のテキストファイルを置いておきます。
(テキストファイルなら何でもいいです)


あとは

perl anpi.pl

を実行するだけ。

plain 以下のテキストファイルからマッチした文字列、
それとヒットしたファイル名と行数が出力されるので、
そこから手動でGooglePersonFinderやanpiレポートなどを確認していく感じです。


また、無駄にack使っているのはグラフィカルで確認したいがためです。
以下スクリーンショット(念のためモザイクかけてます)

安否確認について

知り合いの安否がわからないというのは、待っている方も辛いものです。
一人でも多くの方の不安を取り除いてあげられればいいなと思いました。

*1:基本はPersonFinderに登録されているようなので、あまり意味はないかもしれませんが…

*2:現在は削除