2014/03/21(金)Lingua::JA::KanjiTable - Perlで常用漢字表と人名用漢字表を扱う

プログラミング::Perlプログラミング::自然言語処理

https://metacpan.org/pod/Lingua::JA::KanjiTable

常用漢字表だけでも個人的には嬉しいのですが、人名用漢字表も用意してあるので妥当な名かのチェックもできます。戸籍法 第50条と戸籍法施行規則 第60条によると、子の名には常用漢字表の漢字と人名用漢字表の漢字と片仮名と平仮名が使えるようなので、以下のコードで名の妥当性をチェックできます。（名は Mock::Person::JP で出力）

#!/usr/bin/env perl
 
use strict;
use warnings;
use utf8;
use Lingua::JA::KanjiTable;
 
my @name_list = qw/希砂妃 みのる 菜奈世
勇凪 ソラ 未佑 茶流 怜実 紫翠 夢里/;
 
for my $name (@name_list)
{
    $name =~ /^p{InMei}+$/
        ? print "validn"
        : print "invalidn"
        ;
}
 
sub InMei
{
    return <<"END";
+Lingua::JA::KanjiTable::InJoyoKanji
+Lingua::JA::KanjiTable::InJinmeiyoKanji
3005
3041t3096
309D
309E
30A1t30FA
30FCt30FE
END
}
コメント（0件）

2014/03/08(土)PerlでServer-Sent Events

プログラミング::PerlWeb技術

サーバからPUSHされたイベントを受け取るやつ。（http://www.w3.org/TR/eventsource/）

Server-sent Event

最初リアルタイムで反映されなくて試行錯誤していたのですが、nginxの設定を変えたらリアルタイムで反映されるようになりました。（http://stackoverflow.com/questions/13672743/eventsource-server-sent-events-through-nginx）

コードは下の通りで「plackup」とかで立ち上げられます。

#!/usr/bin/env perl

use strict;
use warnings;
use AnyEvent;
use Time::Piece;
use HTTP::ServerEvent;

my $AFTER    = 1;
my $INTERVAL = 1;
my $DURATION = 60 * 30; # 秒

my $html = do { local $/; <DATA> };

my $app = sub {
    my $env = shift;

    if ($env->{PATH_INFO} ne '/sse/events')
    {
        return [ 200, ['Content-Type', 'text/html'], [$html] ];
    }

    if ( ! $env->{"psgi.streaming"} )
    {
        my $err= "Server does not support streaming responses";
        return [ 500, ['Content-Type', 'text/plain'], [$err] ];
    }

    return sub {
        my $responder = shift;
        my $writer    = $responder->([ 200, [ 'Content-Type' => 'text/event-stream; charset=UTF-8' ] ]);

        my $cnt = 0;

        my $t; $t = AnyEvent->timer(
            after    => $AFTER,
            interval => $INTERVAL,
            cb       => sub {
                my $now = localtime->strftime('%Y-%m-%d %H:%M:%S');

                my $event = HTTP::ServerEvent->as_string(
                    id   => ++$cnt,
                    data => $now,
                );

                $writer->write($event);

                undef $t if $cnt > $DURATION;
            }
        );
    };
};

__DATA__
<!DOCTYPE html>
<html lang="ja">
<head>
  <meta charset="UTF-8">
  <title>Server-Sent Events</title>
  <script src="http://ajax.googleapis.com/ajax/libs/jquery/2.1.0/jquery.min.js"></script>
</head>

<body>
  <h1>Server-Sent Events</h1>
  <div id="msg"></div>
  <script>
    var eventSource = new EventSource('/sse/events');
    var msg = $("#msg");

    eventSource.onmessage = function(e)
    {
        console.log("message");
        console.log(e.data);

        msg.prepend("<p>" + e.data + "</p>");
    };

    eventSource.onopen = function(e)
    {
        console.log("open");
    };

    eventSource.onerror = function(e)
    {
        console.log("error");
    };
  </script>
</body>
コメント（0件）

2014/03/02(日)Logwatch で Date::Manip unable to determine TimeZone が出た時の対処法

