この記事は 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 は継承ツリーの先頭にあるモジュールの属性が有効になっていました

MPがありません。

$liiu->mp == 0

自作attributeを1から実装する方法を考えてみる

はじめに

自作した attribute が動作する仕組み

他の自作 attribute と共存できるように実装する

おわりに