Multiple Vererbung und (dynamische) Aufrufe via SUPER

Hallo NG,

gegeben das unten stehende Programm würde ich es lieber sehen, wenn in
B::test SUPER relativ zur Klasse des Objekts sein würde, mit dem die
Methode aufgerufen wird, d.h. dass in A::Inher danach gesucht wird.
So wie ich das verstehe ist SUPER aber statisch an das aktuelle Paket
gebunden.
Ich möchte das, weil Objekte der B-Familie parallel zu denen der
A-Familie sind, aber jeweils zusätzliches Verhalten haben. Dieses
zusätzliche Verhalten (in test) ist aber abstrakt gesehen auch für
alle von B abgeleiteten Klassen gleich, nämlich:
Mach deine Extrawurst und frag dann deine Basisklassen nach test

Leider ist die einzige Alternative, die ich sehe, die, dass ich die
Methode test von B in jede von B abgeleitete Klasse copy&paste. Das
erscheint mit aber unelegant. Kann ich also irgendwie an das SUPER der
Klasse des aufrufenden Objekts kommen? Oder is mein Design kaputt?

Code:

package A;
use strict;
use warnings;
sub new { print "A::new called\n"; return bless {}, shift}
sub test { print "A::test called\n"}

package B;
use strict;
use warnings;
sub new { print "B::new called\n"; return bless {}, shift}
sub test { print "B::test called\n"; shift->SUPER::test() }

package A::Inher;
use strict;
use warnings;
use base qw/A/;
sub test { print "A::Inher::test called\n" }

package B::Inher;
use strict;
use warnings;
use base qw/B A::Inher/;

package main;
use strict;
use warnings;

my $a = B::Inher->new();
$a->test();

__END__

Schöne Grüße,

Arne Ruhnau

Re: Multiple Vererbung und (dynamische) Aufrufe via SUPER

Arne Ruhnau wrote:

> gegeben das unten stehende Programm würde ich es lieber sehen, wenn in
> B::test SUPER relativ zur Klasse des Objekts sein würde, mit dem die
> Methode aufgerufen wird, d.h. dass in A::Inher danach gesucht wird.
> So wie ich das verstehe ist SUPER aber statisch an das aktuelle Paket
> gebunden.

Ja, SUPER bezieht sich auf die Klasse, in der die Methode
definiert ist, nicht auf die Klasse, der das Objekt angehört.

> Ich möchte das, weil Objekte der B-Familie parallel zu denen der
> A-Familie sind, aber jeweils zusätzliches Verhalten haben.

Ist das nicht der klassische Fall für eine Ableitung (B von A
oder A und B von einer gemeinsamen Basisklasse)?

> Dieses
> zusätzliche Verhalten (in test) ist aber abstrakt gesehen auch für
> alle von B abgeleiteten Klassen gleich, nämlich:
> Mach deine Extrawurst und frag dann deine Basisklassen nach test

Das leistet die Vererbung ja. Die gemeinsame Funktionalität muss
dann allerdings irgendwo entlang der Verbungshierarchie
angesiedelt sein. Andere Möglichkeit: Delegation.

> Leider ist die einzige Alternative, die ich sehe, die, dass ich die
> Methode test von B in jede von B abgeleitete Klasse copy&paste. Das
> erscheint mit aber unelegant. Kann ich also irgendwie an das SUPER der
> Klasse des aufrufenden Objekts kommen?

Du kannst die @ISA-Hierarchie, ausgehend von der Klasse des
Objektes auch selbst durchlaufen. Ich habe aber so meine Zweifel,
ob Du das wirklich willst.

> Oder is mein Design kaputt?

Schwer zu sagen, da nicht klar ist, was Du überhaupt designen willst.
Dazu ist Dein Beispiel etwas zu abstrakt. Aus dem Bauch heraus
würde ich sagen: Ja, mit Deinem Design stimmt was nicht.

Grüße
Frank
--
Dipl.-Inform. Frank Seitz; http://www.fseitz.de/
Anwendungen für Ihr Internet und Intranet
Tel: 04103/180301; Fax: -02; Industriestr. 31, 22880 Wedel

Re: Multiple Vererbung und (dynamische) Aufrufe via SUPER

Arne Ruhnau schrieb:
> Hallo NG,
>
> gegeben das unten stehende Programm würde ich es lieber sehen, wenn in
> B::test SUPER relativ zur Klasse des Objekts sein würde, mit dem die
> Methode aufgerufen wird, d.h. dass in A::Inher danach gesucht wird.
> So wie ich das verstehe ist SUPER aber statisch an das aktuelle Paket
> gebunden.
> Ich möchte das, weil Objekte der B-Familie parallel zu denen der
> A-Familie sind, aber jeweils zusätzliches Verhalten haben. Dieses
> zusätzliche Verhalten (in test) ist aber abstrakt gesehen auch für alle
> von B abgeleiteten Klassen gleich, nämlich:
> Mach deine Extrawurst und frag dann deine Basisklassen nach test
>
> Leider ist die einzige Alternative, die ich sehe, die, dass ich die
> Methode test von B in jede von B abgeleitete Klasse copy&paste. Das
> erscheint mit aber unelegant. Kann ich also irgendwie an das SUPER der
> Klasse des aufrufenden Objekts kommen? Oder is mein Design kaputt?
>
> Code:
>
> package A;
> use strict;
> use warnings;
> sub new { print "A::new called\n"; return bless {}, shift}
> sub test { print "A::test called\n"}
>
> package B;
> use strict;
> use warnings;
> sub new { print "B::new called\n"; return bless {}, shift}

