MPがありません。

$liiu->mp == 0

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 に詳しければこんな感じの総称型を作るのは難しくはないんですが、記述量が多かったりあまり見栄えがよくなかったりするので、このようなコードに何回も登場してもらいたくなかったりします。

また、他のクラスでも総称型を作りたい場合同じような記述を何回もすることになるのであまりイケてないなあという気持ちにもなるわけですね。

そこで簡単に総称型を作れるユーティリティを作ることにしました。

github.com

できること

まずこのユーティリティでは 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 でも関数の型をチェックしたい」というタイトルでトークをしてきました。

トークの資料はこちらです。

speakerdeck.com

内容を簡単にまとめると、Perlで無名関数に型をつける手段がなかったので自分で型ライブラリを作り型をつけれるようにした、といった感じです。

トークの中でも紹介した無名関数の型チェックができるライブラリはこちらです。
コーロバックとかを渡すときに有用だと思うのでぜひ使っていただけると嬉しいです。

metacpan.org

発表自体は最初Youtubeの配信をつけっぱなしにしてしまっていてハウリングさせてしまったり、画面共有がうまく行かなかったりと散々でしたが、運営の皆様のフォローのおかげで無事ちゃんとやりきることができました。
本当にありがとうございます。

Twitter や Japan.pm の Discord をあとから見た感じだと発表はだいぶ盛り上がっていた感じがしていてよかったです。

このような感想もいただき、ありがとうございますとなりました。

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 があると特にエラーも警告もなく後に 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の無料枠を使ったほうが良さそう。

参考