local $PERL_MEMO;

■ [perl][memo]DATAを開くとデバッグがだるい

use autobox::dump;
use YAML;
print Load(do { local $/; <DATA>; })->perl;
sleep 100;
exit;
__DATA__
---
foo: hoge
bar: fuga
baz: piyo

みたいな処理を書くとsleepしてる間ソースファイルがreadonlyになって不便。

print Load(do { local $/; $a = <DATA>; close DATA; $a; })->perl;

■ [perl][memo][module]Win環境でモジュールの配布パッケージを作ってみる(草稿)

日を置くと情熱も記憶も失われるもので、もう何書こうとしてたか思い出せません。ですので、自分の環境で配布パッケージ作る時に引っかかった所を断片的に記録しておきます。

環境

• Windows XP
• Active Perl
• Cygwin
• Visual C++

モジュール作成からパッケージまでの10の手順

1. このへん読む
2. Module::Starter/Module::Starter::PBPインストール
3. $ perl -MModule::Starter::PBP=setup
4. 出来たテンプレートフォルダ(%HOME%/.module_starter/PBP)をC:\Perl\PBPに移動
5. configのテンプレートページのとこC:\Perl\PBPに書き換え
6. $ module-starter --module=Hoge
7. Hoge/lib/Hoge.pm 書く
8. $ PATH C:\Perl\bin;C:\Program Files\Microsoft Visual Studio 9.0\VC\bin
9. $ perl Makefile.pl
10. $ make dist

ツマルの詰まったとこ

• Win 2000/XP特有?の問題として、%HOME%がだいたいDocuments and Settings/fugaとか、パスに空白が入ってるせいでmodule-starterがテンプレートページのパスが分からないとかのエラー吐く
  • スペースはいってないパスにPBPディレクトリを移動して解決
• CygwinのせいなのかMakefileしてつくったmakeが"multiple target patterns. Stop"とかでエラー
  • コマンドPATHで一時的にperlとvc(とあと%System%とか/binとかあったかもしれない)の最小構成にする。そのあいだにperl Makefile.pl etc
  • PATHはコマンドプロンプトが開いてる間、渡されたパスを覚えてるだけなので「環境変数書き変わるかも…」とか心配しなくていい。別のプロンプト起動すればいつもどおりである

おしまい

こんな感じで案外あっさり出来てしまいました。それでもそれなりに環境整えてやらないと出来るものもできないんだなぁというのが今回の感想です。あ、これ草稿のまま終わりそう。夜。

cf.

• perltoot - トムによるPerlオブジェクト指向チュートリアル
• perlnewmod - 新しいモジュールを配布するには

■ [perl][func][memo]配列をshuffle(ランダムに並べ替えたい)/take potluck(ランダムに抜き出したい) - 爆速編

前回の更新ではベンチ取らないでやってたので今回は高速化に挑戦。

まずはベンチマーク

使ったコードはこちら。

#!perl
use Benchmark qw(timethese cmpthese);
use List::Util;
my @a = 'Aa'..'Zz'; # 0 .. 675

cmpthese(timethese(10000, {
  'L::U::shuffle' => sub { List::Util::shuffle(@a) },
  shuffle_simple  => sub { shuffle_simple(@a) },
  shuffle         => sub { shuffle(@a) },
  L_U_shuffle     => sub { L_U_shuffle(@a) },
}));


sub shuffle_simple { return sort { int(rand 3) -1 } @_ }