インフラ

とりあえず、rootになって現在のタイムゾーンを確認します。

perl -MDate::Manip::TZ -le 'print Date::Manip::TZ->new->zone;'

正常ならば、「Asia/Tokyo」とか出力されます。

ここで自分の場合は、以下のエラーが出ました。

ERROR: failed to load Date::Manip::Lang::english: Can't locate YAML/Syck.pm in @IN

そのため、「cpanm YAML::Syck」でYAML::Syckをインストールしました。（cpanm がないなら「cpan YAML::Syck」でOK）これで自分の場合はエラーが解消されました。

「Date::Manip::TZ」のドキュメントによると、↓の順番でチェックするようなので、出力がおかしかったら妥当なタイムゾーンが出力されるまでいじりましょう。

main     TZ
env      zone TZ
file     /etc/TIMEZONE
file     /etc/timezone
file     /etc/sysconfig/clock
file     /etc/default/init
command  "/bin/date +%Z"
command  "/usr/bin/date +%Z"
command  "/usr/local/bin/date +%Z"
cmdfield /bin/date             -2
cmdfield /usr/bin/date         -2
cmdfield /usr/local/bin/date   -2
gmtoff

詳細は↓ http://search.cpan.org/~sbeck/Date-Manip-6.42/lib/Date/Manip/TZ.pod#DETERMINING_THE_SYSTEM_TIME_ZONE

コメント（0件）

2014/02/08(土)WebページへのDirectional Formatting Charactersの埋め込み

Web技術 
<!DOCTYPE html>
<html lang="ja">
<head>
    <meta charset="UTF-8">
    <title>てすと</title>
</head>
<body>
<p>‮あいうえお</p>
</body>

で、ブラウザ上でも「おえういあ」になったので、Webアプリとかでは「Directional Formatting Characters」の入力を削除しておくべきっすね。（アラビア語やヘブライ語かけないと困るような場合は例外として）

実際はp要素のところはこう書いています。

<p>（U+202Eの文字を符号化したもの）あいうえお</p>
コメント（0件）

2014/02/07(金)PerlでのMalformed UTF-8文字を含む文字列の処理とutf-8-strictについて

プログラミング::Perl

深く理解できていないように感じたのでコードにまとめた。

準備：

perl -e 'print "ax{FFFF_FFFF}b"' > malformed_utf8.txt
perl -e 'print "x{FFFE}"' > FFFE.txt

コード：

#!/usr/bin/env perl

use strict;
use warnings;
use Encode qw/decode_utf8/;

my $IN_FILE  = 'malformed_utf8.txt';
my $IN_FILE2 = 'FFFE.txt';

