@INCフックの挙動
Perl5.38のアップデート内容を調べているときに@INCフックの挙動に詳しくついて調べたのでアウトプットする。
requireのドキュメントに記述されていること読みながらを試していった内容をまとめた。
@INCフック とは
Perlでuseやrequireなどでモジュールをロードするとき、 @INC に格納されているディレクトリのリストからモジュール名に対応するファイルパスを検索するといった処理が実行されるが、@INC に文字列ではなくコードリファレンスなどを入れることでモジュールのロード処理にフック処理を入れることができる。
これを@INCフックと呼ぶ。
あまり使いどころが思い浮かばないが、Carmelで利用されているのでパッケージマネージャなどを作っていると使いたくなることがありそう。
@INCフックの種類
フックはCodeRef、オブジェクト、 ArrayRefのいずれかの形式ですることができる。
CodeRefによるフック
@INC を走査しているときにCodeRefが出現した場合、CodeRefがblessされていてかつINC、INCDIRメソッドが実装されていない限り、このサブルーチンはINCフックとして扱われ、2つの引数を渡して呼び出される。
引数は第1引数がそのCodeRef自身で、第2引数がロードしようとしているモジュールのファイル名。
返り値は何も返さないか、以下の順序で最大4つの値のリストを返す。
必要のない引数は抜く。代わりにundefなど渡す必要もない。
- 文字列へのスカラリファレンス。参照している文字列はファイルやジェネレータの出力の先頭部分に追加される
- モジュールファイルの内容を読み込むためのファイルハンドル
- CodeRef
- CodeRefのオプション。3 のサブルーチンの第2引数に渡される
何も返さない場合(空リスト、undef、上記に一致しない引数)が返された場合は require は @INC の残りの要素を調べる。
これらの仕様通りに動くのか実際にコードを書いて確認してみる。
文字列へのスカラリファレンスのみ返す@INCフック
このコードは Ghost というモジュールをロードしようとしたときのみ、モジュールが存在しなくても@INCフックによって $code の内容を代わりにロードするようにしている。
use v5.38; push @INC, sub { my ($__sub__, $filename) = @_; if ($filename eq 'Ghost.pm') { my $code = << 'EOS'; package Ghost; use v5.38; sub do_something { warn q{I'm ghost.} } 1; EOS return (\$code); } else { return; } }; require Ghost; Ghost::do_something(); # I'm ghost. at /loader/0x5556a2cf03e8/Ghost.pm line 3.
Ghost::do_something を呼び出すことができているので、文字列へのリファレンスを返すとそれをパースすることがわかる。
ファイルハンドルを返す@INCフック
本体を実装する前に同じディレクトリに次のようなファイルを hoge.txt として保存しておく。
package Ghost;
use v5.38;
sub do_something { warn q{I'm ghost.} }
1;
Ghost というモジュールをロードしようとしたとき、このファイルを@INCフックの中でopenしてそのファイルハンドルを返すようにする。
use v5.38; push @INC, sub { my ($__sub__, $filename) = @_; if ($filename eq 'Ghost.pm') { open my $fh, '<', './hoge.txt'; return $fh; } else { return; } }; Ghost::do_something(); # I'm ghost. at /loader/0x564580d38368/Ghost.pm line 3.
動かしてみると hoge.txt の内容がパースされて Ghost::do_something を呼び出せるようになっていることがわかる。
コードジェネレータであるCodeRefを返す@INCフック
コードジェネレータは1回の呼び出しごとに $_ の内容を1行ごとパースするコードに追加していき、返り値が真の場合は生成を続け、偽の場合生成を終了するという挙動になっている。
コードジェネレータに渡される引数の第1引数は意味のない引数(実際には 0)で、第2引数はフックの最後の引数が渡される。
このコードでは @lines の内容を1行ずつ $_ に書き込んで1を返し、全部書き込み終わっていたら0を返すように実装している。
フックの最後の返り値が { options => 1 } になっているので、ジェネレータの第2引数に渡される値も{ options => 1 } になる。
use v5.38; push @INC, sub { my ($__sub__, $filename) = @_; if ($filename eq 'Ghost.pm') { my $code = << 'EOS'; package Ghost; use v5.38; sub do_something { warn "I'm ghost."; } EOS my @lines = split /\n/, $code; ( sub { my ($zero, $option) = @_; # $zero = 0, $option = +{ options => 1 } my $line = shift @lines; if ( defined $line ) { $_ = $line; return 1; } else { return 0; } }, +{ options => 1 }, ); } else { return; } }; require Ghost; Ghost::do_something(); # I'm ghost. at /loader/0x560ef23850b8/Ghost.pm line 4.
動かしてみるとコードジェネレーターによって @lines から追加されていった内容がパースされ Ghost::do_something が呼び出せるようになっていることがわかる。
ソースフィルターであるCodeRefを返す@INCフック
先程の hoge.txt の内容を1行ずつ読み込んで置換するソースフィルタを実装する。
ソースフィルターにはファイルハンドルから読み込まれたコードが1行ずつ $_ に格納されて呼び出され、コードを書き換えたい場合は $_ の内容を書き換える。
ファイルハンドルからそれ以上読み込める行がない場合は $_ が空になるので、空になるまでは真値を返し空になったら偽値を返す。途中で偽値を返すと読み込まれる行もそこで終わる。
use v5.38; push @INC, sub { my ($__sub__, $filename) = @_; if ($filename eq 'Ghost.pm') { open my $fh, '<', './hoge.txt'; return ( $fh, sub { if ( $_ ne '' ) { $_ =~ s/ghost/not ghost/g; return 1; } else { return 0; } }, ); } else { return; } }; require Ghost; Ghost::do_something(); # I'm not ghost. at /loader/0x5627bee92078/Ghost.pm line 3.
今回の場合は s/ghost/not ghost/g にマッチする行のみ置き換わるようになっているので、このコードを実行すると sub do_something { warn q{I'm ghost.} } の行が sub do_something { warn q{I'm not ghost.} } に置換され、 Ghost::do_something を呼び出すと I'm not ghost. というwarningが出るようになる。
オブジェクトによるフック
フックがオブジェクトの場合はINCメソッドが実装されている必要がある。 INCメソッドは第1引数はオブジェクト自身、第2引数はファイル名が渡され、返り値はCodeRefと同様の値を期待する。
このコードではINCHookerクラスにINCメソッドを実装し、そのオブジェクトを生成して @INC にpushしている。
INCシンボルは強制的にmainパッケージに宣言されるため、完全修飾名、今回だと INCHooker::INC で宣言する必要があることに注意。
package INCHooker { use v5.38; sub new($class, %args) { return bless +{ %args }, $class; } sub INCHooker::INC { my ($self, $filename) = @_; if ($filename eq 'Ghost.pm') { my $code = << 'EOS'; package Ghost; use v5.38; sub do_something { warn "I'm ghost."; } EOS my @lines = split /\n/, $code; ( sub { my $line = shift @lines; if ( defined $line ) { $_ = $line; return 1; } else { return 0; } }, ); } else { return; } } } use v5.38; my $hooker = INCHooker->new; push @INC, $hooker; require Ghost; Ghost::do_something();
また、返り値のリストを @INC にpushするINCDIRメソッドを実装することもできる。
Perl5.38で実装された。
package INCHooker { use v5.38; sub new($class, %args) { return bless +{ %args }, $class; } sub INCDIR { return ('/usr/local/lib/perl5', 'tmp'); } } use v5.38; my $hooker = INCHooker->new; push @INC, $hooker; require Ghost; Ghost::do_something();
これだとエラーになるがエラー内容の@INCを確認するとINCDIRの返り値が追加されていることがわかる。
Can't locate Ghost.pm in @INC (... INCHooker=HASH(0x55ecde25c5e8) /usr/local/lib/perl5 tmp) at object.pl line 20.
1つのクラスにINCDIRメソッドとINCメソッドが両方とも実装されていた場合は INC メソッドのみ利用される。
配列リファレンスによるフック
フックが配列リファレンスの場合、最初の要素は前述のサブルーチンリファレンスかオブジェクトでなければならない。
最初の要素がINCまたはINCDIRメソッドを実装しているオブジェクトである場合、そのメソッドは第1引数にはオブジェクト自身が、第2引数には要求されたファイル名が、第3引数にはフック配列のリファレンスが渡されて呼び出される。
最初の要素がサブルーチンである場合、第1引数には配列リファレンス自身が、第2引数にはファイル名が渡されて呼び出される。
どちらの形式でも配列リファレンスの中身を変更することで呼び出しと呼び出しの間で状態を受け渡すことができる。
例えば以下のようなことができる。
この配列リファレンスによるフックでは配列リファレンスの1番目の要素にこのフックでロードしたモジュールを記録するようにして、 Phantom.pm をロードしたときすでに Ghost.pm がロードされていたら Phantom.pm のコードを変更するようになっている。
use v5.38; my $phantom_code = << 'EOS'; package Phantom; use v5.38; sub do_something { warn "I'm ghost."; } EOS push @INC, [ sub { my ($arrayref, $filename) = @_; my ($coderef, $loaded_module_map) = @$arrayref; $loaded_module_map->{$filename} = 1; my $code = do { if ($filename eq 'Ghost.pm') { my $code = << 'EOS'; package Ghost; use v5.38; sub disappear { warn "There was nothing..."; } EOS } elsif ($filename eq 'Phantom.pm') { my $code = << 'EOS'; package Phantom; use v5.38; sub nothing_to_do { warn "..."; } EOS $loaded_module_map->{'Ghost.pm'} ? $code =~ s/"\.\.\."/"There was a ghost."/gr : $code; } }; return unless defined $code; my @code_lines = split /\n/, $code; return sub { my $line = shift @code_lines; if ( defined $line ) { $_ = $line; return 1; } else { return 0; } }; }, +{}, # この値が $loaded_module_map になる ];
これにより、Phantom::nothing_to_do の挙動を次のように変化させることができる。
先に Ghost.pm をロードしていない場合
require Phantom; Phantom->nothing_to_do(); # ... at /loader/0x55caef508960/Phantom.pm line 4.
先に Ghost.pm をロードしている場合
require Ghost; require Phantom; Phantom->nothing_to_do(); # There was a ghost. at /loader/0x55caef508960/Phantom.pm line 4.
パッケージマネージャなどで標準の方法とは違う方法でモジュールをロードしたくなった時などに使えそうな感じがする。
%INCへの値のセット
@INCフックは %INC にロードしたモジュールに対応する値をセットすることもできる。
@INCフックで特に %INC に値をセットしない場合はフック自身をセットする。
%INC にロードしたモジュールに対応する値をセットしない場合
use v5.38; push @INC, sub { my ($__sub__, $filename) = @_; return unless $filename eq 'Ghost.pm'; my $code = << 'EOS'; package Ghost; use v5.38; sub do_something { warn "I'm ghost."; } EOS my @lines = split /\n/, $code; return sub { my $line = shift @lines; if ( defined $line ) { $_ = $line; return 1; } else { return 0; } }; }; require Ghost; warn $INC{'Ghost.pm'}; # CODE(0x55785f2c8078) at set_percent_inc.pl line 31.
%INC にロードしたモジュールに対応する値をセットした場合
use v5.38; push @INC, sub { my ($__sub__, $filename) = @_; return unless $filename eq 'Ghost.pm'; $INC{'Ghost.pm'} = './Ghost.pm'; my $code = << 'EOS'; package Ghost; use v5.38; sub do_something { warn "I'm ghost."; } EOS my @lines = split /\n/, $code; return sub { my $line = shift @lines; if ( defined $line ) { $_ = $line; return 1; } else { return 0; } }; }; require Ghost; warn $INC{'Ghost.pm'}; # ./Ghost.pm at set_percent_inc.pl line 31.
フックを用いて@INCを書き換える
フックを使って@INC配列を書き換えることもできる。
@INCを書き換える場合は undef を返す。
use v5.38; push @INC, sub { my ($__sub__, $filename) = @_; state $i = 0; push @INC, sub { warn ++$i; return if $i >= 3; push @INC, __SUB__; }; return; }; require Ghost;
1 at modify_atinc.pl line 9. 2 at modify_atinc.pl line 9. 3 at modify_atinc.pl line 9. Can't locate Ghost.pm in @INC (you may need to install the Ghost module)
5.37.7 より前のバージョンではこの挙動は安定しておらずセグフォなどを引き起こすことがあったが、それ以降は挙動は安定しフックで＠INCの走査をコントロールできるようになったらしい。
(実際に5.37.7以前のバージョンで実行してみたがセグフォは起こせなかったので詳細な条件は不明)
$INC による@INCのイテレーション制御
perl5.37.7 からrequire時に実行される@INC配列の走査処理のイテレーションを制御する機能が追加された。
@INCフックの中ではインデックスが $INC に格納されるようになり、 $INC を書き換えると次にチェックされる@INCの要素は $INC の値の次の要素(undefの場合は0)になる。
push @INC, sub { splice @INC, $INC, 1; # このフックを @INC から取り除く unshift @INC, sub { warn "A" }; undef $INC; # @INC のイテレータをリセットし先頭から実行し直す(上の行でunshiftしたフックが最初に実行される) };
例えば上記のフックを存在しないモジュールを require することで実行すると、フックは@INCから自分自身を取り除き、require するたびに警告を発する新しいフックを先頭に追加した上で、@INC のイテレータをリセットし先頭から実行し直し、 A という警告が表示されるようになる。
5.37.7より前のバージョンでは新しく追加されたフックを即座に使用させたり、イテレータの前にある@INC内の変更された要素をチェックする方法がなかったため、警告は2回目のrequire呼び出しのときにしか発生しなかった。
requireを実行する前に$INCに何らかの値を設定してもrequireの実行には全く影響しないし、$INC に値が設定されていた場合は require の終了時に元に戻される。
YAPC::Kyoto 2023 参加記
3/18, 3/19 に開催されていた YAPC::Kyoto 2023 に参加してきたのでその振り返りや感想を書いていきます。
今回はカンファレンスがどのように運営されているのかを勉強したかったのと、知り合いを増やしたかったことからボランティアスタッフとして参加していました。
また前日祭の企業対抗LTマッチでも登壇しました。
前日祭まで
一応だいぶ前から企業対抗LTマッチのLTの準備はしていたのですが、ブランクがあったり直前までネタを決め切れていなかったためギリギリまで資料作りや準備をする羽目になってました。
特にコロナ禍以降あまり使っていなかったノートPCにLT用の環境を構築するのに四苦八苦*1していて、結果ほぼ寝ていない状態で前日祭を迎えることになってしまいました。
自分の使う道具のメンテを怠ってはいけませんね。。。
前日祭
そんな感じで最悪のコンディションで前日祭を迎えることになってしまいました。
当日ボランティアスタッフは14時集合だったのですが、5分ほど遅れて到着したらノベルティの詰め込み、次の日の進行の説明を聞いているくらいだった
企業対抗LTマッチでは「AstroNvimを使おう！」というタイトルで発表しました。
当日PCがプロジェクターに繋げられないことが発覚しなんとか同じ会社の人にPCを借りることで発表できたのですが、予定通りに発表を進められず時間オーバーしてしまったことや、ライブデモができなくてAstroNvimの魅力をちゃんと伝えれなず失敗してしまいました。
ネタ選定や伝えたいことの選別も失敗していた感じがするので今回のLTを反省して次回以降よいLTをできるようになりたいです。
LTで失敗して落ち込んでいたので後のことはあまり覚えていないのですが、新卒の方でもLTがすごい上手な方が多くてすごいなあと思って見ていました。
疲れていたので前日祭の日は懇親会などには参加せずすぐに帰宅して寝ました。
当日
当日はよく寝れたので良いコンディションで臨むことができました。
自分はアトリウム担当でした。
カンファレンスのスタッフの経験がなかったのでちゃんと仕事ができるか不安だったのですが、masawada さんの的確な指示のおかげでちゃんとこなせた気がします。
Perl神社の設営も手伝ったのですが、京都らしさというか日本の伝統文化とPerl文化が融合した感じがとても良かったです
始まってからは主にトーク後の質問のマイクを観客に向ける係をしていました。
スタッフやりながらだったのでトークはずっと集中して聴くことができませんでしたが、特に記憶に残っているのが次のトークです。
売上と開発環境を同時に改善するために既存のPerl Web アプリケーションをどのようにリプレイスするか
現在も成長し続けているサービスの施策や開発を行い続けつつ、開発体験を良くするためのリプレイスを行うのをどのように進めていったかという話でした。
自分は大規模なリプレイスは行ったことがないので興味深く聴かせていただきました。
Perlを技術課題としてしまわずにPerlの良いところを活かしつつリプレイスを進めているところはとてもいいなと思いましたし、新しいコードで古いコードを包んだりリプレイスが完了したリクエストエンドポイントからロードバランサで新しいアプリケーションサーバにリクエストを振り分けるなどといった段階的にリプレイスを進める手法は今後自分も参考にすることがありそうなので覚えておきたいです。
デプロイ今昔物語 〜CGIからサーバーレスまで〜
前半のCGIや素朴なPlackアプリケーションのデプロイをしている様子を見ていると学生時代CGIゲームを改造してたりPlackを試行錯誤してたころを思い出しノスタルジーを感じれてよかったです。
後半のデプロイ手法の紹介では自分の知らなかったオートスケールする環境に適した手法やコンテナを使っている場合の手法などが紹介されていてとても勉強になりました。
他の部屋のトークで気になっていたけど見れなかったトークも多いのでアーカイブが公開されたら見たいですね。
ボランティアスタッフは終わった後が一番忙しくて会場が閉まるまでに必死に片付けたり荷物を運んでいました。
懇親会
懇親会ではずっと会いたかった人と話せたりPerlの濃い話ができました。
特にPerlを勉強し始めた頃にブログ記事など読ませてもらってとてもお世話になったゆーすけべーさんとはじめて話せたのはとても嬉しかったです。
あなぐらくん、うたがわさん、こばけんさんなどとPerlの型やgRPCの話をしたり、charsbarさんとこれからの Perl とても期待できそうで楽しみだよね、みたいな話もしました。
懇親会のあとははてなのオフィスにお邪魔したり、終電がなくなっちゃったので始発まで焼肉にいってから帰宅しました。
翌日は何も活動できなかったです・・・
感想
久しぶりのオフラインYAPC、とても楽しかったです。
しばらくお話できていなかったPerlコミュニティの方やモバファクを退職された方ともお話することができましたし、やっぱりオフラインでのコミュニケーションはオンラインだと難しい双方向性があっていいですね。
ボランティアスタッフも経験がなかったのでちゃんとできるか不安だったのですが、おかげさまでちゃんと仕事はできて、カンファレンスがどのように準備されてるのかその一端を勉強することもできました。
あと今回になってようやく、知り合いというか、話せる人がかなり増えてきた感じがあって嬉しかったです。
初参加の2017年は本当に誰とも会話せずに帰宅しましたし、2018年は頑張って何人かに話しかけてみたものの自分の気力がもたず消化不良に終わった感じで後悔がありました。
とてもスローペースですが、2019年以降 YAPC や Japan.pm でトークを頑張ったことで僕のことを知ってくださっている方が増えてきた気がします。
普段よく参加している Ooimachi.pm の皆さんにもとても助けられているなと思っていて、感謝を申し上げたいです。
今回キャパオーバーしてしまった感じがあるので無理はできないですが、次回は今回の反省を踏まえつつLTうまくできるようになりたいです。
余裕がありそうならまたカンファレンス運営にも携わりたいですね。
*1:前日にOSのアップデートを1回したあと再インストールしていた
Perl で immutable なデータ構造を作る
この記事はPerl Advent Calendar 202113日目の記事です。
2時間ほど遅刻して申し訳ございません・・・
この記事では Perlで Internals::SvREADONLY を利用しimmutableなデータ構造を作る方法について書きます。
検証は perl5.34.0 で行っています。
immutable なデータ構造の利点
まずは immutable なデータ構造の利点について説明します。
immutable なデータ構造とは作成後に内部の状態を変えることのできないデータ構造のことです。
Perlではハッシュや配列でデータ構造を作った後は自由に内部の状態を変更することが可能です。
しかし内部の状態が変更可能なデータ構造をいろんな関数から操作するようなコードを書くと、どこでどのように内部の状態が変化するのか把握することが難しくなるのでコードを読んだりデバッグが難しくなってしまいます。
こういった現象を避けるために関数型言語やそれに影響を受けた言語では内部の状態が変更不可能なデータ構造を作って必要に応じてデータ構造を複製したり差分のみ保持することで読みやすくデバッグがしやすいようなコードを書けるようにしています。
Perlでも最初から immutable なデータ構造を作っておけばそのようなプログラミングスタイルを強制することができます。
また、グローバルな設定値を保持しているようなデータ構造を誤って変更してしまうといったような事故を防ぐ効果も期待できるでしょう。
Internals::SvREADONLY の挙動
次に Perl で immutable なデータ構造を作る上でキモとなる Internals::SvREADONLY の挙動を説明します。
Internals::SvREADONLY は perl の値の readonly flag の on/off を切り替える関数です。
readonly flag が on になっている値には再代入することが不可能になるので、ご存知の方も多いのではないでしょうか。
CPANにはこれを利用して再代入不可能な変数を作るようなモジュールがいろいろ存在したりしますし、constant や Hash::Util の lock 系の関数の内部で使われているAPIでもあります。
スカラ変数の場合
Internals::SvREADONLY の第1引数に再代入不可能にしたい値を、第2引数に真値を与えて呼び出すことでスカラ変数を再代入不可能にできます。
my $scalar = 10; Internals::SvREADONLY($scalar, 1); $scalar = 1; # Error: Modification of a read-only value attempted
readonly flag が on の状態で値を再代入してみると、実行時に Modification of a read-only value attempted ... というエラーが発生することがわかると思います。
readonly flag は Internals::SvREADONLY の第2引数に偽値を与えることで off にできるので、Internals::SvREADONLY に先程 readonly にした変数と偽値をあたえると再代入が可能になってしまいます。
Internals::SvREADONLY($scalar, 0); $scalar = 20; say $scalar; # 20
このようにこれから紹介する immutable なデータ構造を作る方法は reradonly flag を off にしていくことで再代入が可能になってしまいますので、そこだけご留意お願いします。。
さて、 Internals::SvREADONLY には実は配列とハッシュをそのまま渡すこともできて、その場合の挙動はスカラ変数を渡した場合と少し違うものになります。
配列の場合
配列の場合は再代入不可能 + 要素の追加/削除が不可能になります。
my @ary = (0 .. 4); Internals::SvREADONLY(@ary, 1); # 再代入が不可能になる @ary = (2 .. 5); # Error: Modification of a read-only value attempted # 新しい要素の追加も不可能 push @ary, 6; # Error: Modification of a read-only value attempted # 要素の削除も不可能 pop @ary; # Error: Modification of a read-only value attempted # 既にある要素の上書きは可能 $ary[0] = 1;
既に存在する要素への再代入は可能なままです。
既に存在する要素への再代入も禁止したい場合は配列の各要素も Internals::SvREADONLY に渡す必要があります。
Internals::SvREADONLY($ary[0], 1); $ary[0] = 1; # Error: Modification of a read-only value attempted
ハッシュの場合
ハッシュの場合は再代入禁止 + あらたなキーの追加が不可能となります。
my %hash = ( a => 10, b => 20, ); Internals::SvREADONLY(%hash, 1); # 再代入は不可能 %hash = (c => 3, d => 4); # Error: Attempt to access disallowed key 'c' in a restricted hash # 新しいキーの追加も不可能 $hash{c} = 10; # Error: Attempt to access disallowed key 'c' in a restricted hash # 要素の削除は可能 delete $hash{a}; # 既にある要素の上書きも可能 $hash{b} = 0;
ハッシュの各要素への再代入と各要素の削除も可能なままになっています。
それらへの再代入も禁止したい場合は各要素を Internals::SvREADONLY に渡す必要があります。
Internals::SvREADONLY($ary[0], 1); delete $hash{a}; #Error: Attempt to delete readonly key 'a' from a restricted hash $hash{a} = 0; #Error: Modification of a read-only value attempted
エラーメッセージが他と違うのは Hash::Util の内部で使われていることと関係しているからだと思われます。
なお、リファレンスの場合はスカラ変数と同じ挙動となるのでハッシュリファレンスでも配列リファレンスでも再代入が不可能になるだけのようです。
immutablize なデータ構造を作る
以上の Internals::SvREADONLY の挙動を踏まえると、
- 内部のデータ構造がハッシュ/配列の場合はそれをデリファレンスしたものを
Internals::SvREADONLYに渡す - 内部のデータ構造のハッシュ/配列の各要素を
Internals::SvREADONLYに渡す
といったことを再帰的に行えば immutable なデータ構造を作れることがわかると思います。
というわけで実際に実装してみます。
use Test2::V0; use v5.34; use warnings; use utf8; sub immutablaize { my $data = shift; if (ref $data eq 'HASH') { Internals::SvREADONLY(%$data, 1); for my $key (keys %$data) { Internals::SvREADONLY($data->{$key}, 1); if (ref $data->{$key} eq 'HASH' || ref $data->{$key} eq 'ARRAY') { immutablaize($data->{$key}); } } } elsif (ref $data eq 'ARRAY') { Internals::SvREADONLY(@$data, 1); for (my $i = 0; $i < @$data; $i++) { Internals::SvREADONLY($data->[$i], 1); if (ref $data->[$i] eq 'HASH' || ref $data->[$i] eq 'ARRAY') { immutablaize($data->[$i]); } } } else { Internals::SvREADONLY($data, 1); } } my $data = +{ a => 1, b => 2, c => [0 .. 5], d => +{ hoge => '@@@', fuga => '+++', piyo => [0 .. 10], }, }; immutablaize($data); ok dies { $data->{new} = 10 }, 'key追加'; ok dies { $data->{a} = 2 }, '値の再代入'; ok dies { push $data->{c}->@*, 10 }, '入れ子になっている配列にpush'; ok dies { $data->{d}{puyo} = 10 }, '入れ子になっているハッシュにkey追加'; ok dies { push $data->{d}{piyo}->@*, 10 }, '入れ子になっている配列にpush';
実際にコードを動かしてみるとわかると思いますが、入れ子になっているデータ構造の中身も含めてすべての中身を変更不可能にすることができたので、このコードで immutable なデータ構造を作れるようになったと言えるかと思います。
終わりに
このように Internals::SvREADONLY を駆使することで Perl でも immutable なデータ構造が作れることができます。
データ構造の中身を再帰的に操作するのでパフォーマンスが求められる部分では使いにくそうですが、グローバルな設定値をデータ構造で保持している部分などでは使えるのではないでしょうか。
Perl で簡単に総称型を作れるユーティリティを作った
Perl で総称型を作ろうとすると Type::Tiny にいろんなオプションを渡さなければいけなくて結構面倒だったりします。
例えば、型引数を与えたときにその型引数の制約を満たす値のみを入れられる Queue の型を作る総称型を作ろうとすると、次のようになります。
package Queue { use Moo; use Types::Standard -types; has data => ( is => 'ro', isa => ArrayRef, default => sub { [] }, ); sub push { my ($self, $data) = @_; push $self->data->@*, $data } sub pop { my $self= shift; shift $self->data->@*; } } use Type::Tiny; use Types::Standard -types; use Test2::V0; sub Queue(;$) { my $type_params = shift; my $type = Type::Tiny->new( parent => InstanceOf['Queue'], name_generator => sub { my ($name, $type_param) = @_; 'Queue[' . $type_param . ']'; }, constraint_generator => sub { my $type_param = shift; return InstanceOf['Queue'] unless defined $type_param; my $DataType = ArrayRef[$type_param]; sub { my $queue = shift; # Queue->data の型が型引数の制約を満たす値の配列である場合のみ受け付ける $DataType->check($queue->data); }; }, ); $type->parameterize(@$type_params); } my $QueueInt = Queue[Int]; ok $QueueInt->check( Queue->new(data => [0 .. 10]) ); ok !$QueueInt->check( Queue->new(data => [(undef) x 10]) ); done_testing;
Type::Tiny に詳しければこんな感じの総称型を作るのは難しくはないんですが、記述量が多かったりあまり見栄えがよくなかったりするので、このようなコードに何回も登場してもらいたくなかったりします。
また、他のクラスでも総称型を作りたい場合同じような記述を何回もすることになるのであまりイケてないなあという気持ちにもなるわけですね。
そこで簡単に総称型を作れるユーティリティを作ることにしました。
できること
まずこのユーティリティでは class_generics という関数が提供されています。
これは与えられた型引数で特定のアトリビュートの型をチェックするような型を簡単に作れるユーティリティです。
class_generics で先程作ったような Queue の総称型を作ると次のようになります。
use Types::Standard -types; use Type::Utils::Generics qw( class_generics T ); sub Queue(;$); class_generics Queue => ( class_name => 'Queue', attributes => +{ data => ArrayRef[ T(0) ] }, ); my $QueueInt = Queue[Int];
class_name にクラス名、 attributes に型引数で置き換えたいアトリビュートの情報を渡すことで総称型を作れます。
attributes で渡している値が奇妙な見た目をしているので詳しく解説すると、 attributes には型引数でチェックしたいアトリビュートの名前と型引数で置き換えたい位置を示した型(ここではこれを型テンプレートと呼ぶことにします)のペアを渡します。
T(0) という部分が型引数で置き換えられる部分です。
他の言語で総称型を作ると Queue<T> といったふうになりますが、このときのパラメータ T と同じ概念のものです。
この型引数で置き換えられる部分を表す T という関数は、後から置き換える用の意味のある型チェックをしない型オブジェクトを生成する関数で、引数でどの順番の型引数と置き換えるかを指定します。
上の例では引数に 0 を与えているので 0番目の型引数と置き換えるといった感じに動作します。
他にも型引数の順番の指定方法など考えてみたのですが、同じ型引数で別のアトリビュートの型を置き換えたい場合などを考えると他にいい方法を思いつかず、このような見た目になってしまいました。
その他には sub_generics という型が提供されています。
これは与えられた特定の場所のパラメータの型や引数の型を型引数で置き換えた関数の型を簡単に作れるユーティリティです。
例えば配列の中から同じ値の要素を探し返す関数があったとして、その配列の要素や返り値の型を型引数で指定できるような総称型を作りたい場合は次のようになります。
use Types::Standard -types; use Type::Utils::Generics qw( sub_generics T ); use Sub::WrapInType qw( wrap_sub ); sub find { my ($array, $val) = @_; for my $elem (@$array) { return $elem if $elem == $val; } return; } sub Find($); sub_generics Find => ( params => [ ArrayRef[T(0)], T(0) ], isa => Maybe[T(0)], ); use Test2::V0; my $FindInt = Find[Int]; # = TypedCodeRef[ [ Array[Int], Int ] => Int ] ok $FindInt->check(wrap_sub [ Array[Int], Int ] => Int, \&find);
型テンプレートの部分は class_generics の attributes と同じように動きます。
できないこと
他の言語だとクラスの総称型を作るとメソッドの引数の方や返り値の型もパラメータ化できますが、それをやろうとするとインスタンスごとにメソッドの型定義を変える必要があり、CPU的にもメモリ的にもコストがかかりすぎて現実的ではないなと思い断念しました。
今後の展望など
記事を書いていて思ったのですが、sub_generics のメソッド版の method_generics というユーティリティ関数もあったほうが便利そうなので作りたいと思います。
見た目が奇妙なことと、型オブジェクトを本来想定されていないような使い方をしていることから CPAN にあげるかはかなり迷っている状況です。。
Japan.pm 2021 に参加 & トークしてきました
2/18, 19 に行われていたJapan.pm 2021に参加し、「Perl でも関数の型をチェックしたい」というタイトルでトークをしてきました。
トークの資料はこちらです。
内容を簡単にまとめると、Perlで無名関数に型をつける手段がなかったので自分で型ライブラリを作り型をつけれるようにした、といった感じです。
トークの中でも紹介した無名関数の型チェックができるライブラリはこちらです。
コーロバックとかを渡すときに有用だと思うのでぜひ使っていただけると嬉しいです。
発表自体は最初Youtubeの配信をつけっぱなしにしてしまっていてハウリングさせてしまったり、画面共有がうまく行かなかったりと散々でしたが、運営の皆様のフォローのおかげで無事ちゃんとやりきることができました。
本当にありがとうございます。
Twitter や Japan.pm の Discord をあとから見た感じだと発表はだいぶ盛り上がっていた感じがしていてよかったです。
まったくPerlにみえないすごいw #japanpm pic.twitter.com/27olp8qF2E
— uzulla (@uzulla) 2021年2月18日
このような感想もいただき、ありがとうございますとなりました。
Japan.pm には発表中のトークの内容などについてMCの方を中心に発表者、参加者が Dicord で語ったりしている様子を配信する裏トークというシステムがあって、これも非常に良かったです。
通常のオンラインカンファレンスなどだと発表による反応をすぐに得られなくてあまり達成感や手応えがなかったりするのですが、裏トークチャンネルがあると発表終了後に参加すればすぐにトークのフィードバックを得られるので、達成感や手応えといったものもオフラインのとき並に感じることができました。
他のオンラインカンファレンスなどにもこのような仕組みが広まってほしいですね。
さて、今回もとても素晴らしいトークやLTがたくさん行われていましたが、個人的に特に印象深かったのはLTの一瞬でテストを Test2::V0 対応させていたものと perl の処理系を読んでいくものでした。
前者については PPI で Test::More などで書かれたコードを書き換えていくというのも凄いのですが、それ以上に Test2 のプラグインで動的に解析し書き換えていくという非常にパワーを感じる方法で Test2::V0 に対応させているのがおもしろかったです。
後者に関してはひたすら驚異的な gdb 捌きに圧倒されていました。やっていることの2, 3割しか理解できませんでしたが、これで僕もちょっとは perl の処理系を読めるようになるのではという気持ちになれました。
すべての発表が終了した後は交流会というものがあり、様々なトピックのチャンネルが作られて、話しやすいくらいの人数でトピックについて語り合えるような場が用意されていました。
これも素晴らしくて、オフラインのカンファレンスでよくやっていた懇親会のように機能していました。
僕はだいたい型チャンネルというところにいて、Perlの実行時型チェックや静的解析などについていろいろしゃべったり意見を交換したりしていました。
macopy さんが実行時型チェックは便利だけど実行時型チェックするようなサブルーチンを再帰的に呼んでしまうととてもパフォーマンスが悪化するといったことを話していて、本番環境では型チェックをoffにできるようにしたいよねということを話されていて、そのあたりにPerlの実行時型チェックの課題がありそうだなと感じました。
現状型制約ライブラリや引数バリデーター、クラスビルダーにはそのような機能が提供されていないことが多く、さらにそれらのライブラリはインライン化されていたりしていて mock することも難しいので、解決するのが難しそうな課題ですが、なんとかしたいですね。
最後に、今回の Japan.pm はとても楽しかったです。
オンラインカンファレンスに最適化した新しい体験を提供するカンファレンスになっていたと感じていて、すごい運営の方々が頑張ってらっしゃったんだなと思いました。
ありがとうございました。
自作attributeを1から実装する方法を考えてみる
この記事は Perl Advent Calendar 2020 5日目の記事です。
はじめに
Perlには attribute という、サブルーチンもしくは変数に複数の属性を設定できる機能があり、属性に応じて属性が設定された変数もしくはサブルーチンを利用した処理をさせることが可能です。
このような見た目をしています。
: から始まっている部分が attribute です。
sub do_something :Hoge { ... } my $hoge :Hoge :Fuga = 1;
有名なところだと Catalyst というWAFや、他にも言語機能に欲しいような機能を提供しているライブラリでちらほら見かける機能ですが、いろいろ事情*1がありあまり使われていないマイナーな機能です。
attribute の自作は Attribute::Handlers などを利用することで簡単に行えますが、 最近 Attribute::Handlers を利用せず1から自作 attribute を実装したライブラリ*2のコードに手を入れようとしていて自作 attribute を1から実装する方法をきちんと理解しておかないといけなくなったので、これを機に考えてまとめることにしました。
記事中に登場するコードは perl5.32.0 で動作確認しました。
自作した attribute が動作する仕組み
attribute を自作するにあたっては、まず属性ごとに属性が設定されたサブルーチン / 変数を利用した処理が呼ばれる仕組みを理解しておく必要があります。
仕組みに関してはこちらのドキュメントに書かれているので、そちらを参照していただいた上で、属性を設定されたメソッドをprivateメソッドにするattributeの実装を交えて解説します。
package Attribute::PrivateMethod { use v5.32; use warnings; use strict; use Carp qw( croak ); use Sub::Util qw( subname set_subname ); my %is_method_setted_attribute; sub MODIFY_CODE_ATTRIBUTES { my ( $class, $coderef, # attribute が設定されたサブルーチンのリファレンス @attributes # 設定された attribute のリスト ) = @_; # (2) 設定された属性のリストの中に有効な属性があれば属性に応じて処理を行う if ( grep { $_ eq 'Private' } @attributes ) { my $privated_method = sub { my $class = shift; my $caller = caller; croak 'Can not call private method from other package' if $caller ne __PACKAGE__; goto &$coderef; }; my $method_name = subname($coderef); set_subname($method_name, $privated_method); { no strict 'refs'; no warnings 'redefine'; *$method_name = $privated_method; } # (7) FETCH_CODE_ATTRIBUTES でメソッド名から属性が付与されているか判定できるように記録する $is_method_setted_attribute{$method_name} = 1; } # (3) 設定された属性のリストの中に無効な属性がないかチェック my @ignore_attributes = grep { $_ ne 'Private' } @attributes; return @ignore_attributes > 0 ? @ignore_attributes : (); } # (6) attributes::get で attribute のリストを取得できるようにする sub FETCH_CODE_ATTRIBUTES { my ($class, $coderef) = @_; # 属性を設定済みなら設定済みの属性を、設定されてなければ空リストを返す return exists $is_method_setted_attribute{ subname($coderef) } ? ('Private') : (); } # (4) 自作した attribute を設定 sub do_something :Private { say 'do something...'; } # attribute が設定されたメソッドを呼ぶ __PACKAGE__->do_something(); } use attributes qw( get ); use DDP +{ deparse => 1, use_prototypes => 0 }; # (5) 設定された属性の一覧を取得 p [ get(\&Attribute::PrivateMethod::do_something) ]; # [ [0] "Private" ]
サブルーチンや変数に属性が設定されていると、そのパッケージ内もしくは継承ツリーから MODIFY_${データ型}_ATTRIBUTES というメソッドが呼び出されます。
例えばサブルーチンに属性が設定されている場合は MODIFY_CODE_ATTRIBUTES を、スカラ変数に属性が設定されている場合は MODIFY_SCALAR_ATTRIBUTES メソッドが呼び出されます。
今回はサブルーチンに設定する attribute を実装しているので、(1) のように MODIFY_CODE_ATTRIBUTES というメソッドを定義しています。
メソッドには3つの引数が渡されます。
1つ目は属性が設定されたパッケージの名前、2つ目は属性が宣言された対象のリファレンス、3つ目は設定された属性のリストです。
これらの引数を用いつつ attribute に応じた処理を記述していくことになります。
まず、有効な属性があれば (2) のように属性に応じた処理を行います。
次に設定された属性のリストをチェックします。
MODIFY_${データ型}_ATTRIBUTES メソッドがリストを返すと、返したリストは無効な属性の一覧として扱われ、サブルーチンの場合はコンパイル時、その他のデータ型の場合は実行時にエラーが吐かれます。
なので (3) のように付与された属性の一覧の中に無効な属性がないかチェックし、あれば無効な属性のリストを返します。
(2) の前でにチェックしても動くのですが、そうしてしまうと他の attribute と一緒に使っている場合に (2) の処理が実行されなくなってしまうので (2) の後でチェックしています。
無効な属性がなければ最後に空リストを返します。
attribute は以上のようなメカニズムで動いています。
このように自作の attribute を実装していれば (4) のように自作した attribute を設定し動作させることができるようになります。
なお、自作の attribute は大文字から始めないと警告がでます (全部小文字の attribute はすべて予約語的な扱いとなっています)
attribute の動作とは直接関係はないのですが、サブルーチンや変数に設定した属性の一覧は (5) のように attributes モジュールの get 関数で取得できるようになっています。
しかし、何もしていないと自作した属性は取得できないので、自作した属性も取得できるようにサポートする必要があります。*3
attributes::get は呼び出されたとき、引数に与えたリファレンスの実体が宣言されたパッケージから FETCH_${データ型}_ATTRIBUTES というメソッドを呼び出し、引数の実体に設定されている独自の属性を問い合わせ、その結果と設定済みの組み込みの属性のリストとあわせて返します。
なので、今回は (6) のように FETCH_CODE_ATTRIBUTES というメソッドを定義しています。
調べたい対象に属性が設定されているかどうかを判定するにはあらかじめ属性が設定されたタイミングで設定されたことを記録するしかないので、 (7) のように MODIFY_CODE_ATTRIBUTES 内の処理で対象に属性が設定されていることを記録しておいて判定できるようにしています。
他の自作 attribute と共存できるように実装する
上記のコードのままライブラリとして再利用できるように MODIFY_${データ型}_ATTRIBUTES , FETCH_${データ型}_ATTRIBUTES メソッドを export するようなコードを書くと、他の自作 attribute に必要な MODIFY_${データ型}_ATTRIBUTES , FETCH_${データ型}_ATTRIBUTES メソッドを上書きしてしまい他の自作 attribute が動作しなくなってしまうため、共存できるよう工夫して実装する必要があります。
次のように自作 attribute に必要なすべての MODIFY_${データ型}_ATTRIBUTES , FETCH_${データ型}_ATTRIBUTES メソッドを import するときに、 import 先の MODIFY_${データ型}_ATTRIBUTES , FETCH_${データ型}_ATTRIBUTES メソッドを確認し、メソッドが存在すれば既に定義されているメソッドをラップして呼び出してから export すれば共存できるようになります。
package Attribute::PrivateMethod { (略) sub import { my $class = shift; my $export_to = caller; { no strict 'refs'; no warnings 'redefine'; *{ $export_to . '::MODIFY_CODE_ATTRIBUTES' } = do { use strict 'refs'; use warnings 'redefine'; # 他の自作 attribute が使われているか確認 if ( my $orig = $export_to->can('MODIFY_CODE_ATTRIBUTES') ) { # 他の自作 attribute による MODIFY_CODE_ATTRIBUTES を先に呼び出し, 他の attribute では無効だった属性のリストを渡すようにする sub { my ($klass, $coderef, @attributes) = @_; my @orig_ignore_attributes = $klass->$orig($coderef, @attributes); return $class->MODIFY_CODE_ATTRIBUTES($coderef, @orig_ignore_attributes); }; } else { \&MODIFY_CODE_ATTRIBUTES; } }; *{ $export_to . '::FETCH_CODE_ATTRIBUTES' } = do { use strict 'refs'; use warnings 'redefine'; if ( my $orig = $export_to->can('FETCH_CODE_ATTRIBUTES') ) { sub { # 他の自作 attribute による FETCH_CODE_ATTRIBUTES を先に呼び出しその結果とあわせて設定されている属性のリストを返す my ($klass, $coderef) = @_; my @attributes = $klass->$orig($coderef); return ( @attributes, $class->FETCH_CODE_ATTRIBUTES($coderef) ); }; } else { \&FETCH_CODE_ATTRIBUTES; } }; } } (略) } 1;
ただし、ここまで実装を頑張ってもまだいくつか問題があります。
- 組み込みの属性*4 と自作の属性が一緒に設定されているものから attributes::get で属性の一覧を取得しようとすると、組み込みの属性が返されなくなる
- 例えば
sub read :method :Privateみたいなメソッドから属性の一覧を取得しようとすると'Private'しか返ってこない - XSで書かれたコードを読まないと原因がわからないので時間があれば調査してみようと思います
- 例えば
- Attribute::Handlers で実装されているものと併用する場合、先に Attribute::Handlers で実装されたライブラリをロードしておかないと Attribute::Handlers で実装された attribute が動かなくなる
- Attribute::Handlers は UNIVERSAL に
MODIFY_${データ型}_ATTRIBUTESを生やして独自の仕組みで競合しないように実装しているため、先に上記のようなコードのライブラリを使ってしまうと UNIVERSAL に定義されたMODIFY_${データ型}_ATTRIBUTESを呼び出すことなく上書きしてしまう
- Attribute::Handlers は UNIVERSAL に
- 同じ名前の属性をサポートする attribute があると特にエラーも警告もなく後に use した方の attribute が無効になってしまう*5
- 同じ名前の属性をサポートする attribute があるときの挙動の定義もドキュメントを読んだ感じ決まっていなさそうなので、どうすればいいのか難しいところ
おわりに
一通り自作attributeを1から実装する方法を考えてまとめてみましたが、自分で実装しなきゃいけない部分が多すぎて難易度が非常に高かったですし、実験的なメカニズムと書いてあるだけあって綺麗に実装することが難しくて疲れました。
よっぽどの事情がないかぎり Attribute::Handlers を使っといたほうが幸せになれると思います。
今回説明で使ったコードは下のリポジトリにおいてあるので興味のある方は動かしてみてください。
GitHub - ybrliiu/create_homemade_attribute
さて、明日は @narita_cpp さんで 「Paws::S3 で ECS タスクロールを用いてS3へファイルをアップロードする」です。
*1:変数のattributeは実験的な機能であること、属性に応じた処理が呼び出されるメカニズムが実験的な実装だったりすること、attributeを知らない人が見ると何をしているのかわからないことなどから敬遠されがちです
*2:Function::Return によって他の attribute が無効になってしまう不具合の原因を探っていました。 Function::Return のバージョン0.05 までは use するときに attribute の名前をユーザー側で指定できるようになっていたのですが、Attribute::Handlers だと attribute の名前を自由に変更することはできないため1から実装していたのだと思います
*3:ちなみに Attribute::Handlers で実装した attribute であっても attributes::get で属性の一覧を取得できませんでした
*4:lvalue, method, prototype, const など
*5:Attribute::Handlers は継承ツリーの先頭にあるモジュールの属性が有効になっていました
ISUCON10予選に参加してきました
isucon10予選に会社の同期とひとはというチームで参加しました。
最終的にスコアは 1479 で、順位は68位くらいだったようです。
事前準備
New Relic が無料で使えるので使いたいよね、という話をしていて事前にチームで集まってNew Relicを触っていたりしました。
最初は言語をみんなが書けるPerlでやろうという話をしていたのですが、New RelicをPerlで使うのはかなり大変だったので途中からちゃんと動くnodejsでやる方針になりました。
また、当日の段取りはチームメンバーがある程度考えてくれていました。
やったこと
deployスクリプトの作成
- まず3台配られた各サーバーのNginx, MySQLの設定をコピーしてきてレポジトリに追加しました
- デプロイスクリプトは次のような内容になりました
- デプロイするときは各サーバでそれぞれこのスクリプトを実行するという運用にしていました
- ある程度デプロイを自動化したことにより簡単に変更を反映できるようになりました
- Ansible や etckeeper を利用すればもっと早くデプロイの自動化ができそうだったので試してみたいと思います
searchの改善
- まず件数をcountしているところのクエリ発行を消せそうとなりましたが、消せませんでした
- その後はベンチのときのアクセスログを解析して、どのパラメータがよく使われているかを調べていました
- MySQLはインデックスが1つしか使われないので、1番よく使われるパラメータに対応するカラムにインデックスを貼るとスコアが上がると考えて貼ってみましたが、気づいたらチームメンバーが既に貼っていました
- 後日講評を読んだところ、searchで使われるカラム全部にインデックス貼って良かったようでした
- そもそもアクセスログより先にslow query logをまず見るべきでした
考えていたこと
自分がやっていたことは上記2つくらいで、あとは次のようなことを考えていたりしていたと思います。
- APIにリクエスト投げてちゃんと動作しているか確認するスクリプトがあれば捗るのでは？と考えていた
- search系のAPIのパラメータが多くて、その辺り網羅しないとあまり意味がなさそうだったので結局やらず
- データをメモリに乗せればスコアが伸びるのでは?
- 考えついたのが終了1時間前くらいだったので何もできず・・・
チームでやったこと
スコアの伸びに繋がったことのみです
searchの改善
estate.rent と chair.price にインデックスを貼って、少しスコアが伸びました。
nazoteの改善
MySQLの空間インデックスを使うように変更を入れました。
複数台構成にする
1台ロードバランシングさせて3台全部をアプリケーションサーバにしました。
2台構成にした時点ではそこそこスコアが増えたのですが、3台構成にしてもあまり変化はありませんでした。
振り返り
事前準備していたことや経験値が増えたこともあって、前回参加した2年前よりどう動けばいいのかがわかってきた感じはありました。
しかしまだまだきちんと動けていないところやMySQLの理解が足りないと感じるところがあったので、精進しないとなあという感じです。
ボトルネックを解消しようとする前にきちんとメトリクスを計測してプロファイラやslow query logを見てから手をつけるということを肝に命じようと思います。