sub test {
my $self = shift;
print "B::test called\n";
# $self->SUPER::test() ;
if (my $coderef = $self->find_next('test')){
$coderef->($self,@_)
}
}
sub find_next{
# step through selfs @ISA and return the 1st method 'method_name'
# found after the one defined in the current package
my ($self,$method_name)= @_;
my $class = ref $self;
no strict 'refs';
my $get_this;
for my $parent(@{$class."::ISA"}){
if ($parent eq __PACKAGE__){$get_this = 1; next;}
if ($get_this && (my $code = $parent->can($method_name))){
return $code;
}
}
return undef;
}

> package A::Inher;
> use strict;
> use warnings;
> use base qw/A/;
> sub test { print "A::Inher::test called\n" }
>
> package B::Inher;
> use strict;
> use warnings;
> use base qw/B A::Inher/;
>
> package main;
> use strict;
> use warnings;
>
> my $a = B::Inher->new();
> $a->test();
>
> __END__
>
> Schöne Grüße,
>
> Arne Ruhnau


Hallo Arne,

so etwas wie das find_next oben würde vielleicht funktionieren.
Es spart hier den aktuellen Zweig (also das, was 'SUPER' finden würde)
ganz aus.
Ich habe das noch nie gebraucht, aber vielleicht hilft es ja.

Christoph
--

perl -e "print scalar reverse q/ed.enilno@ergn.l.hc/"

Re: Multiple Vererbung und (dynamische) Aufrufe via SUPER

Frank Seitz wrote:
> Arne Ruhnau wrote:
>
>>Ich möchte das, weil Objekte der B-Familie parallel zu denen der
>>A-Familie sind, aber jeweils zusätzliches Verhalten haben.
>
>
> Ist das nicht der klassische Fall für eine Ableitung (B von A
> oder A und B von einer gemeinsamen Basisklasse)?

Danke für den Tipp, das hat den Knoten ein wenig gelöst. Jetzt gibt es
eine Zwischenklasse A::Cond, die von A ableitet, unterhalb der die
vorherige B-Familie angesiedelt ist. Mit ein, zwei Helfermethoden
macht es jetzt auch Das Richtige(tm).

>>Leider ist die einzige Alternative, die ich sehe, die, dass ich die
>>Methode test von B in jede von B abgeleitete Klasse copy&paste. Das
>>erscheint mit aber unelegant. Kann ich also irgendwie an das SUPER der
>>Klasse des aufrufenden Objekts kommen?
>
>
> Du kannst die @ISA-Hierarchie, ausgehend von der Klasse des
> Objektes auch selbst durchlaufen. Ich habe aber so meine Zweifel,
> ob Du das wirklich willst.

Das wäre ja dank Christophs Posting möglich :). Aber wie sich
herausstellte, wollte ich das tatsächlich nicht.

>>Oder is mein Design kaputt?
>
> Schwer zu sagen, da nicht klar ist, was Du überhaupt designen willst.
> Dazu ist Dein Beispiel etwas zu abstrakt. Aus dem Bauch heraus
> würde ich sagen: Ja, mit Deinem Design stimmt was nicht.

Unten nochmal der korrigierte Code, sogar mit ein wenig
Funktionalität. Spaßigerweise gibt es jetzt einen wunderbaren
Diamanten in der Vererbung... Macht das in Perl was? Ich denke ja
nicht, da Vererbung in Perl ja nur Namensauflösung ist...

Besten Dank für die Hilfe,

Arne Ruhnau

__CODE__

package A;
use strict;
use warnings;
sub new {
my ($class, $name) = @_;
my $self = { 'need' => $name };
return bless $self, $class;
}
sub _hasConstraint { 1 }; # per default ist alles nur bedingt möglich
sub test {
my ($self, $target, $doneHashList) = @_;
if ($self->_hasConstraint($target)) {
return $self->_test($target, $doneHashList);
}
return 1;
};

package A::Cond;
use strict;
use warnings;
use base qw/A/;
sub new {
my ($class, $pre, $target) = @_;
my $self = {'target' => $target, 'need' => $pre };
return bless $self, $class;
}
sub _hasConstraint { # nur $target ist bedingt möglich, der Rest immer
my ($self, $what) = @_;
return $self->{'target'} eq $what;
}

package A::Inher1;
use strict;
use warnings;
use base qw/A/;
sub _test {
my ($self, $target, $doneHashList) = @_;
for my $doneHash (@$doneHashList) {
return 1 if(exists($doneHash->{$self->{'need'}}));
}
return 0;
}
package A::Cond::Inher1;
use strict;
use warnings;
use base qw/A::Cond A::Inher1/;

package main;
use strict;
use warnings;
my $obj1 = A::Cond::Inher1->new('a', 'b'); # obj1: nur b braucht a
my $obj2 = A::Inher1->new('a'); # obj2: alle brauchen a
my @known = ( {qw/c c d d e e/}, {qw/b b c c/ });

print "Treffer 1\n" if $obj1->test('b', \@known); # a nicht da
print "Treffer 2\n" if $obj1->test('c', \@known); # c ist nicht b
print "Treffer 3\n" if $obj2->test('b', \@known); # a nicht da
print "Treffer 4\n" if $obj2->test('c', \@known); # a nicht da