{
  open(my $fh, '<', $IN_FILE) or die $!;
  chomp(my $text = <$fh>);
  close($fh);

  # malformed が来たら代替文字で置換
  print "Encode::DEFAULT\n";
  printf( "U+%04Xn", ord decode_utf8($_, Encode::FB_DEFAULT) ) for split(//, $text);

  # malformed が来たら即死
  print "Encode::FB_CROAK\n";
  eval { printf( "U+%04X\n", ord decode_utf8($_, Encode::FB_CROAK) ) for split(//, $text) };
  print "Encode::FB_CROAK: $@" if $@;

  # malformed が来たらこれまで処理したデータの一部を返す
  print "Encode::FB_QUIET\n";
  printf( "U+%04X\n", ord decode_utf8($_, Encode::FB_QUIET) ) for split(//, $text);

  # FB_QUIET + 警告（デバッグ時に便利）
  print "Encode::FB_WARN\n";
  printf( "U+%04X\n", ord decode_utf8($_, Encode::FB_WARN) )  for split(//, $text);

  print "\n";
}

## utf8 と utf-8-strict の区別
# utf と 8 の間にハイフン（またはアンダーライン '_'）があるかどうか（大文字小文字は関係なし）

## utf-8-strict ってなに？
# 以下の制約がある
# U+FDD0 .. U+FDEF の non-character code points を許さない
# Unicodeの各面の最後の２文字のnon-character code points を許さない（U+XXFFFE, U+XXFFFF. XX = 0 - 10）
# non-shortest エンコーディングを許さない
# ↑を許すと例えば非最短形式のスラッシュとかがバリデーションをすり抜けて脆弱性になりうる
# てなわけで外からの信頼できない入力には常に utf-8-strict を使うべき

{
  open(my $fh, '<:encoding(utf-8)', $IN_FILE) or die $!;
  chomp(my $text = <$fh>);
  close($fh);

  printf("U+%04X\n", ord) for split(//, $text);
  print "$text\n";
  print "\n";
}

{
  open(my $fh, '<:utf8', $IN_FILE) or die $!;
  chomp(my $text = <$fh>);
  close($fh);

  printf("U+%04X\n", ord) for split(//, $text);
  print "\n";
}

# ここから U+FFFE

{
  open(my $fh, '<:encoding(utf-8)', $IN_FILE2) or die $!;
  chomp(my $text = <$fh>);
  close($fh);

  printf("U+%04X\n", ord) for split(//, $text);
  print "$text\n";
  print "\n";
}

{
  open(my $fh, '<:utf8', $IN_FILE2) or die $!;
  chomp(my $text = <$fh>);
  close($fh);

  printf("U+%04X\n", ord) for split(//, $text);
  print "\n";
}

出力：

Encode::DEFAULT
U+0061
U+FFFD
U+FFFD
U+FFFD
U+FFFD
U+FFFD
U+FFFD
U+FFFD
U+0062
Encode::FB_CROAK
U+0061
Encode::FB_CROAK: utf8 "xFE" does not map to Unicode at /home/***/.plenv/versions/5.18.2/lib/perl5/site_perl/5.18.2/x86_64-linux/Encode.pm line 215.
Encode::FB_QUIET
U+0061
U+0000
U+0000
U+0000
U+0000
U+0000
U+0000
U+0000
U+0062
Encode::FB_WARN
U+0061
utf8 "xFE" does not map to Unicode at /home/***/.plenv/versions/5.18.2/lib/perl5/site_perl/5.18.2/x86_64-linux/Encode.pm line 215.
U+0000
utf8 "x83" does not map to Unicode at /home/***/.plenv/versions/5.18.2/lib/perl5/site_perl/5.18.2/x86_64-linux/Encode.pm line 215.
U+0000
utf8 "xBF" does not map to Unicode at /home/***/.plenv/versions/5.18.2/lib/perl5/site_perl/5.18.2/x86_64-linux/Encode.pm line 215.
U+0000
utf8 "xBF" does not map to Unicode at /home/***/.plenv/versions/5.18.2/lib/perl5/site_perl/5.18.2/x86_64-linux/Encode.pm line 215.
U+0000
utf8 "xBF" does not map to Unicode at /home/***/.plenv/versions/5.18.2/lib/perl5/site_perl/5.18.2/x86_64-linux/Encode.pm line 215.
U+0000
utf8 "xBF" does not map to Unicode at /home/***/.plenv/versions/5.18.2/lib/perl5/site_perl/5.18.2/x86_64-linux/Encode.pm line 215.
U+0000
utf8 "xBF" does not map to Unicode at /home/***/.plenv/versions/5.18.2/lib/perl5/site_perl/5.18.2/x86_64-linux/Encode.pm line 215.
U+0000
U+0062

utf8 "xFFFFFFFF" does not map to Unicode at read_malformed_utf8.pl line 48.
U+0061
U+005C
U+0078
U+007B
U+0046
U+0046
U+0046
U+0046
U+0046
U+0046
U+0046
U+0046
U+007D
U+0062
ax{FFFFFFFF}b

U+0061
U+FFFFFFFF
U+0062

utf8 "xFFFE" does not map to Unicode at read_malformed_utf8.pl line 69.
U+005C
U+0078
U+007B
U+0046
U+0046
U+0046
U+0045
U+007D
x{FFFE}

U+FFFE
コメント（0件）