Perlの最近のブログ記事

リストリファレンス(参照配列)やハッシュリファレンス(参照連想配列)は Perl の鬼門だ。

リファレンス(参照)の考え方を学ぼうとした時、言語が Perl だったら多分理解する前にギブアップすると思う(笑)

Perl は変数の前にシジルと呼ばれる記号を付けて、その変数の種類(という言い方が正しいのかどうなのか)を指定する。これは Perl アンチにとっては「Perl の駄目なところ」だし、Perl 信者にとっては「Perl の良いところ」だ。
まあ、俺は好きだけどね。このお陰で、予約語と変数名がぶつかることがないので。

ちなみに、$ が付いているのがスカラー変数(文字や数値などの一つの値がセットされる変数)、@ が配列(リスト)、% が連想配列(ハッシュ)である。

しかし、これがまた Perl 初心者の人がソースを読む時の障害にもなるんだよねえ。特にリファレンスを使おうとすると、$、@、% などのシジルに加えて、リファレンスの \$、\@、\% や、デリファレンスする時の $$、@$、%$ のようなシジルも出てきてもうわやくちゃ(笑)
シジルだけで、それが配列なのか配列リファレンスなのか理解せえや!の世界だ。
リファレンスとデリファレンスの、どっちが $@ だったか \@ だったかもしばらく使ってないと忘れちゃうしね。

リファレンスの勉強がしたければ C言語とかで学ぶことをオススメします(笑)

で、いつも多重リファレンスの時の書き方アレコレを忘れてしまうので、このブログにメモっとく。

$oya ... 一番大きな配列リファレンス。つまり親。
$ko1 他 ... $oya の要素のひとつとなる配列リファレンス。つまり子。
$mago11 他 ... $ko の要素のひとつとなる連想配列リファレンス。つまり孫。

普通の配列とはリファレンスの宣言は以下のように異なる。

my @array = (); # リスト
my %hash = (); # ハッシュ
my $array = []; # リストリファレンス
my $hash = {}; # ハッシュリファレンス

各リファレンスへの値のセットと抽出の仕方を Perl のコードにしてみる。

    my $oya       = [];   # リストリファレンスの宣言

    my $ko1       = [];   # リストリファレンスの宣言
    my $mago11    = {};   # ハッシュリファレンスの宣言
    my $mago12    = {};   # ハッシュリファレンスの宣言

    my $ko2       = [];   # リストリファレンスの宣言
    my $mago21    = {};   # ハッシュリファレンスの宣言

    $mago11->{'01'} = 'abc';   # ハッシュリファレンス mago11 に値をセット
    $mago11->{'02'} = 'def';   #  〃
    $mago11->{'03'} = 'ghi';   #  〃

    $mago12->{'01'} = 'jkl';   # ハッシュリファレンス mago12 に値をセット
    $mago12->{'02'} = 'mno';   #  〃

    push @$ko1, $mago11;       # 子リストリファレンスに孫ハッシュリファレンスを push
    push @$ko1, $mago12;       #  〃

    $mago21->{'01'} = 'pqr';   # ハッシュリファレンス mago21 に値をセット
    $mago21->{'02'} = 'stu';   #  〃
    $mago21->{'03'} = 'vwx';   #  〃

    push @$ko2, $mago21;       # 子リストリファレンスに孫ハッシュリファレンスを push

    push @$oya, $ko1;          # 親リストリファレンスに子リストリファレンスを push
    push @$oya, $ko2;          #  〃

    # 親リストリファレンスから子リストリファレンスの抽出
    # リファレンスの要素数を確認するには、デリファレンスしてスカラー値を取得
    for ($i = 0; $i < scalar(@$oya); $i++) {

        # 一時リストリファレンスに子リストリファレンスをセット
        my $array    = [];
        $array       = $oya->[$i];

        # 子のリストリファレンスから孫ハッシュリファレンスを抽出
        # リファレンスの要素数を確認するには、デリファレンスしてスカラー値を取得
        for ($j = 0; $j < scalar(@$array); $j++) {

            # 一時ハッシュリファレンスに孫ハッシュリファレンスをセット
            my $hash    = {};
            $hash       = $array->[$j];

            # keys でハッシュキーを抜き出すには、デリファレンスする
            foreach $key(keys %$hash) {

                print "キー=" . $key . " 値=" . $hash->{$key} . "\n";

            }

        }

    }

