MPがありません。

$liiu->mp == 0

自作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 があると特にエラーも警告もなく後に 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の設定をコピーしてきてレポジトリに追加しました
  • デプロイスクリプトは次のような内容になりました
    1. git pull してくる
    2. 変更をもとに戻しやすいようにブランチも指定できるようにする
    3. 各サーバのNginx, MySQLの設定を cp -rf で上書き
    4. npm ci を実行
      • この日初めて知ったのですが、npm install と違い package-lock.json を更新しないので本番とかCIの場合はこちらを使うほうがいいとのことだった
    5. nodejsで動いているWebアプリ、Nginx, MySQLのサービスをrestartする
  • デプロイするときは各サーバでそれぞれこのスクリプトを実行するという運用にしていました
  • ある程度デプロイを自動化したことにより簡単に変更を反映できるようになりました
    • Ansible や etckeeper を利用すればもっと早くデプロイの自動化ができそうだったので試してみたいと思います

searchの改善

  • まず件数をcountしているところのクエリ発行を消せそうとなりましたが、消せませんでした
  • その後はベンチのときのアクセスログを解析して、どのパラメータがよく使われているかを調べていました
    • MySQLはインデックスが1つしか使われないので、1番よく使われるパラメータに対応するカラムにインデックスを貼るとスコアが上がると考えて貼ってみましたが、気づいたらチームメンバーが既に貼っていました
    • 後日講評を読んだところ、searchで使われるカラム全部にインデックス貼って良かったようでした
  • そもそもアクセスログより先にslow query logをまず見るべきでした

考えていたこと

自分がやっていたことは上記2つくらいで、あとは次のようなことを考えていたりしていたと思います。

  • APIにリクエスト投げてちゃんと動作しているか確認するスクリプトがあれば捗るのでは?と考えていた
    • search系のAPIのパラメータが多くて、その辺り網羅しないとあまり意味がなさそうだったので結局やらず
  • データをメモリに乗せればスコアが伸びるのでは?
    • 考えついたのが終了1時間前くらいだったので何もできず・・・

チームでやったこと

スコアの伸びに繋がったことのみです

searchの改善

estate.rentchair.price にインデックスを貼って、少しスコアが伸びました。

nazoteの改善

MySQLの空間インデックスを使うように変更を入れました。

複数台構成にする

1台ロードバランシングさせて3台全部をアプリケーションサーバにしました。
2台構成にした時点ではそこそこスコアが増えたのですが、3台構成にしてもあまり変化はありませんでした。

振り返り

事前準備していたことや経験値が増えたこともあって、前回参加した2年前よりどう動けばいいのかがわかってきた感じはありました。
しかしまだまだきちんと動けていないところやMySQLの理解が足りないと感じるところがあったので、精進しないとなあという感じです。
ボトルネックを解消しようとする前にきちんとメトリクスを計測してプロファイラやslow query logを見てから手をつけるということを肝に命じようと思います。

sshで接続しようとすると Bad configuration option: proxyjump というエラーがでる場合の対処方法

そこそこ時間を溶かしたのでメモ.

この前古めのPCからssh config をいじってssh接続しようとしたら Bad configuration option: proxyjump というエラーがでました。

OpenSSHで Proxyjump の設定をサポートしたのは7.3からなので、古いOpenSSHがインストールされていると上記のようなエラーがでるようです。

なのでOpenSSHを7.3以上にアップデートすることでエラーを解消できますが、アップデートが面倒な場合は ProxyCommand を使って書き換えることで同じように動作させることができます。

ProxyJump ${ホスト名}
ProxyCommand ssh ${ホスト名} -W %h:%p

Perl5.32の新機能

 6/22にリリースされたPerlの最新安定バージョン5.32では久しぶりにいろいろ新機能が追加されてたので、perldeltaを読みつつ試してみました。
 内容は7/1にあったPerl若手の会で発表したこととほぼ同じで、そこで聞いたことを追記したりしてます。

isa 演算子

 左被演算子に渡した値が右被演算子のクラスのインスタンスまたはそこから派生したクラスのインスタンスなのかを調べる演算子です。
 use feature 'isa' でこの機能を有効化でき、実験的機能使用による警告は no warnings 'experimental::isa' で抑止できます。

use v5.32;
use feature 'isa';
no warnings 'experimental::isa';
  
package A { use Moo }
my $obj = A->new;
  
