Distinguish one additional call from another

In the following snippet, how can I distinguish the second instance of my sub foo call from the first?

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

Something like super- caller() , which returned the file, row and column, would do the trick. I would prefer not to use source filters.

Background, or, is this not a XY problem?

I have a convenience module, Local :: Thread :: Once, which provides functions like pthread_once / std::call_once in the OO-ish way, and also as an attribute of a subroutine. This is easy enough, because in any case there is a natural and unambiguous "once_control" or "once_flag".

However, there is also a procedural interface - once { ... } - which is currently serialized based on the $filename and $line returned by caller . Something like that:

 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; } 

It's not exactly how it works — real — more efficient, but again, it's that the call is called from the file and the line of the caller. This works, except that it cannot distinguish between two calls on the same line.

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

Please note that the address $user_routine cannot be used as an additional discriminant, since subs are copied from one, etc. to another.

I can live with this problem as a documented limitation for a very far-fetched use case, but I would rather fix it somehow.

+4
source share
3 answers

Devel :: Callsite was written just for this purpose.

+6
source

I had to read this several times before I realized what you were talking about. What about the super caller function, for example:

 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; } 

This is similar to caller , but the fourth element is an account of how many times we saw this exact package, file, and line in line.

+3
source

For me there is so much black magic, but here are my observations:

  • when passing code link options, you come across one B::COP structure
  • The B::COP structure has file , line and cop_seq (among others)
  • The cop_seq property cop_seq different for different subroutine definitions.

Ass-u-me-ing is true, and not a terribly incomplete model of what is happening, you can use the file, line and cop_seq as a key, or maybe even just cop_seq . Here's a proof of concept:

 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 

And here is the conclusion (your results may vary):

 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' 
+1
source

Source: https://habr.com/ru/post/1499455/


All Articles