Objektorientierung und Tests

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

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

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";

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

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";

(3, 6) nach 2 Schritten

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");

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