say '$obj is instance of A.' if $obj isa A;
say '$obj is instance of A.' if $obj isa 'A';
my $klass = 'A';
say '$obj is instance of A.' if $obj isa $klass;

 isa演算子の追加によって、トリッキーな方法や外部モジュールを利用することなく、クラスのインスタンスまたはそこから派生したクラスのインスタンスなのかを調べることが可能になります。

 Perlには以前から UNIVERSAL に isa メソッドが定義されていて、すべてのクラスから呼べるこのメソッドを使うことで呼び出し元が引数に与えたクラスのインスタンスまたはそこから派生したクラスのインスタンスなのかを調べていました。

package A { use Moo }
   
my $obj = A->new;
say '$obj is instance of A.' if $obj->isa('A');

 しかし isa メソッドを呼ぶ処理を書くだけではクラスのインスタンスまたはそこから派生したクラスのインスタンスなのかを調べることができないので不便なことがあります。

 まず、未定義値や空文字列からメソッドを呼び出そうとすると例外が発生するので、それらの値が来るような処理では例外が発生しないように処理を書く必要がありました。
 そのような処理を書くために、 UNIVERSAL::isa を関数として呼び出したり*1Scalar::Util モジュールにある blessed 関数を利用して bless されたリファレンスかをチェックしてから isa メソッドを呼び出すといったことが行われてきました。

my $obj = undef;
$obj->isa('A'); # Can't call method "isa" on an undefined value 

$obj = '';
$obj->isa('A'); # Can't call method "isa" without a package or object reference 

# UNIVERSAL::isa を関数として呼び出して判定
UNIVERSAL::isa($obj);

# blessed でblessされたインスタンスか調べてから判定
use Scalar::Util qw( blessed );
say '$obj is instance of A.' if blessed($obj) && $obj->isa('A');

 また、 isa メソッドは文字列からも呼び出せる為クラスのインスタンスまたはそこから派生したクラスのインスタンスかどうかを調べたい場合は不都合があり、そういったときも Scalar::Util#blessed を利用する必要がありました。

演算子の連鎖が可能に

 python のように同じ優先順位の比較演算子、等価演算子であれば連鎖して書くことが可能になりました。
 $x < $y && $y <= $z$x < $y <= $z$x == $y && $x == $z$x == $y == $z といったふうに記述できるようになります。

 注意点がいくつかあって、まず、優先順位が違う演算子を連鎖させることは不可能です。
例えば $x < $y == $z$x < $y が先に評価され、評価した結果を $z と等価か調べる挙動となります。

 また、サブルーチンや式の結果は使いまわされます。
 例えば $x < expensive_sub() <= $zmy $tmp = expensive_sub(); $x < $tmp && $tmp <= $z と同じ挙動に、$x < $tied_scalar + 12 < $ymy $tmp = $tied_scalar + 12; $x < $tmp && $tmp <= $z と同じ挙動になります。
 なお、 tie されたスカラ変数が演算子にそのまま渡される場合は毎回 FETCH を、演算子オーバーロードされたクラスのインスタンスの変数が演算子にそのまま渡される場合は毎回演算子に対応するメソッドを呼び出します。
 例えば $x < $tied_scalar < $y を実行すると、$x < $tied_scalar && $tied_scalar < $y というふうに動作するので $tied_scalar と紐付いているFETCHメソッドは2回実行され、実行されるたびに返された値で条件式が実行されます。

Unicode 13.0 のサポート

 PerlUnicode のサポートが手厚くて恒例のという感じです。
サポートにより具体的にどういったことができるかは完全に把握できていないですが、Unicode文字名でUnicode文字を指定できるようになったり、正規表現Unicode文字特性にマッチさせることができるようになっているのを確認しています。
 例えば Unicode 13.0 では忍者の絵文字が追加されているので say "\N{NINJA}" で(OSがサポートしていれば)忍者の絵文字を標準出力に出力できたり、 "\N{NINJA}" =~ /\p{Emoji}/Unicode文字特性にマッチさせれたりといった感じです。

正規表現の中で \p{name=...} と書くことでUnicode文字を表現することが可能に

 今まで でも\N{...}Unicode文字を表現できていましたが、代わりの方法として正規表現の中なら \p{name=NAME}Unicode文字を表現可能になりました。
  \N{...}との主な違いは実行時に変数が展開されるところです。

my $name = "NINJA";
"\N{$name}";       # Unknown charname '$name'
qr/\p{name=$name}/ # \p{name=NINJA} として解釈される

 他にも細かい点で違いがあって、詳しく知りたい方はドキュメントを読むといいと思います

新しいUnicode文字特性 Identifier_Status, Identifier_Type のサポート

 これに関してはperldeltaに貼ってある unicode.org の記事が見れなかったので詳細は不明です・・・。
 分かり次第追記するかもです