ちなみに、上記コードではリファレンスしか使っていないが、通常の配列(リスト)に連想配列(ハッシュ)をセットするには、セットするハッシュをリファレンス化する。

    my @ko1       = ();   # リストの宣言
    my %mago11    = ();   # ハッシュの宣言
    my %mago12    = ();   # ハッシュの宣言

    $mago11{'01'} = 'abc';   # ハッシュ mago11 に値をセット
    $mago11{'02'} = 'def';   #  〃
    $mago11{'03'} = 'ghi';   #  〃

    $mago12{'01'} = 'jkl';   # ハッシュ mago12 に値をセット
    $mago12{'02'} = 'mno';   #  〃

    push @ko1, \%mago11;     # ハッシュリファレンスとしてセット
    push @ko1, \%mago12;     # ハッシュリファレンスとしてセット

    foreach $ko(@ko1) {      # リストからハッシュリファレンスを1件読み出し

        # keys でハッシュキーを抜き出すには、デリファレンスする
    foreach $key (keys %$ko) { 

            print "キー=" . $key . " 値=" . $ko->{$key} . "\n";

    }

    }

こんな感じ。

俺的には最初から最後までリファレンスで処理するのが好み。リファレンスにしたりデリファレンスしたりしてるとわけわかんなくなる(^^;
UTF-8 で入出力している Web システムがあるんだけど、最終的に Winodows PC ベースのシステムにデータ持ち込んで印刷してるんで、Shift_JIS(てか、CP932だな)に変換できない文字は入力エラーにしてほしいという要望が。

元々、UTF-8 の 3バイト文字で 0xE28480 から 0xE38FBE までの文字(例外あり)は入力制限してたんだけど、もう少し厳密に・・・という話。

予算的に自前の変換表作ってというのは厳しいので、なんか良いものがないかなあと探してたんだけど、Perl の Encode::from_to メソッドが使えそう。

これ、Encode モジュールのメソッドで、

Encode::from_to( $text, "UTF8", "Shift_JIS");

と書けば、変数 $text の内容を UTF-8 から Shift JIS に変換してくれるんだけど、ここにオプション XMLCREF をつけると、変換できなかった文字(UTF-8 に有って、Shift JIS に無い文字)を数値文字参照コードで出力してくれる。

例えば「ハシラダカ」と呼ばれる「髙」の文字は Shift JIS には無いので、「髙林」を

Encode::from_to( $text, "UTF8", "Shift_JIS", Encode::XMLCREF );

という具合に変換してやれば、

&#x9ad9;林

という結果が $text にセットされる。&#x9ad9; が数値文字参照コードね。
ちなみに、Windows 拡張版の Shift JIS(Windows-31j)であれば「ハシラダカ」も文字セットに含まれているので、

Encode::from_to( $text, "UTF8", "CP932", Encode::XMLCREF );

であれば、そのまま「髙林」が結果に返ってくる。
もちろん、Windows-31j に含まれていない文字は数値文字参照コードで返ってくる。

もう、これでいいんじゃね?(笑)

変換後の文字を↓こんな風にチェックして、'OK'、'NG' を返してやる API を作れば、多言語で作成した Web システムからも呼べるしね。

if ($text =~ /\&\#[^\;]+\;/) {
    return('NG');
}
return('OK');

いやあ、Perl 良いわあ。
セキュリティとか考えても、実際、こういう枯れた技術を使うのは '吉' なんだけど、ま、チーム開発のやりやすさとか、メーカーからの公式サポートとか、他にも理由があって Java とか VB.NET とかになっちゃうんだろうけど。
久しぶりに DB データが「ハッシュの配列」にセットされまくってる感じの Perl プログラムのメンテを行うことになったので、ハッシュ(連想配列)のリファレンスなどについてメモ。

まあ、Perl の多次元配列については、木本裕紀さんの「Perl学習サイト - サンプルコードPerl入門」サイトの中の「配列とハッシュで多次元データ構造を自由に操る」がそのまま参考になる。

なので、ここで書いているのはその補足。

ハッシュ(連想配列)を配列にセットした、いわゆる「ハッシュの配列」を扱う場合。

下のコードは、PostgreSQL から取得したデータをセットしてる例(余分な処理は削ってるので、「例外に対する処理が甘い」とか、そういうツッコミはなしで(笑))

@persons = ();

# DB から $sql の条件でデータ取得(例えば、クラス名簿とか)
$result = $Conn->exec($sql);
if (!$result->resultStatus eq PGRES_TUPLES_OK) {
# DB エラーなら処理を抜ける
exit;
}

# 人数分データを読み込む
for ($i = 0 ; $i < $result->ntuples ; $i++) {
# DB から取得した名前、性別、年齢をハッシュにセット
my %person = ();
$person{'name'} = $result->getvalue($i, $result->fnumber(name));
$person{'sex'} = $result->getvalue($i, $result->fnumber(sex));
$person{'age'} = $result->getvalue($i, $result->fnumber(age));
# ハッシュを配列にセット
push @persons, \%person;
}

これで、クラス名簿が「ハッシュの配列」にセットされる。

全員のデータを読みだそうとしたら、

foreach $person (@persons) {
foreach $key (keys %$person) {
$value = $person->{$key};
print "$key : $value\n";
}
}

こうすれば抜き出せる。

結果は、

name : Masunori
sex : m
age : 23
name : Beiko
sex : f
age : 44
.....
name : Taro
sex : m
age : 18

こんな風に表示される。

では、全件出力するのではなく、最初の人のデータだけ読み出したいって場合。
例えば、一人目の人の性別を確認とか。

ポイントは、「ハッシュの配列」はただの配列ではなく、実際は「ハッシュのリファレンス」を要素に持つ「配列のリファレンス」ということ。
そのため、@persons を参照するには @$persons のように配列のデリファレンスを行なう必要あり。

print @$persons[0]->{'sex'};

このように書けばいいのね。これで「m」という結果が表示される。
以前、俺が Perl で書いた API プログラムについて「別サーバに移したら DBI モジュールが無くて動かないみたいなのでヨロシク」・・・という指示がお客さんからあったので対応。

CentOS サーバなのだが、

# perl
use DBI;
Can't locate DBI.pm in @INC (@INC contains: /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi /usr/lib/perl5/site_perl/5.8.8 <略> .) at - line 1.
BEGIN failed--compilation aborted at - line 1.

確かに DBI モジュールがインストールされていないようなので入れる。

このサーバ、ローカルネットワークの外には出れないようになっているので、インターネットに接続できる Windows PC でダウンロードしたファイルをサーバに SFTP アップして作業をする。

取ってくるファイルは、最新のアーカイブ。
CPAN サイト
から、DBI-1.636.tar.gz をダウンロードし、サーバに上げて以下作業を行った。

# tar xvfz DBI-1.636.tar.gz
DBI-1.636/
DBI-1.636/Changes
DBI-1.636/dbd_xsh.h
DBI-1.636/DBI.pm
<略>
DBI-1.636/ex/corogofer.pl
DBI-1.636/ex/perl_dbi_nulls_test.pl
DBI-1.636/ex/profile.pl
# cd DBI-1.636
# perl Makefile.PL

*** Your LANG environment variable is set to 'ja_JP.UTF-8'
*** This may cause problems for some perl installations.
*** If you get test failures, please try again with LANG unset.
*** If that then works, please email dbi-dev@perl.org with details
*** including the output of 'perl -V'

Your perl was compiled with gcc (version 4.1.2 20080704 (Red Hat 4.1.2-55)), okay.
Creating test wrappers for DBD::Gofer:
t/zvg_01basics.t
<略>
Checking if your kit is complete...
Looks good
Warning: prerequisite ExtUtils::MakeMaker 6.48 not found. We have 6.30.
Warning: prerequisite Test::Simple 0.90 not found. We have 0.62.

    I see you're using perl 5.008008 on x86_64-linux-thread-multi, okay.
    Remember to actually *read* the README file!
    Use  'make' to build the software (dmake or nmake on Windows).
    Then 'make test' to execute self tests.
    Then 'make install' to install the DBI and then delete this working
    directory before unpacking and building any DBD::* drivers.

Writing Makefile for DBI

ExtUtils::MakeMaker
Test::Simple
この2つのバージョンが古いって警告(Warning)が出てるけど、この2つを入れ直そうとすると依存関係すごそう(^^;
上に書いたように、依存関係のあるモジュールについても一個一個手動インストールするしかないんで、「ま、Warning なんで・・・」と、とりあえず無視してインストールしちゃう。

# make
<略>
Manifying blib/man3/DBI::DBD.3pm
Manifying blib/man3/Win32::DBIODBC.3pm
Manifying blib/man3/DBI::DBD::SqlEngine.3pm
Manifying blib/man3/DBI::PurePerl.3pm
Manifying blib/man3/DBI::ProfileData.3pm

特にエラーは出てない。問題なく make できたっぽいなあ。
まあ、make test は予想どおりボロボロですけど。

# make test
<略>
Failed Test                    Stat Wstat Total Fail  Failed  List of Failed
-------------------------------------------------------------------------------
t/06attrs.t                     255 65280    ??   ??       %  ??
t/08keeperr.t                   255 65280    ??   ??       %  ??
t/10examp.t                     255 65280   238  476 200.00%  1-238
t/42prof_data.t                 255 65280    31   58 187.10%  3-31
t/48dbi_dbd_sqlengine.t         255 65280    ??   ??       %  ??
<略>
t/zvxnp_52dbm_complex.t         255 65280    ??   ??       %  ??
t/zvxnp_85gofer.t               255 65280    ??   ??       %  ??
32 tests and 225 subtests skipped.
Failed 74/194 test scripts, 61.86% okay. 1010/4579 subtests failed, 77.94% okay.
make: *** [test_dynamic] エラー 255

ずいぶんエラーが発生しているけど、

t/zvp_10examp.t                 255 65280   238  476 200.00%  1-238

のように、全テスト件数が 238 なのに、faild になったエラーが 476件あって、エラー発生率 200%というおかしなものも混ざっているので、とりあえず無視。

インストールしてみる。

# make install
Installing /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi/auto/DBI/DBIXS.h
Installing /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi/auto/DBI/Driver.xst
Installing /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi/auto/DBI/DBI.bs
<略>
Installing /usr/bin/dbiprof
Installing /usr/bin/dbilogstrip
Writing /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi/auto/DBI/.packlist
Appending installation info to /usr/lib64/perl5/5.8.8/x86_64-linux-thread-multi/perllocal.pod

まあ、インストールはファイルのコピーするだけだからイクわな。

# perl
use DBI;

とりあえず、エラーは出なくなった。
次は DBD::Pg モジュールのインストール。
PostgreSQL インストールして DBI と DBD::Pg の2つの Perl モジュールをインストール。

もちろん cpan でささっと・・・と行きたいが、相変わらず DBD::Pg は cpan じゃ make test が引っかかってうまくいかないな(^^;

これ、うまくいくケースってあるの?

もう、20年近く(Pg.pm の時代から)DBD::Pg インストールしてきたけど、一回もすんなり cpan コマンド一発でインストールに成功したことないんだけど(^^;
多くの人の環境でエラーになるような test なら意味ないと思うんだけど?
少なくとも、cpan の手順からだけでも make test なんか抜いてしまえばいいんじゃないかと・・・

ま、そりゃ無理なんだろうけどさ。

というわけで、いつものように make test だけ吹っ飛ばすよう手作業でインストール。

# cp /root/.cpan/sources/authors/id/T/TU/TURNSTEP/DBD-Pg-3.5.3.tar.gz ~postgres
# chown postgres ~postgres/DBD-Pg-3.5.3.tar.gz
# su - postgres
$ tar xfzp DBD-Pg-3.5.3.tar.gz
$ cd DBD-Pg-3.5.3
$ perl Makefile.PL
$ make
$ exit
# cd /usr/local/pgsql/DBD-Pg-3.5.3
# make install

で、OK。

パスを通して、一般ユーザで試しに使ってみる。

$ PATH=$PATH:$HOME/bin:/usr/local/pgsql/bin
$ export POSTGRES_HOME=/usr/local/pgsql
$ export PGDATA=$POSTGRES_HOME/data
$ export PGLIB=$POSTGRES_HOME/lib
$ export LD_LIBRARY_PATH=$POSTGRES_HOME/lib
$ perl
use DBD::Pg;
Can't load '/usr/local/lib64/perl5/auto/DBD/Pg/Pg.so' for module DBD::Pg: libpq.so.5: 共有オブジェクトファイルを開けません: そのようなファイルやディレクトリはありません at /usr/lib64/perl5/DynaLoader.pm line 190.
 at - line 1.
Compilation failed in require at - line 1.
BEGIN failed--compilation aborted at - line 1.

あかんやん。「libpq.so.5: 共有オブジェクトファイルを開けません」でググったら、俺のこのブログが最初にヒットした(^^;


毎回、同じことで引っかかとるんやあ(^^;;

root で、

# chmod 755 /usr/local/pgsql

として、

$ perl
use DBD::Pg;
^D

なんのエラーも出ない。ばっちりやん(笑)

手動インストールに使ったファイル消しとこ。

$ \rm -R DBD-Pg-3.5.3
rm: 書き込み保護されたファイル 通常ファイル `DBD-Pg-3.5.3/blib/lib/DBD/Pg.pm' を削除しますか?y
rm: 書き込み保護されたファイル 通常ファイル `DBD-Pg-3.5.3/blib/lib/Bundle/DBD/Pg.pm' を削除しますか?y
$ \rm DBD-Pg-3.5.3.tar.gz

いやあ、今回は、shinodaさんの「電気ウナギ的○○」というサイトがすごく役に立った!!(笑)
先月から今月にかけて、夜間や休みの日に、古い(それこそ10年くらい前に作ったものとか)Perl CGI のソースの修正をしてて、まあ、自分で作ったものはなんとかなるんだけど、外注さんに頼んで作ったものとか、自分のやり方とは違ってたりしてハマるわぁ(^^;

例えば、俺はテンプレートの HTML ファイルに動的な値を貼り付ける時に自前で処理を書くんだけど(まあ、正規表現で値を書き込む箇所のマーカーになる文字列見つけて置換するだけだし)、以前よく使っていた外注さんは HTML::Template モジュールを使っていた。
PHP の Smarty みたいな高機能テンプレートエンジンね。

テンプレートエンジンを使うと、ちょっとした HTML のデザイン変更の時にプログラムソースに手を入れなくても HTML テンプレートだけ直せばどうにかなるので便利なことも多いんだけど、うちの仕事だと「どっちみちプログラムも直さないといけないケース」が多いんで、結局「プログラム修正」「HTML::Template のルールに沿ったテンプレートの修正」の両方が発生しちゃうからあんまり工数の削減や修正のしやすさにつながらないんだよね。
テンプレートエンジン厨の怨嗟の声が聞こえてきそうだけど(笑)

テンプレートエンジンに限らず、こういうのを使う/使わないはケース・バイ・ケースなのよ。使った方がいいのに使わないのも愚かだけど、どんなケースでも、常に HTML::Template モジュールを使うというのも愚かなこと。

ま、そういうわけで、俺自身は「別に使わなくていいんじゃないの」というケースが多いから、今まで使ったことがほとんどなくて(まったく無いわけじゃないけど)、たまに使うと(って、ほとんど他人が作ったもののメンテナンスだけど)下らないことでハマっちゃうんよね(^^;

今日も、仕様変更にともなってテンプレート HTML の不要な部分をバサッと削ったら、いきなり Internal Server Error が出始めて、なんじゃ?とログを見たら・・・

[Sat Feb 13 18:13:42 2016] [error] [client 202.XXX.XXX.XXX] HTML::Template->new() : found </TMPL_LOOP> with no matching <TMPL_LOOP> at template.html : line 133! at HTML/Template.pm line 1558., referer: http://exsample.co.jp/cgi-bin/hogehoge.cgi
[Sat Feb 13 18:13:42 2016] [error] [client 202.XXX.XXX.XXX] Premature end of script headers: hogehoge.cgi, referer: http://exsample.co.jp/cgi-bin/hogehoge.cgi

ああ・・・<TMPL_LOOP> と </TMPL_LOOP> がアンマッチだとおっしゃってる(^^;

確かに、

<!--tmpl_loop name="hogehoge_list"-->
 ~ほげほげ~
<!--/tmpl_loop-->

の、

<!--tmpl_loop name="hogehoge_list"-->

だけ消して、

<!--/tmpl_loop-->

が残ってるわぁ(^^;気づかんかった(^^;

で、素直に修正すればよかったんだけど、あんま日頃 HTML::Template モジュール使わないんで、Template クラスをインスタンス化する時、

my $template = new HTML::Template(
filename => $filename,
die_on_bad_params => 0,
path => DEF_TMP_DIR
);

みたいに die_on_bad_params オプションに 0 を与えておけば、エラーは全て無視をしてベストエフォートな実行をしてくれるのだと思い込んでて、なんかインスタンス化のオプションの組み合わせがおかしいんじゃないかとか、変なところで悩んでハマってしまった(^^;

die_on_bad_params は読んで字のごとく、「テンプレートで定義していないパラメータを処理しようとしても無視する」ってだけのことなのね(^^;
つまり、hoge というパラメータで指定された部分を置換しようとした時、実際にはテンプレート上に

<!--tmpl_var name="hoge"-->

という記述がなければエラーになるけど、それを無視するってだけのオプション・・・
さすがに、「ループの終了はあるのに、ループの開始は無い」ようなエラーまでは無視してくれんか(^^;

エラーメッセージやマニュアルの記述は、素直に言葉通りに解釈せよということですな(^^;

という反省エントリーでありました(笑)
サーバ移行案件で、ある Perl プログラムを新サーバに移行した。

そのプログラムは、LWP::UserAgent モジュールを使って、外部の HTTPS サーバと通信をしている。
まあ、写真のデータを取ってくるだけなんですけど。

ところが、新しいサーバで HTTPS 接続しても空のデータしか取れない。

Crypt::SSLeay
IO::Socket::SSL

や、ついでに

Net::SSLeay

とかとか。SSL 通信を行なうためのモジュールは入っているのに・・・である。

試しに、

#!/usr/bin/perl
use HTTP::Status;
use LWP::UserAgent;
$ua = new LWP::UserAgent;
$ua->agent("LWP::GETHEAD");
$url = $ARGV[0];
$request = new HTTP::Request HEAD => $url;
$response = $ua->request($request);
print "Content-Type:\t", $response->header("Content-Type"),"\n";
print "Content-Length:\t", $response->header("Content-Length"),"\n";
print "Last-Modified:\t", $response->header("Last-Modified"),"\n";
print "Expires:\t", $response->header("Expires"),"\n";
print "Server: \t", $response->header("Server"),"\n";

こういうスクリプトを作って走らせてみても、

# perl test.pl https://www.exsample.jp/
Content-Type:   text/plain
Content-Length:
Last-Modified:
Expires:
Server:

という寂しい結果が返ってくるだけ。

なんじゃ?と思ったのだが、そう言えば IO::Socket::SSL モジュールのバージョンが上がって、「ホスト同士で証明書交換せえよ。それが出来んのだったら『セキュリティ的には緩くなっちゃうのがわかってて、あえて証明書は用意してないんですよ』という意思表明のために、verify_hostname オプションを明示的に書けよ」ということになったのを思い出した。以前、このブログにも書いたことあるけどな。

というわけで、スクリプトに、

#!/usr/bin/perl
use HTTP::Status;
use LWP::UserAgent;
$ua = new LWP::UserAgent;
$ua->agent("LWP::GETHEAD");
$ua->ssl_opts( verify_hostname => 0 );
$url = $ARGV[0];
$request = new HTTP::Request HEAD => $url;
$response = $ua->request($request);
print "Content-Type:\t", $response->header("Content-Type"),"\n";
print "Content-Length:\t", $response->header("Content-Length"),"\n";
print "Last-Modified:\t", $response->header("Last-Modified"),"\n";
print "Expires:\t", $response->header("Expires"),"\n";
print "Server: \t", $response->header("Server"),"\n";

という具合に一文入れてやるだけで、

# perl test.pl https://www.exsample.jp/
Content-Type:   text/html
Content-Length: 18469
Last-Modified:  Sun, 01 Mar 2015 00:04:16 GMT
Expires:
Server:         Apache

このように通信可能となる。

そう言えば、この当該プログラムを書いたの、6年も前だ(^^;

長く動いているプログラムは、移行の時に色々ある(^^;
EUC コードで保存されているデータがありまして、中に「髙」(所謂「ハシラダカ」)とか、EUC-JP ではサポートしていない文字が含まれていまして、Jcode を使った

$str = Jcode->new($str, 'euc')->utf8;

という変換では、「髙」(ハシラダカ)は UTF-8 に含まれているにも関わらず「?」と変換されてしまいます。というか、変換されません・・・が正しいか。

EUC-JP には「髙」という文字は「無い」ので、実際には計算式にしたがって EUC-JP のコード体系に合ったコードに変換されて保存されているんだけど、Jcode(実体は Encode)が「EUC-JP に本来含まれていない文字だから、変換せんもんね」と「?」を返してきちゃうわけですな。

そこで、この EUC-JP に、「NEC特殊文字」「NEC選定IBM拡張文字」という CP932 独自の文字(「髙」もこの中に含まれます)も含めた拡張文字コードセットが CP51932 です。
で、Jcode(Encode)で CP51932 も扱えるようにするには、別途 Encode::EUCJPMS というモジュールをインストールしてやらなければいけません。まあ、cpan コマンド一発やけどね。

# cpan Encode::EUCJPMS
CPAN: Storable loaded ok (v2.15)
Reading '/root/.cpan/Metadata'
  Database was generated on Fri, 11 Apr 2014 17:41:02 GMT
CPAN: LWP::UserAgent loaded ok (v6.04)
CPAN: Time::HiRes loaded ok (v1.9717)
Fetching with LWP:
<略>
Installing /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi/auto/Encode/EUCJPMS/EUCJPMS.bs
Installing /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi/auto/Encode/EUCJPMS/EUCJPMS.so
Installing /usr/lib64/perl5/site_perl/5.8.8/x86_64-linux-thread-multi/Encode/EUCJPMS.pm
Appending installation info to /usr/lib64/perl5/5.8.8/x86_64-linux-thread-multi/perllocal.pod
  NARUSE/Encode-EUCJPMS-0.07.tar.gz
  /usr/bin/make install  -- OK

で、終わり。

use Jcode;
use Encode::EUCJPMS;

という具合にプログラムの頭で Jcode モジュールと Encode::EUCJPMS モジュールを読み込んでやれば、

$str = Jcode->new($str, 'euc')->utf8;

が、

$str = Jcode->new($str, 'cp51932')->utf8;

って書けるようになって、ちゃんと UTF-8 で「髙」が表示できるようになるわけです。
LinkedIn フレンドさんが「NTT研究所の日本語解析技術API公開、「語句類似度算出」「ひらがな化」など4種」という記事をチェックされてたので、早速昼休みに Perl でちょいプロを作って使ってみた。

俺はサラリーマン時代、後輩のO皮君と二人で広島県(県警含む)の複数の Web サーバを串刺し検索できるキーワード検索システムを Perl で一から作った経験があるので(もう 20年近く前だけど(笑))、「形態素解析」という言葉には敏感に反応するのだ(笑)

application/x-www-form-urlencoded形式での POST を受け付けるそうなので、以下のようなスクリプトを作成。

アプリケーションIDは事前に goo ラボで取得しておくこと。
リクエストID は任意の適当な文字列を。
PERL_NET_HTTPS_SSL_SOCKET_CLASS とかの環境変数の設定はうちのサーバの事情なので気になさらぬよう(笑)気になる人は、「IO::Socket::SSLモジュールが中間者攻撃のワーニングを出し始めた」参照のこと。

#!/usr/bin/perl

use strict;
use LWP::UserAgent;
use HTTP::Request::Common;

$ENV{'PERL_NET_HTTPS_SSL_SOCKET_CLASS'} = "Net::SSL";
$ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'} = 0;

my $url = 'https://labs.goo.ne.jp/api/morph';
my %postdata = (
'app_id' => 'c4e54ef1667***************************************495c84125',
'request_id' => 'hogehoge001',
'sentence' => '私の名前はりんごちゃんだよ。男好きだよ。',
'info_filter' => 'form|pos|read'
);
my $request = POST($url, \%postdata);

my $ua = LWP::UserAgent -> new;
my $res = $ua -> request($request) -> as_string;

print $res;

これを実行すると、

HTTP/1.1 200 OK
Date: Fri, 05 Dec 2014 03:34:34 GMT
Server: thin 1.5.1 codename Straight Razor
Content-Length: 462
Content-Type: application/json
Client-Date: Fri, 05 Dec 2014 03:34:34 GMT
Client-Peer: XXX.XXX.XXX.XXX:443
Client-Response-Num: 1
Client-SSL-Cert-Issuer: /C=US/O=Symantec Corporation/OU=Symantec Trust Network/CN=Symantec Class 3 Secure Server CA - G4
Client-SSL-Cert-Subject: /C=JP/ST=Tokyo/L=Minato-ku/O=NTT Resonant Inc./OU=goo Service Platform 1/CN=labs.goo.ne.jp
Client-SSL-Cipher: RC4-SHA
Client-SSL-Warning: Peer certificate not verified
P3P: policyref="/w3c/p3p.xml",CP="CAO DSP COR CURa ADMa DEVa TAIa PSAa PSDa IVAi IVDi CONo OUR SAMo OTRo IND PHY ONL UNI PUR FIN COM NAV INT DEM CNT STA HEA PRE LOC"
X-Cnection: close
X-Content-Type-Options: nosniff

{"request_id":"hogehoge001","info_filter":"form|pos|read","word_list":[[["私","名詞","ワタシ"],["の","格助詞","ノ"],["名前","名詞","ナマエ"],["は","連用助詞","ハ"],["りんご","名詞","リンゴ"],["ちゃん","名詞接尾辞","チャン"],["だ","判定詞","ダ"],["よ","終助詞","ヨ"],["。","句点","$"]],[["男好き","名詞","オトコズキ"],["だ","判定詞","ダ"],["よ","終助詞","ヨ"],["。","句点","$"]]]}

という結果が JSON 形式で返ってくる。

うひょう、面白え~

これはちょっと遊べるかも。いや、遊んでる暇がまったくないんですが(^^;
昨夜のメモでは、静的に配列に値をセット(ソースに値をベタ書き)して XML 化するプログラムになっているが、実際の業務では DB から読み込んだデータを元に動的に XML データを作成するケースがほとんどだろう。
そのやり方についてもメモっとく。

ちなみに、このサンプルでは @model などの配列に値をセットして、それを For Loop の中で順次読み出し XML::Simple に食わせるためのハッシュを作成しているが、この部分はつまり DB からの SELECT 結果が 3レコードあったというケースのシミュレーションである。

#!/usr/bin/perl

use XML::Simple;

my @model = ('ZE91-CHINPOKO', 'ZE44-OMANTAX1', 'ZE90-KEZ00101');
my @price = (23450, 1000, 5820);
my @detail = ('とても素敵なラジカセ付きカメラ', 'とても素敵なレンズ', '');

my $results = [];

for ($i = 0; $i < 3; $i++) {

my $result = {};
$result->{'modelNumber'} = $model[$i];
$result->{'suggestedPrice'} = $price[$i];
$result->{'detailDescription'} = $detail[$i];

push @$results, $result;

}

my $val = {
'resultCode' => 0,
'result' => $results
};

my $x = new XML::Simple;
my $xml = $x->XMLout($val, RootName => 'results', NoAttr=>1);
print qq(<?xml version="1.0" encoding="UTF-8" ?>\n);
print $xml

この結果が

<?xml version="1.0" encoding="UTF-8" ?>
<results>
  <result>
    <detailDescription>とても素敵なラジカセ付きカメラ</detailDescription>
    <modelNumber>ZE91-CHINPOKO</modelNumber>
    <suggestedPrice>23450</suggestedPrice>
  </result>
  <result>
    <detailDescription>とても素敵なレンズ</detailDescription>
    <modelNumber>ZE44-OMANTAX1</modelNumber>
    <suggestedPrice>1000</suggestedPrice>
  </result>
  <result>
    <detailDescription></detailDescription>
    <modelNumber>ZE90-KEZ00101</modelNumber>
    <suggestedPrice>5820</suggestedPrice>
  </result>
  <resultCode>0</resultCode>
</results>

となり、つまり昨夜のメモのソースで表せば、

#!/usr/bin/perl

use XML::Simple;

my $val = {
'resultCode' => 0,
'result' => [
{
'modelNumber' => 'ZE91-CHINPOKO',
'suggestedPrice' => 234500,
'detailDescription' => 'とても素敵なラジカセ付きカメラ',
},
{
'modelNumber' => 'ZE44-OMANTAX1',
'suggestedPrice' => 1000,
'detailDescription' => 'とても素敵なレンズ',
},
{
'modelNumber' => 'ZE90-KEZ00101',
'suggestedPrice' => 5820,
'detailDescription' => '',
},
]
};

my $x = new XML::Simple;
my $xml = $x->XMLout($val, RootName => 'results', NoAttr=>1);
print qq(<?xml version="1.0" encoding="UTF-8" ?>\n);
print $xml

とベタ書きした場合と一緒である。

ちょっと配列、ハッシュ(連想配列)のリファレンスとか理解してないとわかりづらいかな?

このアーカイブについて

このページには、過去に書かれたブログ記事のうちPerlカテゴリに属しているものが含まれています。

前のカテゴリはAIR/Flexです。

次のカテゴリはPHPです。

最近のコンテンツはインデックスページで見られます。過去に書かれたものはアーカイブのページで見られます。

月別 アーカイブ

電気ウナギ的○○ mobile ver.

携帯版「電気ウナギ的○○」はこちら