1
2
3
4
5
6
7
8
9
if ( Modul2 ) {
use Modul2 ;
$o= new Modul2;
} else {
use Modul1 ;
$o= new Modul1;
}
$o->SAVE() ;
1 2 3 4 5 6 7 8 9
# Module laden use Module1; # optional bei "use Module2", da dieses ebenfalls Module1 laden sollte use Module2; # optional wenn nur Module1 genutzt werden soll # Objekt anlegen my $obj = new Module1; # bei Bedarf auf "new Module2 ändern # Objekt nutzen $obj->SAVE();
Quote.. alleine wenn man die APIs denkt, die gibt es nur noch mit PHP ..
QuoteAndererseits bin ich mir sicher, dass byte-orientierten Datenstrukturen die Zukunft gehört
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
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
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
#!/usr/bin/perl use strict; use warnings; ################################################################### 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 Digest::MD5 qw(md5_hex); my %used; 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}++; $self=eval(' no strict; @'.$obj_unique.'::ISA=('.$class.'); $self->{ISA}=\@'.$obj_unique.'::ISA; return bless($self,'.$obj_unique.'); '); return $self; } sub SAVE { print "SAVE von klasse($_[0]->{val})\n"; } sub LOAD { print "LOAD von klasse($_[0]->{val})\n"; } sub CONVERT { print "CONVERT von klasse($_[0]->{val})\n"; } sub add_plugins { my $self=shift; for(@_) { unshift(@{$self->{ISA}},$_) if($_); } } 1; ################################################################### ################################################################### ################################################################### package main; my $klasse=klasse->new('TEST1'); $klasse->add_plugins('plugin::A','plugin::C'); $klasse->SAVE; $klasse->LOAD; $klasse->CONVERT; print "\n###########\n\n"; my $klasse2=klasse->new('TEST2'); $klasse2->add_plugins('plugin::B','plugin::C'); $klasse2->SAVE; $klasse2->LOAD; $klasse2->CONVERT;
2012-11-29T10:08:42 markywie 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.
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 ); }
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 markyPS: 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.
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
#!/usr/bin/perl
use Modern::Perl;
###################################################################
package plugin::A;
use Moose::Role;
sub SAVE { print "SAVE von plugin::A($_[0]->{val})\n"; }
1;
###################################################################
package plugin::B;
use Moose::Role;
sub LOAD { print "LOAD von plugin::B($_[0]->{val})\n"; }
1;
###################################################################
package plugin::C;
use Moose::Role;
sub CONVERT { print "CONVERT von plugin::C($_[0]->{val})\n"; }
1;
###################################################################
package klasse;
use Moose;
use Moose::Util qw( apply_all_roles );
has 'val' => (is => 'rw', isa => 'Str');
sub SAVE { print "SAVE von klasse($_[0]->{val})\n"; }
sub LOAD { print "LOAD von klasse($_[0]->{val})\n"; }
sub CONVERT { print "CONVERT von klasse($_[0]->{val})\n"; }
sub add_plugins
{
my $self=shift;
apply_all_roles($self, $_) for @_;
}
1;
###################################################################
###################################################################
###################################################################
package main;
my $klasse=klasse->new(val => 'TEST1');
$klasse->add_plugins('plugin::A','plugin::C');
$klasse->SAVE;
$klasse->LOAD;
$klasse->CONVERT;
print "\n###########\n\n";
my $klasse2=klasse->new(val => 'TEST2');
$klasse2->add_plugins('plugin::B','plugin::C');
$klasse2->SAVE;
$klasse2->LOAD;
$klasse2->CONVERT;
2012-12-03T11:21:23 GwenDragonMod: Ich bitte darum wieder zurück zum Thema OO-Vererbung für Plugins zu kommen.