frog.raindrop.jp.knowledge

PHP

<?php
// foreach は便利
$array = array ("year" => 2010, "month" => 9, "day" => 27);
foreach ($array as $key => $value)
    echo "$key: $value\n";

// こうすると perl っぽい
while (list ($key, $value) = each ($array))
    echo "$key: $value\n";
?>

Perl

# たとえば、keys が返すキーの配列を foreach で列挙
%hash = ("year" => 2010, "month" => 9, "day" => 27);
foreach $key (keys %hash1)
    print "$key: $hash{$key}\n";

# 順番を確定したければキーをソートするといい
foreach $key (sort keys %hash1)
    print "$key: $hash{$key}\n";

# たとえばキーと値を each で列挙
while (($key, $value) = each (%hash1))
    print "$key: $value\n";

PHP の for

for ($i = 0; $i < 10; $i ++)
    echo "$i\n";

Perl の for

for ($i = 0; $i < 10; $i ++)
    print "$i\n";

Javascript の for

for (var i = 0; i < 10; i ++)
    document.writeln (i);

PHP の foreach

$array1 = array ("foo", "bar", "baz");
foreach ($array1 as $value)
    echo "$value\n";

$array2 = array ("year" => 2010, "month" => 9, "day" => 27);
foreach ($array1 as $key => $value)
    echo "$key: $value\n";

Perl の foreach

@array1 = ("foo", "bar", "baz");
foreach $value (@array1)
    print "$value\n";

%hash1 = ("year" => 2010, "month" => 9, "day" => 27);
foreach $key (keys %hash1)
    print "$key: $hash1{$key}\n";

# 実は for と foreach は同様に使える。インタプリタが文脈で判断するので。
@array2 = qw (apple peach banana);
for $value (@array2)
    print "$value\n";

Javascript の for ( in )

// for ( in ) を配列で使用した場合は添字を列挙
var array = ["foo", "bar", "baz"];
for (var index in array)
    document.writeln (array [index]);

// 連想配列で使用した場合はキーを列挙
var hash = {year: 2010, month: 9, day: 27};
for (var key in hash)
    document.writeln (key + ': ' + hash [key]);

package EqualSeparated；

sub TIEHASH
{
    my ($class, $file) = @_;
    my @lines = ();

    eval
    {
        open FH, "<$file" or die $!;
        @lines = <FH>;
        close FH;
    };

    bless {
        map {$_->[0] => $_->[1]}
        grep {$_->[0]}
        map {[/^(\w+)\s*=\s*([^\r\n]+)\s*$/]} @lines
    }, $class;
}

sub FETCH { $_[0]->{$_[1]} }
sub EXISTS { exists $_[0]->{$_[1]} }
sub FIRSTKEY { keys %{$_[0]}; each %{$_[0]} }
sub NEXTKEY { each %{$_[0]} }

Net::DNSを使用した実装例です。

Email::Validを使用すると可能なのですが、リトライする、レコードなしはNGだが、タイムアウトなどのエラーはとりあえずOKとするなど、柔軟性がほしかったので作ってみたもの。でもよく考えたら、ここに載せなくても、Email::Validのソースをみたらいつでもよいサンプルになるのかもしれません。

CGIからsendmailでメール送信するときに、送信に成功したかエラーになったかを取得する方法を調べてみたのでとりあえず実験編です。

まず、送信エラー時にエラーメールを返す、ってやつ。通常メールクライアントからSMTPに投げると返ってくるけど、同じことをさせるには、sendmailの-fオプションで返信先を指定します。sendmailについてはsendmailのman page[www.linux.or.jp]が参考になります。ためしにてきとうなアドレスに送ってみたら、ちゃんと返ってきました 笑。

も一個、sendmailは実行時にステータスを返してくるのを取得してみよう、ってやつ。特殊変数$?にステータスコードが入ってくる・・・はずだけど、そのような条件を作れませんでした。なので、定数を宣言したのみ。まあ、画面出力してみてます。

Perl CGIを使ったWebアプリケーションで、セッション情報を管理するのにWalrus::Session::Lite[digit.que.ne.jp]を使おうとしていたのですが、テスト環境のPerl 5.8.1のもとでは機嫌良く動いていたのに、Perl 5.6.1の実稼働サーバに移したところ、データが正常に保存できなくなり(そういえば、原因調べようと思って調べてないや。それはまたそのうち。)、急遽CGI::Sessionを使う方向に変更しました。しかし、Walrus::Session::Liteにあって、CGI::Sessionにない機能に、期限切れセッションの一括削除があります。セッションというのは必ず完結するとは限らないので、時々何かのタイミングでお掃除しないと、いつかはディスクを埋め尽くしてしまうことになる、というわけで、そんなクラスを作成してみました。お掃除するので、その名も、CGI::Session::Sweeperです。

