[Perl] 警告ハンドリングをカスケードする

警告のハンドリング

Perl の警告は、warningsプラグマを有効にしておいて怪しげなことをやってのけるか、またはwarn関数にメッセージを渡せば、発生させることができます。
警告メッセージングをトラップして好きに料理するために、Perl では特殊変数%SIG¹を使います。

warn 'test1';  #=> test1 at ...
{
    my $handler = sub {
        my $msg = shift;
        print "hello! $msg";
    };
    $SIG{__WARN__} = $handler;
}
warn 'test2';            #=> hello! test2 at ...
print STDERR "test3\n";  #=> test3

$SIG{__WARN__}エントリにハンドラとしてサブルーチンリファレンスをセットしておくと、警告メッセージは通常のようにSTDERRに出力される代わりに、引数$_[0]としてハンドラに渡ります。ハンドラは、メッセージを加工して情報を追加するなり、警告をdieで致命的エラーに昇格させるなり、出力せずにどこかの配列に溜めてゆくなり、何もしない (ゆえに警告も表示されない) なり、好きなことができます。

warnは文字列のリストを取り、$SIG{__WARN__}フックのかかっていない状態では、printのように標準エラー出力に逐次それらを出力してゆくだけです (しかし警告シグナルが発生していることは忘れないように！)。出力が改行で終わっていない場合には、さらに警告が発生した位置の情報と、それから改行を追加してくれます。上掲のwarn 'test1'の箇所では、そのように振舞っています。
ハンドラがセットされていると、ハンドラにメッセージが渡りますが、その@_の中味はwarnに渡されたリストそのものではありません。warnが出力するように連結され加工された文字列が$_[0]に渡り、$_[1]以下は未定義になります。従ってwarn 'test2'のところでは、"test2 at ..."という加工済みの文字列が、&my_handlerの$msgに渡っています。&my_handlerはそれを"hello! test2 at ..."という文字列にさらに加工してから、標準出力に²出力します (だってタダのprintですから)。
最後に、print STDERR "test3\n"では、警告ではないので、単にSTDERRに出力されるだけです。標準エラー出力に出力したからといって、perl 内部で警告シグナルが発生するわけではありません。

$SIG{__WARN__} の仕様

$SIG{__WARN__}の細かい仕様は、warn のドキュメント 及び perlvar を参照してください。以下には軽く列挙します。

• すべての警告を強引に無視するには、$SIG{__WARN__} = sub {};として no-op. を設定します。
• 初期状態に戻すには、$SIG{__WARN__} = 'DEFAULT';として、特殊な文字列値'DEFAULT'を格納します。
• コンパイルフェーズでの警告も捕捉する必要があるのなら、BEGIN { $SIG{__WARN__} = sub { ... } }などと、BEGINブロックの中で操作します。
• local $SIG{__WARN__} = sub { ... };として、レキシカルスコープの中だけで有効なハンドラを設定できます。
• ハンドラ内でwarnを安全に呼べます。このwarnはデフォルトの振舞いをし、それが再びハンドラを呼出して無限ループに陥ることはありません。

警告ハンドリングのカスケーディング

Perl の警告メッセージング機構は、このように非常に動的言語としての特性が前面に出たものであり、$SIG{__WARN__}によって処理系のグローバルな状態を操作するものです。つまり一面、$SIG{__WARN__}にハンドラをセットするのは強力すぎる道具立てだ、ということになります。
空サブルーチンを設置して警告を黙らせれば、どんなモジュールのどんな警告も出なくなります。レキシカルスコープに局所化することはできますが、それは上書きなので、そのブロック内では他の一切のハンドラが機能しなくなります。またメッセージのタイプによって何かをする場合など、予想もしないすべての警告にハンドラが対処することは難しいので、ハンドラ内で再びwarnを呼んで、とりあえず表示させておくのが通例です：

BEGIN {
    $SIG{__WARN__} = sub {
        my $msg = shift;
        warn $msg;  # 文字通り警告しておく
        ...;        # それから何かをする
    };
}

