区分一个子调用和另一个

Question

在下面的片段中，如何区分我的子 foo 的第二个调用实例和第一个？

while ($whatever) {
  foo(); foo();     # foo() and foo() have the same caller package, file, and line
}

返回 file、line 和 column 之类的 super-caller() 就可以解决问题。我不想使用源过滤器。

背景，或者，这不是一个 XY 问题吗？

我有一个便利模块，Local::Thread::Once，它以面向对象的方式以及作为子例程属性公开像 pthread_once/std::call_once 这样的功能。这些都很容易，因为在任何一种情况下都有一个自然且明确的“once_control”或“once_flag”。

但是，还有一个过程接口 — once { ... } — 目前基于 caller 返回的 $filename 和 $line 进行序列化。像这样的：

sub once(&) {
  my $user_routine = shift;
  my (undef, $file, $line) = caller;

  my $once_control = get_a_shared_flag_just_for_this_invocation($file, $line);

  lock($once_control);
  if (! $once_control) { $once_control++; $user_routine->(); }
  return;
}

这并不完全是它的工作方式——真正的效率更高——但重点是调用与调用者的文件和行无关。这可行，只是它无法区分同一行上的两个调用。

while ($whatever) {
  once { foo(); }
  once { bar(); }                    # OK, foo() and bar() each called only once
  once { baz(); }; once { buz(); };  # :(  buz() not called, not even once
}

请注意，$user_routine 的地址不能用作附加判别式，因为 subs 是从一个 ithread 复制到另一个。

我可以忍受这个问题作为一个非常人为的用例的记录限制，但我更愿意以某种方式解决它。

Answer 1

Devel::Callsite 正是为此目的而编写的。

Answer 2

在我明白你在说什么之前，我不得不读了几遍。像这样的“超级调用者”函数怎么样：

my @last_caller = ("","","",0);
sub super_caller {
    my ($pkg,$file,$line) = caller(1 + shift);
    if ($pkg eq $last_caller[0] &&
        $file eq $last_caller[1] &&
        $line eq $last_caller[2]) {
        $last_caller[3]++;
    } else {
        @last_caller = ($pkg,$file,$line,1);
    }
    return @last_caller;
}

类似于caller，但第 4 个元素是对我们连续看到这个确切的包、文件和行的次数的计数。

Answer 3

optree 对我来说仍然是个黑魔法，但以下是我的观察：

1. 在遍历代码引用的 optree 时，您会遇到一个 B::COP 结构
2. B::COP 结构具有file、line 和cop_seq 属性（等等）
3. cop_seq 属性对于不同的子例程定义是不同的

Ass-u-me-ing 这些都是真实的，而不是一个非常不完整的正在发生的模型，您可以使用文件、行和 cop_seq 作为键，或者甚至只是 cop_seq。这是一个概念证明：

use B;

sub once (&) {
    my $code = shift;
    my $key = get_cop_seq($code);
    print "once called with code '$key'\n";
}

my $optreedata;
sub get_cop_seq {
    my $code = shift;
    $optreedata = "";
    B::walkoptree( B::svref_2object($code)->ROOT, "find_cop_seq" );
    return $optreedata;
}
sub B::OP::find_cop_seq {
    my $op = shift;
    if (ref $op eq 'B::COP') {
        $optreedata .= sprintf "%s:%d:%d", $op->file, $op->line, $op->cop_seq;
    }
}

sub foo { 42 }
sub bar { 19 };

once { foo };                  # this is line 26
once { bar };
once { foo }; once { bar };
once { bar } for 1..5;         # line 29

这是输出（您的结果可能会有所不同）：

once called with code 'super-caller2.pl:26:205'
once called with code 'super-caller2.pl:27:206'
once called with code 'super-caller2.pl:28:207'  <--- two calls for line 28
once called with code 'super-caller2.pl:28:208'    |- with different cop_seq
once called with code 'super-caller2.pl:29:209'      
once called with code 'super-caller2.pl:29:209'      
once called with code 'super-caller2.pl:29:209'  <--- but 5 calls for line 29
once called with code 'super-caller2.pl:29:209'       with the same cop_seq
once called with code 'super-caller2.pl:29:209'