caller関数のメモ

#!/usr/bin/perl
use strict;
use warnings;

package Foo;

use Perl6::Say;

sub foo {
    my ($pkg, $file, $line);

    $pkg = caller;
    say $pkg;
    
    ($pkg, $file, $line) = caller;
    say $pkg;
    say $file;
    say $line;
}

package Bar;

Foo::foo();

# <実行結果>
# $ perl ./try.pl
# Bar
# Bar
# ./try.pl
# 23

caller関数を引数無しで呼び出した場合
- スカラーコンテキスト　→　直接の呼び出し元「パッケージ名」を返す
- リストコンテキスト　　→　直接の呼び出し元「パッケージ名」，「ファイル名」，「行番号」を返す

では，caller関数に引数を与えると何が返ってくるのか？

#!/usr/bin/perl
use strict;
use warnings;

package Foo;

use Perl6::Say;

sub foo {
    my ($package, $filename, $line, $subroutine, $hasargs,
        $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(0);
    
    say "\$package   : $package"        if defined $package;
    say "\$filename  : $filename"       if defined $filename;
    say "\$line      : $line"           if defined $line; 
    say "\$subroutine: $subroutine"     if defined $subroutine;
    say "\$hasargs   : $hasargs"        if defined $hasargs;
    say "\$wantarray : $wantarray"      if defined $wantarray;
    say "\$evaltext  : $evaltext"       if defined $evaltext;
    say "\$is_require: $is_require"     if defined $is_require;
    say "\$hints     : $hints"          if defined $hints;
    say "\$bitmask   : $bitmask"        if defined $bitmask;
}

package Bar;

Foo::foo();

# <実行結果>
# $ perl ./try.pl
# $package   : Bar
# $filename  : ./try.pl
# $line      : 27
# $subroutine: Foo::foo
# $hasargs   : 1
# $hints     : 2
# $bitmask   : UUUUUUUUUUUU

引数には，「何番目の呼出元の情報を得るか」を指定する数値(>= 0)を与えます。
引数を指定した時は，戻り値が追加されます。
引数として「0」を指定した場合は，引数を指定しない場合と同じように，直接の呼び出し元の情報を返しますが，リストコンテキストの場合，戻り値が追加される所が異なります。

引数に「1」を指定して，呼び出し元の呼び出し元の情報を取得したケース。

#!/usr/bin/perl
use strict;
use warnings;

package Foo;

use Perl6::Say;

sub foo {
    my ($package, $filename, $line, $subroutine, $hasargs,
        $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(1);
    
    say "\$package   : $package"        if defined $package;
    say "\$filename  : $filename"       if defined $filename;
    say "\$line      : $line"           if defined $line; 
    say "\$subroutine: $subroutine"     if defined $subroutine;
    say "\$hasargs   : $hasargs"        if defined $hasargs;
    say "\$wantarray : $wantarray"      if defined $wantarray;
    say "\$evaltext  : $evaltext"       if defined $evaltext;
    say "\$is_require: $is_require"     if defined $is_require;
    say "\$hints     : $hints"          if defined $hints;
    say "\$bitmask   : $bitmask"        if defined $bitmask;
}

package Bar;

sub bar {
    Foo::foo();
}

package Baz;

Bar::bar();
# <実行結果>
# $ perl ./try.pl
# $package   : Baz
# $filename  : ./try.pl
# $line      : 33
# $subroutine: Bar::bar
# $hasargs   : 1
# $hints     : 2
# $bitmask   : UUUUUUUUUUUU