これを、比較的頻度の少ない、ただし必ず行われる処理のついでに、以下のようにして呼び出すことで、設定した期限を超えたセッションを削除することができます。

use CGI::Session::Sweeper;
my $sweeper	= CGI::Session::Sweeper->new( "driver:File", { Directory => '/session' } );
$sweeper->sweep;

newの引数はCGI::Session->newの1個目と３個目の引数と同じものを指定します。これは詳しくはCGI::Sessionのpodを参照。

CGI::Sessionを使おうとすると、Digest::MD5を使うことになる。もちろん、セッションIDの生成にMD5を指定した(またはデフォルトの)場合だけど。

しかしDigest::MD5はPerl 5.8.0以降なら標準モジュールだけど、プロバイダのサーバがPerl 5.6.1ですぅ、XSモジュールなんてインストールできませーん、てなことも。

よくできたことに、Digest::MD5はXSがロードできなければ、Digest::Perl::MD5を継承してくれる。私は最初知らなくって、CGI::Session::ID::MD5の中身をわざわざDigest::Perl::MD5を使うように修正していた 笑。でも、テストの通ってるCPANモジュールをわざわざ修正なんてしたくないわけで。オリジナルのCGI::Sessionの戻して、Digest::MD5経由でDigest::Perl::MD5を使う方法に変更することに。

で、Digest::MD5をWindows上でINSTALLSITELIB=サーバアップ用の作業ディレクトリとかして、一応Makeの手順を踏んで、バイナリを削除してプロバイダのサーバにアップしようとしたのだけど、Digest::MD5をPerl Makefile.PLすると、Warningが出た。

F:\>Perl Makefile.PL INSTALLSITELIB=c:/workingdir/site/lib
Assumes that MSWin32 implies free alignment for U32 access.
Warning: prerequisite Digest::base failed to load: Can't locate Digest/base.pm in @INC (@INC contains: C:/Perl/lib C:/Perl/site/lib .) at (eval 4) line 3.
Writing Makefile for Digest::MD5

ふぅーん、Digest::baseがいるんだ、と思い、Digestも入れることにした。いざ、サーバ上のソースを置き換えると、私のDigest::Perl::MD5置換版のCGI::Sessionでは動作していたソースが、こんな出力。

Undefined subroutine &Digest::base::new called at /foo/bar/site/lib/CGI/Session/ID/MD5.pm line 14.

要するにDigest::MD5->newはXSにしか定義がないので、継承元のDigest::base->newを呼ぼうとして失敗するらしい。Digest::MD5のソースを見たが、Digest::Perl::MD5をロードする場合は、Digest::baseを継承しなくっても特に問題はなさそう。ということで、Digest::baseは削除。一件落着。無事動作した。

「New Comment Posted to の文字化けをなおす。」でみた、Movable Typeのメールの本文作成するとこ

require Text::Wrap;
$Text::Wrap::cols = 72;
$body = Text::Wrap::wrap('', '', $body) . "\n$link_url\n\n" .
	$app->translate('IP Address:') . ' ' . $comment->ip . "\n" .
	$app->translate('Name:') . ' ' . $comment->author . "\n" .
	$app->translate('Email Address:') . ' ' . $comment->email . "\n" .
	$app->translate('URL:') . ' ' . $comment->url . "\n\n" .
	$app->translate('Comments:') . "\n\n" . $comment->text . "\n";

は

$body	 = jcode( $body )->jfold(( 72, "\n" ));
$body	.= "\n$link_url\n\n" .
	$app->translate('IP Address:') . ' ' . $comment->ip . "\n" .
	$app->translate('Name:') . ' ' . $comment->author . "\n" .
	$app->translate('Email Address:') . ' ' . $comment->email . "\n" .
	$app->translate('URL:') . ' ' . $comment->url . "\n\n" .
	$app->translate('Comments:') . "\n\n" . $comment->text . "\n";

のがよさげか？

Perlで名前つき引数ってこんな感じに書く。サブルーチン内では省略されたときの初期値をエレガントに設定する。

sub mySub {
	%args	= (
		PARAM1		=> '', 
		PARAM2		=> 5, 
		PARAM3		=> '', 
		@_
	);
	return \%args;
}
# 呼び出す
$ret	= mySub( PARAM1	=> 'foo', 
				PARAM2	=> 123, 
				PARAM3	=> 'bar');

でも、VBな私は引数名の大文字小文字の区別がないようにしたい。さらに、ハッシュのキーをすべて大文字にしたい。したがってこう。

