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

topeg
 2012-11-29 14:00
#163740 #163740
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
2012-11-29T10:08:42 marky
wie ist das Performancemässig zu betrachten. Wenn man direkt vererben würde, würde der Hacken über die virt. Klasse fehlen. Aber irgendwie gefällt mir das :-) wobei ich lieber eine Lösung ohne eval hätte, wenn das möglich ist.

Ja es geht ohne eval. Die Schreibweise macht den Unterschied:
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14

sub new {
  my $class=shift;
  my $val=shift;

  my $self={ val  => $val };

  my $obj_unique=$class.'::INSIDE';
  $obj_unique.=chr(int(rand(26)+65)) while($used{$obj_unique});
  $used{$obj_unique}++;
  no strict;
  @{$obj_unique.'::'.ISA}=($class);
  $self->{ISA}=\@{$obj_unique.'::'.ISA};
  return bless($self, $obj_unique );
}


Nach ein wenig Grübeln ist mir eine andere Möglichkeit mit "attributes" eingefallen. Der Vorteil hierbei ist, dass man festlegen kann welche Methoden von den Plugins überschrieben werden dürfen. Das macht das einfügen der Plugins robuster. Das ist natürlich für jeden Aufruf langsamer, da die Prüfung welche Methode benutzt werden soll zur Laufzeit mit Perl geschieht.

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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124

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

########################################################################
package can_plugin;
use attributes;

BEGIN
{
  my %found;

  sub MODIFY_CODE_ATTRIBUTES
  {
    my  $pkg = shift;
    my  $ref = shift;
    next unless grep{ /^PLUGIN_OVERWRITE$/ }@_;
    $found{$pkg}{$ref}++;
    return;
  }

  sub __INIT__
  {
    for my $pkg (keys(%found))
    {
      no strict 'refs';
      while(my ( $name , $symbol ) = each %{ $pkg . '::' })
      {
        no warnings 'once';
        my  $ref  = *{ $symbol }{ CODE } or next;
        next unless($found{$pkg}{$ref});
        no warnings 'redefine';
        *{ $pkg . '::' . $name } = sub {
          {
            my $fname=$name;
            my $self=$_[0];
            for my $plugin (@{$self->{__PLUGIN__ISA}})
            {
              if( $plugin->can($fname) )
              { goto &{$plugin . '::' . $fname}; }
            }
          }
          goto $ref;
        } # sub end
      }
    }
  }
}

INIT{ __PACKAGE__->__INIT__(); }

sub add_plugins
{
  my $self=shift;
  for(@_)
  { unshift(@{$self->{__PLUGIN__ISA}},$_) if($_); }
}

1;
########################################################################

###################################################################
package plugin::A;

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

1;

###################################################################
package plugin::B;

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

1;

###################################################################
package plugin::C;

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

1;

###################################################################
package klasse;
use base 'can_plugin';

sub new
{
  my $class=shift;
  my $val=shift;

  my $self={ val  => $val };
  return bless($self,$class);
}

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

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

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

1;

###################################################################
###################################################################
###################################################################
package main;

my $k1=klasse->new('A');
$k1->add_plugins(qw ( plugin::B plugin::C ));

$k1->LOAD();
$k1->SAVE();
$k1->CONVERT();

my $k2=klasse->new('B');
$k2->add_plugins(qw ( plugin::A plugin::C ));

$k2->LOAD();
$k2->SAVE();
$k2->CONVERT();


2012-11-29T10:08:42 marky
PS: Wäre es ggf. möglich dass wir ein offiziellen bezahltes Verhältnis treten, wir könnten sicher noch einen Berater brauchen, der eine externe Sicht auf die Dinge hat.

Sicher ist das Möglich. Ich habe dir eine PM geschickt.


EDIT: Tippfeher im Code;
Last edited: 2012-11-29 14:03:47 +0100 (CET)

View full thread OO-Vererbung für Plugins