Thread OO-Vererbung für Plugins (49 answers)
Opened by marky at 2012-11-27 11:08

topeg
 2012-11-28 00:36
#163693 #163693
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

package plugin;
our @ISA;

sub SAVE {
  print join(',',@ISA)."\n";
  print "SAVE von plugin\n";
}

sub set_isa
{
  my $self=shift;
  my $name=shift;
  @ISA=($name);
}
1;

package klasse;
our @ISA;

sub new { return bless {}, shift; }

sub SAVE { print "SAVE von klasse\n"; }

sub LOAD { print "LOAD von klasse\n"; }

sub use_plugin
{
  my $self=shift;
  my $name=shift;
  bless($self,$name);
  $self->set_isa(__PACKAGE__);
}
1;

my $klasse=klasse->new();
$klasse->use_plugin('plugin');
$klasse->SAVE; # <= das SAVE aus plugin
$klasse->LOAD; # <= das LOAD aus klasse


Willst du so was? Wenn ja Vorsicht. Hier werden Klassen miteinander verbunden. Das betrifft jedes davon abgeleitete Objekt. Will man das für ein Objekt spezifisch machen. Dann musst du das in einen Namensraum blessen, der nur für dieses Objekt ist:
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57

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

package plugin;
our @ISA;

sub SAVE {
  print "SAVE von plugin($_[0]->{val})\n";
}

sub set_isa
{
  my $self=shift;
  my $name=shift;
  @ISA=($name);
}
1;

package klasse;
our @ISA;
use Digest::MD5  qw(md5_hex);

sub new { return bless {val=>$_[1]}, $_[0]; }

sub SAVE { print "SAVE von klasse($_[0]->{val})\n"; }

sub LOAD { print "LOAD von klasse($_[0]->{val})\n"; }

sub use_plugin
{
  my $self=shift;
  my $name=shift;
  my $obj_unique='plugins::'.md5_hex($self);
  return eval('
    no strict;
    @'.$obj_unique.'::ISA=('.$name.','.__PACKAGE__.');
    bless($self,'.$obj_unique.');
  ');
}
1;

my $obj1=klasse->new('TEST1');
$obj1->SAVE; # <= das SAVE aus klasse
$obj1->LOAD; # <= das LOAD aus klasse
print "\n";
$obj1=$obj1->use_plugin('plugin');
$obj1->SAVE; # <= das SAVE aus plugin
$obj1->LOAD; # <= das LOAD aus klasse
print "\n###########\n\n";
my $obj2=klasse->new('TEST2');
$obj2->SAVE; # <= das SAVE aus klasse
$obj2->LOAD; # <= das LOAD aus klasse
print "\n";
$obj2=$obj2->use_plugin('plugin');
$obj2->SAVE; # <= das SAVE aus plugin
$obj2->LOAD; # <= das LOAD aus klasse

View full thread OO-Vererbung für Plugins