Perl Наследование - Кто вызывающий родительский класс

Question

У меня есть ситуации, когда мне нужно найти абонента пакета и мой код выглядит примерно так:

Inherited.pm:

package Inherited; 
our @ISA = qw(BaseClass); 
sub new { 
    SUPER::new(); 
} 

BaseClass .pm

package BaseClass; 
sub new { 
    $a = caller(0); 
    print $a 
} 

Теперь у меня есть еще один класс (MyClass.pm), который делает:
MyClass.pm:

$obj = Inherited->new(); 

Отпечаток Inherited. Но мне нужно MyClass быть напечатанным заявлением.

Может кто-то, пожалуйста, помогите мне решить, как это решить?

Answer 1

Когда вы даете caller аргумент, вы рассказываете ему, сколько уровней нужно возвращать. Вы дали ему аргумент 0, который является текущим уровнем. Если вы хотите на один уровень вверх, добавьте 1:

use v5.12; 

package Inherited { 
    our @ISA = qw(BaseClass); 
    sub new { 
     $_[0]->SUPER::new(); 
    } 
} 

package BaseClass { 
    sub new { 
     say "0: ", scalar caller(0); 
     say "1: ", scalar caller(1); 
    } 
} 

package MyClass { 
    my $obj = Inherited->new; 
    } 

Теперь результат:

0: Inherited 
1: MyClass 

Помните всегда включают полный пример программы в ваших вопросах. Код Perl, который вы опубликовали, был поврежден по другим причинам, не связанным с caller.

Answer 2

Если я правильно читаю ваше сообщение, вам нужно найти последний кадр в стеке вызовов, вызывающий конструктор.

package BaseClass; 
sub new { 
    my $a = caller(0); 
    for (my $n=0; my @c=caller($n); $n++) { 
     last if $c[4] !~ /::new$/; 
     $a = $c[0]; 
    } 
    print $a; 
} 

или

package BaseClass; 
sub new { 
    my @a; 
    unshift @a, [ caller(@a) ] while caller(@a); 
    my ($a) = grep { $_->[4] =~ /::new$/ } @a; 
    print $a // caller(0); 
} 

Второй фрагмент кода будет обрабатывать случай, когда есть вызовы промежуточные функции, которые не являются конструкторами, например, если стек вызовов выглядит

GrandChild::new 
GrandChild::init 
Inherited::new 
BaseClass::new 

в первый фрагмент вернет вызывающего абонента для Inherited::new (который предположительно будет GrandChild, а второй будет возвращать вызывающего абонента GrandChild::new.