sub mySub {
	my %args	= @_;
	%args	= (
		PARAM1		=> '', 
		PARAM2		=> 5, 
		PARAM3		=> '', 
		( map { uc( $_ ) => $args{$_} } keys( %args ) )
	);
	return \%args;
}
# 呼び出す
$ret	= mySub( Param1	=> 'foo', 
				pArAm2	=> 123, 
				param3	=> 'bar');

[raindrop::diary] New Comment Posted toの件を、取り急ぎなおしてみた。全体をちゃんと見たわけじゃないので、適当。だけどちゃんと直った。

# MT::App::Comments
# From Line 349
# <<< MODIFY
#            my $charset = $app->{cfg}->PublishCharset || 'iso-8859-1';
            my $charset = 'iso-2022-jp';
# >>> MODIFY
            $head{'Content-Type'} = qq(text/plain; charset="$charset");
            my $body = $app->translate(
                'A new comment has been posted on your blog [_1], on entry #[_2] ([_3]).',
                $blog->name, $entry->id, $entry->title);
            require Text::Wrap;
            $Text::Wrap::cols = 72;
            $body = Text::Wrap::wrap('', '', $body) . "\n$link_url\n\n" .
              $app->translate('IP Address:') . ' ' . $comment->ip . "\n" .
              $app->translate('Name:') . ' ' . $comment->author . "\n" .
              $app->translate('Email Address:') . ' ' . $comment->email . "\n" .
              $app->translate('URL:') . ' ' . $comment->url . "\n\n" .
              $app->translate('Comments:') . "\n\n" . $comment->text . "\n";
# <<< ADD
			require Jcode;
			$body = new Jcode( $body )->jis();
# >>> ADD

あとは、extlibにJcodeをいれる。こんだけ。

覚え書き的ですが

# エンコード
$value	=~ s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;

# デコード
$value	=~ tr/+/ /;
$value	=~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

Movable Typeの場合、@INC(ライブラリ検索パス)にユーザ定義パスを追加する処理はこんな感じで実現している。

my($MT_DIR);
BEGIN {
    if ($0 =~ m!(.*[/\\])!) {
        $MT_DIR = $1;
    } else {
        $MT_DIR = './';
    }
    unshift @INC, $MT_DIR . 'lib';
    unshift @INC, $MT_DIR . 'extlib';
}

私もそれに倣ってずっとunshiftで押し込んでたんだけど、実はプラグマが存在することを最近知った。これだと、モジュール内でユーザ定義ライブラリ内のモジュール'hoge.pm'を参照するときも、requierでなく、useで書くことができる。

use lib qw(./lib ./extlib);
use hoge;

ActivePerlにはPPMというインストールのためのユーティリティーが付属
http://homepage1.nifty.com/kazuf/imagemagick.html
http://homepage1.nifty.com/kazuf/renewal_2002_07.html

http://www5a.biglobe.ne.jp/~n_rieko/
http://www.psl.ne.jp
http://www.rfs.jp
http://perldocjp.sourceforge.jp
http://itbtech.itboost.co.jp/perl/perl_00.php

nmakeで自分でコンパイル、テスト、インストールを行うほかに、もっと結構な方法があります。

「モジュールのインストール」にくらべて、バージョンも調べてくれて、常に最新のモジュールがインストール/アップデートされるので、簡単でおすすめ。

C:\>perl -MCPAN -e shell
cpan>install LWP

これだけで、LWPをインストールできる、はず。

LWPの部分はインストールしたいモジュール名を指定する。

初回はネットワークの設定をする必要がある。設定を間違った場合、あとから変更するのはちょっと面倒なので、結構真剣にやった方がいいみたい。

ただし、依存関係のチェックまではしてくれないので、インストールに失敗したら、やっぱりCPANのサイトから手動で落としてきたモジュールを自分でコンパイルして、出力されるエラーを確認するか、CPAN Searchで検索すると、モジュールの依存関係が併記してある。

----------------------------------

2003.10.31追記

初回に行った設定は$perldir\lib\CPAN\Config.pm に格納される。このファイルがなければCPAN起動時に設定がを聞いてくる。再度設定をやり直す場合はConfig.pmをリネームするとかすればよい。

モジュールはsearch.cpan.orgや、CPAN Searchから探すといいみたいです。
Jcode.pmを例にとると、インストール手順はこんな感じ。

C:\>cd temp\jcode-0.83
C:\Temp\Jcode-0.83>perl Makefile.PL
C:\Temp\Jcode-0.83>nmake
C:\Temp\Jcode-0.83>nmake test
C:\Temp\Jcode-0.83>nmake install

実際に私の環境で行うと、nmakeでエラーになってしまいました。
C:\Temp\Jcode-0.83\Unicode\uni.cの18行目を修正するとよいという情報に従い、テストを行うとうまくいきました。