Okay, hier mal ein Beispiel für die Möglichkeiten, die wir mit Perl6 und Roles bzw. Moose und Roles bekommen. Roles erlauben uns Methoden an Klassen zu binden, die bestimmte Voraussetzungen erfüllen. Man könnte Vergleichbares durch Mehrfachvererbung erreichen, aber Roles sind eleganter, da sie völlig unterschiedliche Klassen um eine bestimmte Funktionalität erweitern.
Hier ein Beispiel für eine Role:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
#!/usr/bin/perl
use strict;
use warnings;
package RoleDigraph;
use Moose::Role;
requires '_as_queque';
sub as_digraph {
my $self = shift;
my @queque = @{$self->_as_queque};
my $o = 'digraph G {' . "\n";
$o .= "\t" . $_->[0] . ' -> ' . $_->[1] . ";\n" for @queque;
$o .= "}\n";
return $o;
}
1;
Wie man sieht haben wir nur eine Methode, keine Instanzvariablen etc. Die Role benötigt eine Methode
_as_queque() die von der Klasse angeboten werden muss, die die Role einbinden will. Diese Klasse wird dann um die Methode
as_digraph() erweitert, die aus einer Liste von Tupeln (als Queque bezeichnet) einen Digraph erzeugt, wie er mit
http://www.graphviz.org/ dot visualisiert werden kann.
Hier jetzt zwei Beispiele in denen die Role in die Klasse eingebunden wird, um deren Funktionalität zu erweitern. Das Baum-Beispiel (aus einem relativ aktuellen Thread im Forum) ist nur bedingt geeignet, weil der Baum als Graph nur teilweise richtig visualisiert werden kann:
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
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
package BinTree;
use Moose;
with 'RoleDigraph';
use overload '""' => \&to_s;
has 'val' => ( is => 'rw', isa => 'Num' );
has 'l' => ( is => 'rw');
has 'r' => ( is => 'rw');
sub _set_l {
my $self = shift;
my $val = shift;
if (blessed $self->l) { $self->l->append($val); }
else { $self->l($self->new(val => $val)); }
}
sub _set_r {
my $self = shift;
my $val = shift;
if (blessed $self->r) { $self->r->append($val); }
else { $self->r($self->new(val => $val)); }
}
sub to_s {
my $self = shift;
my $v = $self->val;
my $l = blessed $self->l ? $self->l->to_s : undef;
my $r = blessed $self->r ? $self->r->to_s : undef;
return join ', ', grep defined, ($l, $v, $r);
}
sub append {
my $self = shift;
my @vals = @_;
while ( my $n = shift @vals ) {
if ($n < $self->val) { $self->_set_l($n) }
elsif ($n > $self->val) { $self->_set_r($n) }
}
}
sub _as_queque {
my $self = shift;
my $queque = shift || [];
my $v = $self->val;
if (blessed $self->l) {
push @$queque, [$v, $self->l->val];
$self->l->_as_queque($queque);
}
if (blessed $self->r) {
push @$queque, [$v, $self->r->val];
$self->r->_as_queque($queque);
}
return $queque,
}
package main;
my @list = (20, 4, 28, 9, 100, 12, 84, 10, 11);
my $tree = BinTree->new( val => shift @list );
$tree->append(@list);
$tree->append(1, 50, 200);
print $tree . "\n" x 2;
print $tree->as_digraph;
http://www.ronnie-neumann.de/trashbin/tree.png
In dem zweiten Beispiel wird ein einfaches Soziogramm aus einem Logfile erstellt:
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
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
package Event;
use Moose;
has 'source' => ( is => 'rw', isa => 'Str' );
has 'destination' => ( is => 'rw', isa => 'Str' );
has 'id' => ( is => 'rw', isa => 'Num' );
package LogAnalyzer;
use Moose;
with 'RoleDigraph';
has 'events' => ( is => 'rw', isa => 'ArrayRef' );
sub parse_line {
my $self = shift;
my $line = shift;
chomp($line);
my ($s) = $line =~ m/source:(\w+)\s*/; # we ignore the domains
my ($d) = $line =~ m/destination:(\w+)\s*/;
my ($id) = $line =~ m/id:(\w+)\s*/;
my $event = Event->new(
source => $s,
destination => $d,
id => $id
);
push @{$self->{events}}, $event;
}
sub _as_queque {
my $self = shift;
my $queque = [];
@$queque = map { [$_->source, $_->destination] } @{$self->events};
return $queque;
}
package main;
my $al = LogAnalyzer->new;
$al->parse_line($_) while (<DATA>);
print $al->as_digraph;
__DATA__
source:joe@example.com destination:bob@example.com id:685421
source:bob@example.com destination:tim@example.com id:685424
source:joe@example.com destination:tina@example.com id:685429
source:tim@example.com destination:bob@example.com id:685431
source:tina@example.com destination:bob@example.com id:685441
source:joe@example.com destination:bob@example.com id:685452
http://www.ronnie-neumann.de/trashbin/sozio.png
Wie man sieht, werden beide Klassen elegant um ein und dieselbe Methode erweitert, auch wenn es völlig unterschiedliche Klassen und Anwendungen sind.\n\n
<!--EDIT|Ronnie|1177172450-->
Jemand zu Hause?![[twitter]](/battie/theme/default/icons/twitter.gif){kind=icon}
![[default_avatar]](/battie/theme/default/default_avatar.gif){kind=avatar}
![[Homepage]](/battie/theme/default/homepage.gif)
Wie frage ich & perlintro 
Schrift
Blog
Einstellungen![[feed]](/battie/theme/default/icons/feed.png){kind=icon}
![[Powered by Battie]](/battie/img/powered.png)