*1:Perlのメソッドは実態としてはただのサブルーチンなので、パッケージ名を修飾すれば普通にサブルーチンとして呼び出すことができます

なるべく確実にメールを送信する処理を書くには

メール送信処理は単純にコードを書くだけではダメっぽいのでどうすればいいのかという話

メールが送信に失敗する状況

何らかのエラーによって送信したメールが送信者に差し戻されることをバウンスという。
バウンスにはソフト / ハードの2種類がある。

ハードバウンス

永続的なエラーによるバウンスで、そのメールアドレスには基本的に届けることができない。
例えばDNSの参照に失敗する、メールアドレスが存在しない、メールアドレスの書式が不正、受信拒否されている、など。

ソフトバウンス

一時的なエラーによるバウンス。時間をおいて再送信すれば届くことが多い。
例えばメールボックスがいっぱい、メッセージサイズが大きすぎる、サーバがダウンしている、など。

メール送信のエラー処理の書き方

つまりなるべく確実にメールを送信したいのなら、バウンスがソフトバウンスなら時間を少しおいて送信処理をリトライするような処理を書けば良い。

ソフトバウンスならエラーコードが400系、ハードバウンスなら500系になるので、1回目の送信で400系のエラーなら1, 2分間隔を空けつつ3回ほどリトライ処理を行い、
500系のバウンスの場合はリトライしても送れない可能性が高いのでなぜ送信できなかったかを確認できるようにログに書き出すなどしておく。

以下PerlEmail::Sender を使ってなるべく確実にメールを送信する処理を書いた例

use Encode qw( encode );
use Scalar::Util qw( blessed );
use Log::Minimal qw( critf );
use Email::Sender::Simple qw( sendmail );
use Email::Simple;
use Email::Sender::Transport::SMTP ();

my $transport = Email::Sender::Transport::SMTP->new(
  host          => $host,
  port          => 587,
  sasl_username => $username,
  sasl_password => $password,
);

my $email = Email::Simple->create(
  header => [
    To      => $address,
    From    => $sender_address,
    Subject => encode('MIME-Header-ISO_2022_JP', 'タイトル'),
  ],
  body => encode('ISO-2022-JP', '本文'),
);
redundanted_sendmail($email, +{ transport => $transport });

sub redundanted_sendmail {
  my ($email, $options) = @_;
  my $retry_num = 2;
  for (0 .. $retry_num) {
    eval { sendmail($email, $options) };
    if (my $e = $@) {
      die $e unless blessed($e) && $e->isa('Email::Sender::Failure');
      if ( $e->code =~ /^4[0-9]{2}$/ ) {
        if ( $_ >= $retry_num ) {
          critf "Send mail failed. code: %d %s", $e->code, $e->message;
          die $e;
        }
        sleep 60;
      }
      elsif ( $e->code =~ /^5[0-9]{2}$/ ) {
        critf "Send mail failed. code: %d %s", $e->code, $e->message;
        die $e;
      }
      else {
        die $e;
      }
    }
  }
}

しかし、エラーが返ってきても何度もメールを送信していると相手からBANされることがあったりするので、少量の送信ならば無料枠で済むSendGridの無料枠を使ったほうが良さそう。

参考

WEB+DB Press Vol.115 の Perl Hackers Hub に寄稿しました

2/22 に発売される WEB+DB Press Vol.115 の Perl Hackers Hub に「動的なモジュールロードとの付き合い方」というタイトルで寄稿させていただきました。
恐れ多くも商業誌デビューとなります。

(他記事や他の作者の方を見て、僕のような未熟な人間がこのような場にいていいのかと改めて戦慄しています・・・)

記事の内容は以下のようになっています。

  • Perlで動的なモジュールロードをする方法とハマりどころ
  • 動的なモジュールロードで実現できること
  • 動的なモジュールロードの活用
  • 動的なモジュールロードで発生する問題とその対策

過去にブログで書いた記事や、昨年11月にYAPC::Nagoya::Tiny で発表したトークを実践的に深堀りした内容ですね。

Perlではほかの言語と比べ、言語の柔軟性や文化的な要因により動的なモジュールロードが利用されることが多いと思います。
実際、拡張性や実装の手間の削減といった面で多大な恩恵もたらすので、僕も仕事や趣味でよく利用してきましたし、 CPANでも動的にロードする処理をよく見かけます。
しかし、規模が大きいプロダクトや継続的にメンテナンスされるコードでは、動的なモジュールロードが原因で保守性が低下し様々な問題が発生する・・・という経験をしてきました。
そこで、改めて動的なモジュールロードでどのようなことができるようになり、どのように活用されているかをまとめ、その上でどのような問題が起きるのか、問題に対してどのような対策をうてるのかを調査したり考えた、という内容になっています。
動的なモジュールロードはなかなか扱いが難しいので、この記事で述べたことが使いどころの指針になったり、より保守性の高いコードを書くための助けになれば幸いです。