sub shuffle {
  my @old = @_; local $_;
  my ($i, $new) = ($#old+1, 0);
  map {
    $_ = $old[$new = rand $i--];
    $old[$new] = $old[$i];
    $_;
  } 0 .. $#old
}

sub L_U_shuffle {
  my @old = \(@_);
  my $n; my $i = @_;
  map {
    (${$old[$n = rand $i--]}, $old[$n] = $old[$i])[0];
  } @_
}

L_U_shuffleはList::Util::shuffleのpure perl版です。

で、結果が以下。

                   Rate shuffle L_U_shuffle L::U::shuffle shuffle_simple
shuffle           215/s      --        -73%          -97%          -100%
L_U_shuffle       794/s    270%          --          -90%           -99%
L::U::shuffle    7622/s   3453%        859%            --           -94%
shuffle_simple 125000/s  58171%      15635%         1540%             --

…(shuffle_simpleはともかく)勝負にならんな！あとXSのshuffle速すぎ。

なんでこんなに差がつくかというと、L_U_shuffleは実体をコピーするのではなくさっきの記事の方法を使ってリファレンスのリストを作ってそいつを回しているのが原因だと思う。余計な代入も一切発生しない。あと僕の作ったshuffleはmap回すのに0..$#oldみたいないらん配列作ってるしさらに遅い。で、3倍近く差がつく。この点を改良して最速shuffle/take potluckを作ります。

並べ替え

sub shuffle_fast(@) {
  my @old = \(@_);
  my $n; my $i = @_;
  map {
    (${$old[$n = rand $i--]}, $old[$n] = $old[$i])[0];
  } @_;
}

ええパクリです。でも僕の環境だとpure perlのList::Util::shuffleの倍は出ます。何故か。mapの中を1行にしただけなのに。

参考ベンチ(試行回数1000)

              Rate      shuffle  L_U_shuffle shuffle_fast
shuffle      216/s           --         -46%         -72%
L_U_shuffle  396/s          84%           --         -49%
shuffle_fast 774/s         259%          95%           --

適当に抜き出す

sub potluck_fast($;$) {
  my $i = my @a = \(@{+shift});
  my $n = shift || int rand $i;
     $n = $i if $n > $i;
  map {
    (${$a[$n = rand $i--]}, $a[$n] = $a[$i])[0];
  } 0 .. $n-1;
}
warn potluck_fast([0..9,A..Z,a..z],20);
# XK7kgQq6Dn1RLVa8ozOW

ぱくぱく。使い方は前回同様、第1引数に配列のリファレンスを、第2引数に抜き出したい数を渡します。

参考ベンチ(試行回数1000)

              Rate      potluck potluck_fast
potluck      248/s           --         -73%
potluck_fast 925/s         273%           --

おしまい

爆速って程でもなかったかな。しかし既存のshuffleよりはずっと速くなったはず。そのへんのよりは3倍速い。

List::Util使えるんだったらshuffleはList::Util使いましょう。爆速です。potluckみたいなことしたいときも

(List::Util::shuffle('Aa'..'Zz'))[0..rand(676)]

とかすれば爆速間違いなし。XSにはどう頑張っても勝てんわ。

cf.

• List::AllUtils - search.cpan.org

■ [perl][func][memo]配列をshuffle(ランダムに並べ替えたい)/take potluck(ランダムに抜き出したい)

たまーに配列を適当に並べ替えたり、そこからいくつか抜き出したいってことがあります。そんなときのためのTIP。

並べ替え

お手軽に

sub shuffle {
  return sort { int(rand 3) - 1 } @_
}
print shuffle(0 .. 9);
# 0123456789 => 6517840923

非常に簡単です。ただ元の配列の並びの影響を受けやすいので、内容が10～20個程度の配列なら気にならないですが、それ以上になるとあまり役に立ちません。

きちんと

sub shuffle {
  my @old = @_; local $_;
  my ($i, $new) = ($#old+1, 0);
  map {
    $_ = $old[$new = rand $i--];
    $old[$new] = $old[$i];
    $_;
  } 0 .. $#old
}
print shuffle(0..9,A..Z,a..z);
# before: 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz
# after : qBwNj3uiMgtLG9TKs6Ry7fpmZvVUSDQOdEeaJWoX8nlr5Cc0h2xbH4FIAPkYz1

ややこしいですがどんだけ大きな配列を入れようがランダムです。

適当に抜き出す

お手軽に

sub shuffle {
  return sort { int(rand 3) - 1 } @_
}
print ((shuffle(0..9,A..Z,a..z))[0..9]);
# iOKq7r1GL8

適当に並べ替えた奴の先頭から10個取ってるだけですね。簡単簡単。でも低ランダム。(元の配列の頭のほうばっかり取ってきます)

print grep { defined } ((shuffle(0..rand 9))[0..9]);

かっつり

sub potluck {
  my @old = @{+shift}; local $_;
  my ($i, $new) = ($#old+1, 0);
  my $count = shift || int rand $i;
     $count = $i if $count > $i;
  map {
    $_ = $old[$new = rand $i--];
    $old[$new] = $old[$i];
    $_;
  } 0 .. $count-1
}
print potluck([0..9,A..Z,a..z]);
# hx9Py6m83ERG5JfarLqMeBwQozuZCYUv4i02KbntTDdpjs7NHgXO1WAI
print potluck([0..9,A..Z,a..z],10);
# o5fjvETbBJ

さっきのsub shuffleをちょっといじっただけです。配列のリファレンスを渡します。第2引数に抜き出したい数を渡すとその分だけ取ってきます。元の配列の大きさは超えません。

番外: List::Utilを使う

use List::Util qw(shuffle);
print shuffle(0..9,A..Z,a..z);
# 81D9moCj3n0zPO4VwIpGu5aFJR2ftTlyEgvxMHebhcXZYkqUiB6SWdAKrQNs7L

List::Utilはuseしただけでは関数をエクスポートしてくれないので使いたい関数は必ずインポートしましょう。

List::Utilはこれ以上ないくらい洗練されてる(と思う)のでv5.7.3以降のperlを使ってる人はこれ使うといいですね。

抜き出すのはないっぽいから自前で何とかしよう！

■ [perl][memo][Encode][char]User-Agentとencoded-wordについて (Encode.pmでmime encodingする)

User Agentを変更してオリジナリティ溢れるサーバログを撒き散らしたいなーと思い、User Agent Switcherアドオンを導入したり、日本語をUAに使うにはどうしたらいいかを調べているうちに、

• UAにはascii以外と一部の記号は使えない
• 使いたいときはRFC2047(原文)で定められている方法、つまりencoded-wordに変換する

ということがわかりました。そういうわけで、今日はmime encodingについてのメモ。

User Agentとは

ユーザーエージェントとは、閲覧者が使っているソフトやハードのこと。ここでは特に、使用している言語、ウェブブラウザ、OS、ディスプレイなどの閲覧環境の情報を指します。

HTTPリクエストの際にブラウザがUser-Agentヘッダをサーバに送信することで、サーバあるいはコンテンツ作成者は閲覧者がどのような環境でウェブサイトを閲覧しているか知ることができ、その情報を元に、閲覧者の環境に合わせたより良いコンテンツを提供できるようになることが期待できます。

User-Agentヘッダの書式

RFC2616によれば以下のような感じ。

User-Agent      = "User-Agent" ":" 1*( product | comment )
 
product         = token ["/" product-version]
product-version = token
token           = 1*<any CHAR except CTLs or separators>
separators      = "(" | ")" | "<" | ">" | "@"
                | "," | ";" | ":" | "\" | <">
                | "/" | "[" | "]" | "?" | "="
                | "{" | "}" | SP | HT

CHAR            = <any US-ASCII character (octets 0 - 127)>
 
comment         = "(" *( ctext | quoted-pair | comment ) ")"
ctext           = <any TEXT excluding "(" and ")">
TEXT            = <any OCTET except CTLs, but including LWS>
OCTET           = <any 8-bit sequence of data>
CTL             = <any US-ASCII control character (octets 0 - 31) and DEL (127)>
LWS             = [CRLF] 1*( SP | HT )

Hypertext Transfer Protocol -- HTTP/1.1 - User-Agent

(まとめるのがめんどくさくてコピペしてしまった…)

簡単に言えば、User-Agent: (product | comment)+ですね。productはhoge/fuga、commentは任意の文字、そして文字列はUS-ASCIIのみという感じ。なのでUser-AgentにはISO_8859_1以外の文字コードは出現出来ないことになってるんですが、Words of *TEXT MAY contain characters from character sets other than ISO-8859-1 [22] only when encoded according to the rules of RFC 2047 [14].*とあるように、RFC 2047に書かれている方法でエンコードすればコメントには他の文字コードも使えますよ、ということらしい。そして、そのほかの方法というのが、encoded-wordというわけだ。

じゃあencoded-wordって？

使用の都合で、MIME-Headerに使用できる文字(記号)が非常に少なくなってしまった。それを解消するために、使用出来ない文字列をエンコードすることでMIME-Headerに埋め込めるようにしよう、ということで出来た仕様がencoded-word...なのかな？

これは他のエンコード技術も混ざってくるので簡潔に書くと、

encoded-word = "=?" charset "?" encoding "?" encoded-text "?="

となります。例えば、=?iso-8859-1?q?this=20is=20some=20text?=など。文字コードセット名と変換方法と変換後のテキストのセットになっています。

このencoded-wordならUser-Agentヘッダのコメント部分に書いてもいいよ、と定められているみたい。User-Agentヘッダで日本語を使うには、このencoded-wordに変換しなくてはいけないのですね。

Perlでencoded-wordを作るには

やっと本題です。

このencoded-wordは、RFC2047のタイトルにもあるように、MIME(Multipurpose Internet Mail Extensions)のメッセージヘッダ拡張のための仕様なので、MIMEヘッダあたりのモジュールで何とかしなくてはいけないのかと思ったのですが、うれしいことに標準モジュールのEncode.pmがMIME-Headerの変換に対応しています。

use Encode;

$encoded = encode('MIME-Header', decode('utf8', 'ほげほげ'));
# $encoded => '=?UTF-8?B?44G744GS44G744GS?='

$utf8 = decode('MIME-Header', $encoded);
# $utf8 => 'ほげほげ'

以上のように非常に簡単に変換が出来ました。弾さんすばらしい！ dankogai++

v5.008_008以降にはEncode::MIME::Header::ISO_2022_JPが含まれているので、文字コードにISO_2022_JPを指定してエンコードすることも出来るようです。UTF-8を使用出来ない環境ではencode('MIME-Header-ISO_2022_JP')を使用するといいのかな。

$encoded = encode('MIME-Header-ISO_2022_JP', decode('utf8', 'ほげほげ'));
# $encoded => '=?ISO-2022-JP?B?GyRCJFskMiRbJDIbKEI=?='

$utf8 = decode('MIME-Header', $encoded);
# $utf8 => 'ほげほげ'

使用上の注意

ソースを読んだ感じではちょっと癖がありそうなので注意点をまとめてみます。

• encode('MIME-Header')には通常のencodeと同じく内部Unicode文字列で渡してあげる。
• decode('MIME-Header')はencoded-word以外は文字コードの変換をしない。よって通常の文字列とencoded-wordが混在するテキストは、まず最初にdecode('utf8')を行ってからdecode('MIME-Header')に渡すといい(encoded-wordはASCIIのみで構成されているのでこの順序ならエラーは発生しない)。
• encode('MIME-Header-ISO_2022_JP')は空白文字の連続を一つの空白に置き換えてしまうと思う。空白を纏められたくないときは s/\s+$//o に引っかからないようにうまく変換してから突っ込まないといけないっぽい。

おわり

mime encodingが出来るようになった！

(=?ISO-2022-JP?B?GyRCS00kLDgrJEYkayRoITwbKEI=?=)をUAに追加したのでどこかで見かけたらアレアレアレしたりするといいです。CardCaptor/1.0 (さくら怪獣じゃないもんブラウザ)のほうがよかったかな。これを機にみなさんもガンガンUAを偽装したり解析ツールのUAの項目でmime decodeするようにしたりすればいい。

最後に。User-Agentヘッダはコメントに括弧以外のASCII使えるから、標準にこだわらなければ日本語部分は文字実体参照でいいんじゃないかな。

javascript:(function(a){if(!a)return;for(var b=[],i=0,l=a.length;i<l;i++){b.push('&#x'+a.charCodeAt(i).toString(16)+';');}alert(b.join(''))})(prompt('入力を実体参照に変換します'));void 0;

cf.

• Encode::MIME::Header - search.cpan.org
• 数値文字参照で iCab で牛乳 (4) - ねこめしにっき
• UA - 某日記
• エンコード・コレクション (メール、テキスト関連)
• 図解: Perl と Unicode 文字列 - daily dayflower
• ASCII文字コード ： IT用語辞典