EMZETT.
Login

Emzett Wiki

Perl: Objektorientierung und Tests

Properties1
tagsprogrammiersprachen, perl

5 Min. Lesezeit

Kurz: In Perl ist eine Klasse ein Paket, ein Objekt eine gesegnete (bless) Referenz, eine Methode eine Subroutine, die das Objekt als erstes Argument bekommt:

Teil des Kurses Perl

Kapitel 10 von 11 im Kurs Perl (Abschnitt „Fortgeschritten“). Mit Fortschritt, Quiz und Zertifikat auf der Lernseite.

Klassen in Perl

In Perl ist eine Klasse ein Paket, ein Objekt eine gesegnete (bless) Referenz, eine Methode eine Subroutine, die das Objekt als erstes Argument bekommt:

use strict; use warnings;
 
package Tier;
sub new {
    my ($klasse, %args) = @_;
    my $self = bless { name => $args{name} // "unbekannt", laute => 0 }, $klasse;
    return $self;
}
sub name  { $_[0]{name} }
sub laut  { "..." }
sub vorstellen {
    my $self = shift;
    return sprintf("%s (%s) sagt %s", $self->name, ref($self), $self->laut);
}
 
package Hund;
our @ISA = ('Tier');               # Vererbung
sub laut { "Wuff" }
sub apportiere { my ($self, $was) = @_; return $self->name . " holt $was" }
 
package Katze;
use parent -norequire, 'Tier';      # moderner: use parent
sub new {
    my ($klasse, %args) = @_;
    my $self = Tier::new($klasse, %args);
    $self->{leben} = $args{leben} // 9;
    return $self;
}
sub laut { "Miau" }
sub vorstellen {
    my $self = shift;
    return $self->SUPER::vorstellen() . " und hat $self->{leben} Leben";
}
 
package main;
my @tiere = (Hund->new(name => "Rex"), Katze->new(name => "Mimi"));
print $_->vorstellen, "\n" for @tiere;
print $tiere[0]->apportiere("Stock"), "\n";
print $tiere[1]->isa('Tier') ? "Katze ist ein Tier\n" : "";
print Hund->can('apportiere') ? "Hund kann apportieren\n" : "";
print Katze->can('apportiere') ? "" : "Katze kann nicht apportieren\n";
my $methode = "laut";
print $tiere[0]->$methode, "\n";       # dynamischer Methodenaufruf

Ausgabe:

Rex (Hund) sagt Wuff
Mimi (Katze) sagt Miau und hat 9 Leben
Rex holt Stock
Katze ist ein Tier
Hund kann apportieren
Katze kann nicht apportieren
Wuff

Perl verbirgt nichts: Das Objekt ist ein Hash, Eigenschaften stehen in $self->{...}. Kapselung ist Konvention (Felder mit _ als privat).

Accessoren, Destruktor, Overload

use strict; use warnings;
 
package Konto;
use overload
    '""'  => \&als_text,
    '+'   => \&plus,
    '=='  => sub { $_[0]->stand == $_[1]->stand },
    '<=>' => sub { my ($a, $b, $swap) = @_; ($swap ? -1 : 1) * ($a->stand <=> (ref $b ? $b->stand : $b)) };
 
my $anzahl = 0;
sub new { my ($c, $inhaber, $stand) = @_; $anzahl++; bless { inhaber => $inhaber, stand => $stand // 0 }, $c }
sub stand { $_[0]{stand} }
sub inhaber { $_[0]{inhaber} }
sub einzahlen { my ($s, $b) = @_; die "Betrag muss positiv sein\n" if $b <= 0; $s->{stand} += $b; $s }
sub als_text { sprintf("%s: %.2f", $_[0]->inhaber, $_[0]->stand) }
sub plus { Konto->new($_[0]->inhaber, $_[0]->stand + (ref $_[1] ? $_[1]->stand : $_[1])) }
sub anzahl { $anzahl }
sub DESTROY { }
 
package main;
my $k = Konto->new("Mia", 100);
$k->einzahlen(50)->einzahlen(25);
print "$k\n";
my $summe = $k + 25;
print "$summe\n";
print "gleich\n" if $k == Konto->new("Tom", 175);
print "größer\n" if $k > Konto->new("X", 5);
eval { $k->einzahlen(-1) };
print "Fehler: $@";
print "Konten: ", Konto->anzahl, "\n";

Ausgabe:

Mia: 175.00
Mia: 200.00
gleich
größer
Fehler: Betrag muss positiv sein
Konten: 4

Moderne OOP: Moo und die Klasse-Syntax

In echten Projekten nutzt man Moo (oder Moose) für weniger Schreibarbeit. Ab Perl 5.38 gibt es zudem experimentell das Schlüsselwort class:

package Person;
use Moo;
use Types::Standard qw(Str Int);
 
has name  => (is => 'ro', isa => Str, required => 1);
has alter => (is => 'rw', isa => Int, default => 0);
has hobbys => (is => 'ro', default => sub { [] });
 
sub vorstellen { my $s = shift; sprintf("%s (%d)", $s->name, $s->alter) }
 
package Student;
use Moo;
extends 'Person';
has uni => (is => 'ro');
around vorstellen => sub { my ($orig, $self) = @_; $self->$orig() . " @ " . $self->uni };
use v5.38;
use experimental 'class';
 
class Punkt {
    field $x :param = 0;
    field $y :param = 0;
    field @verlauf;
 
    method verschiebe($dx, $dy) { push @verlauf, [$x, $y]; $x += $dx; $y += $dy; return $self }
    method position { "($x, $y)" }
    method schritte { scalar @verlauf }
}
my $p = Punkt->new(x => 1, y => 2);
$p->verschiebe(3, 4)->verschiebe(-1, 0);
say $p->position, " nach ", $p->schritte, " Schritten";

Ausgabe:

(3, 6) nach 2 Schritten

Tests mit Test::More

Perl hat eine lange Testkultur (TAP-Format). Tests liegen in t/*.t und laufen mit prove:

use strict; use warnings;
use Test::More tests => 7;
 
sub addiere { $_[0] + $_[1] }
 
is(addiere(2, 3), 5, "Addition");
isnt(addiere(1, 1), 3, "Ungleich");
ok(addiere(0, 0) == 0, "Null");
like("Hallo Welt", qr/Welt/, "Regex passt");
is_deeply([1, { a => 2 }], [1, { a => 2 }], "Struktur gleich");
can_ok("Test::More", "is");
eval { die "kaputt\n" };
is($@, "kaputt\n", "Fehler gefangen");

Ausgabe:

1..7
ok 1 - Addition
ok 2 - Ungleich
ok 3 - Null
ok 4 - Regex passt
ok 5 - Struktur gleich
ok 6 - Test::More->can('is')
ok 7 - Fehler gefangen

Jede Zeile beginnt mit ok oder not ok. Das Programm prove -v t/ fasst die Ergebnisse zusammen.

Merke

  • Klasse = Paket, Objekt = bless-te Referenz, Methode = Sub mit $self
  • Vererbung: use parent, @ISA, SUPER::
  • use overload definiert Operatoren; can, isa, ref für Introspektion
  • Moo/Moose für komfortable OOP; Perl 5.38 bringt class
  • Test::More mit ok, is, like, is_deeply; prove führt Tests aus

Übungsaufgabe

Schreibe eine Klasse Stapel mit push, pop, groesse und teste sie mit Test::More.

Quiz zur Selbstkontrolle

Weiter im Kurs

Zurück: Module, CPAN und Pakete

Weiter: Referenz und Spickzettel

Alle Kapitel: Perl im Überblick

Graphansicht

Backlinks