僕の記事以外にも、競プロの過去問からアルゴリズムを学べる記事や、iOS13での新機能に関する記事、12月にリリースされたRuby2.7についての記事、さくっとゲームを作る方法を解説している記事などおもしろそうな記事がいろいろありますので、ぜひお手に取ってみてください。
よろしくお願いいたします!

今回このような貴重な機会をくださった方、記事の内容を校正してくださったりレビューしてくださった関係者の皆様方、アドバイスをくれたり応援してくださった方々にこの場を借りて御礼申し上げます。
とても嬉しかったですし、勉強になりました。
ありがとうございました。

Types::TypedCodeRef というモジュールを作りました

概要

Types::TypedCodeRef はPerlで「関数の型」をチェックする型を提供するようなモジュールです。
調べた感じ匿名サブルーチンにいい感じに引数の型とサブルーチンの返り値の型をつけてくれるようなモジュールもなさそうだったので、
AnonSub::Typed という匿名サブルーチンの引数の型と返り値の型をチェックするようなモジュールも作りました。

https://github.com/ybrliiu/p5-Types-TypedCodeRef
https://github.com/ybrliiu/p5-AnonSub-Typed

使い方

use v5.30;
use Test2::V0;
use Types::TypedCodeRef qw( TypedCodeRef );
use Types::Standard qw( Int Str );
use AnonSub::Typed qw( anon );

my $type = TypedCodeRef[ [Int, Int] => Int ];
ok $type->check(anon [Int, Int] => Int, sub { $_[0] + $_[1] });
ok !$type->check(0);
ok !$type->check([]);
ok !$type->check(sub {});

package Hoge {

    use Moo;
    use Types::Standard qw( ArrayRef Int );
    use Types::TypedCodeRef qw( TypedCodeRef );

    has event_handlers => (
        is       => 'ro',
        isa      => ArrayRef[ TypedCodeRef[ [ Int, Int ] => Int ] ],
        required => 1,
    );

}

my $hoge = Hoge->new(event_handlers => [ anon [Int, Int] => Int, sub { $_[0] + $_[1] } ]);
is $hoge->event_handlers->[0]->(12, 13), 25;

done_testing;

モチベーション

Perlでコード書いているときにもObserverパターン的なアーキテクチャを作りたくなることがあるのですが、
いちいち愚直にObserverパターンを実装するのは面倒くさいですし、かといってイベントハンドラみたいにCodeRefだけわたして雑に実装しようとすると、
イベントハンドラに登録するコールバック関数に渡す引数と関数の返り値の型がわかりにくくなり、コードの可読性が落ちるので、なんとかしたくなり実装しました。

最初は Function::Parameters や Function::Return あたりのモジュールで匿名サブルーチンの引数と返り値の型付けもできるかなーと思っていましたが、どうやら匿名サブルーチンの場合はattributeが有効にならないようだったので、(attributeの実装的にも恐らくそうなる)、匿名サブルーチンの引数と返り値の型チェックを行うモジュール AnonSub::Typed の実装を行ってから、Types::TypedCodeRef を実装しました。

実装について

AnonSub::Typed

型に関する情報もGCで一緒に管理されてほしいので、匿名サブルーチン本体をblessしたinside-outオブジェクトを返すクラスとして実装していて、それにパラメータの型や返り値の型情報を紐付けています。
クラスビルダーには Class::InsideOut というクラスビルダーを利用しています。
後は愚直に anon という AnonSub::Typedインスタンスを作る関数を提供しています。

Types::TypedCodeRef

Type::Tiny のコードを参考にしつつ、総称型のような型を作っています。
同じインターフェースの関数かどうかは最近kfly8さんが作られた Sub::Meta を利用して比較しています。
また、外部からコールバック関数を登録すれば AnonSub::Typed 以外のインスタンスでも比較できるような設計にしています。

今後の展望

AnonSub::Typed はもうやることはないかなーという感じですが、
Types::TypedCodeRef の方は AnonSub::Typed 以外を利用しているパターンでも関数の型を取得できる場合があればコールバック関数を登録しなくても比較できるようにしたいです。
後はテストとドキュメントを充実させたらCPANizeしたいと思っています。