それでは、複数の警告ハンドリング機構を同時に使い、それらをカスケードしたい場合には、どうすればよいのでしょうか？　これは例えば、あるモジュール X では警告に情報を添加する、別のモジュール Y では警告に色を付ける、そしてそれらのモジュールが読込まれているかどうか、またどんな順序で読込まれているかについて、モジュール設計者としてはいかなる仮定も置けない、というような場合です。
まず、以前のハンドラを退避することが必要です。そして、自分のしたいことをしてから、以前のハンドラも呼ぶことにしましょう。しかし、「以前のハンドラ」というものはそもそもなく、$SIG{__WARN__}が初期状態である可能性もあります。従って、場合分けが必要です。これは例えば、次のようなコードで実現することができます。

cascade_warn.pl

use 5.28.0;
use warnings;

warn 'Message!';
# => Message! at cascade_warn.pl line 4.


package Fuga {
    my $prev_warn = $SIG{__WARN__};
    $SIG{__WARN__} = sub {
        my $str = "Fuga: $_[0]";  # したいことをする

        defined $prev_warn
            ? $prev_warn->($str)
            : warn($str)
        ;
    };
}

warn 'Message!';
# => Fuga: Message! at cascade_warn.pl line 20.


package Piyo {
    my $prev_warn = $SIG{__WARN__};
    $SIG{__WARN__} = sub {
        my $str = "Piyo: $_[0]";  # したいことをする

        defined $prev_warn
            ? $prev_warn->($str)
            : warn($str)
        ;
    };
}

warn 'Message!';
# => Fuga: Piyo: Message! at cascade_warn.pl line 36.

Fuga→Piyoの順でパッケージが読込まれ、それぞれが$SIG{__WARN__}を操作して、したいことをしています。しかしその前に、以前に設置されていたハンドラを$prev_warnに退避しています。ところで、「以前のハンドラ」が存在しない場合には？　Fugaが、ちょうどそうですね。この場合、$SIG{__WARN__}は未定義値を返します。だから、$prev_warnがundefかどうかによって、定義されているならサブルーチンリファレンスだからそれを呼び、定義されていないなら単にwarnを呼ぶ、と挙動を変えてやればよいのです (Fuga→Piyoの順でハンドラがアペンドされたので、最後のwarnでは、メッセージはまずPiyo化され、次にFuga化されます)。

$SIG{__WARN__}はグローバルにどこからでも弄れるので、こうした仕組みをさらにサブルーチンにまとめてやることもできます。このような手続きを、どこかで何らかの API で提供しておけば、他のモジュールはそれを利用するだけで、簡単にカスケーディングを実現できるようになるでしょう：

cascade_warn2.pl

use 5.28.0;
use warnings;

sub cascade_warn :prototype(&) {
    my $coderef = shift;
    my $prev_warn = $SIG{__WARN__};

    $SIG{__WARN__} = sub {
        my $str = $coderef->($_[0]);

        defined $prev_warn
            ? $prev_warn->($str)
            : warn($str)
        ;
    };
}

package Hoge {
    warn 'Message!';
    #=> Message! at cascade_warn2.pl line 19.
}

package Fuga {
    main::cascade_warn { return "Fuga: $_[0]" };  # したいことをする
    warn 'Message!';
    #=> Fuga: Message! at cascade_warn2.pl line 25.
}

package Piyo {
    main::cascade_warn { return "Piyo: $_[0]" };  # したいことをする
    warn 'Message!';
    #=> Fuga: Piyo: Message! at cascade_warn2.pl line 31.
}

以上は、警告ハンドリングのカスケーディングについて、私の考えついた一つの方法に過ぎません。何かもっといいトリックをご存知だったり、思いついた方がいらっしゃれば、ぜひともお知らせください。

1. ハッシュのように見えますが、あくまで特殊変数であり「本物のハッシュ」ではありません。ハッシュのように扱えますが、必ずしもどんな場合にもそうできるというわけではありません。 ↩

2. より正確には、その時点でselectされていた出力ハンドルに。 ↩