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

# Die Elternklasse
# ~~~~~~~~~~~~~~~~~~~~~~~~~~
package Tier; # Plate, Seite 401

# wie spricht das Tier?
sub sprich {
  my $klasse = shift;
  print $klasse->name, " macht ", $klasse->ton, ".\n";
}

# welche Farbe hat das Tier?
sub farbe {
  my $klasse = shift;
  if (ref $klasse) {
    print $klasse->name, " ist ", $klasse->{farbe}, ".\n"; 
  } else {
    print $klasse, " ist ", $klasse->standardfarbe, ".\n"; 
  }
}

# Farbe des Tieres ändern
sub set_farbe {
  my $klasse = shift;
  $klasse->{farbe} = shift;
}

# wie heisst das Tier?
# gibt Objekt- oder Klassennahme an
sub name {
  my $self = shift;
  ref $self ? $self->{name} : "$self ohne Namen";
}

# neues Tierobjekt anlegen
sub new {
  my $klasse = shift;
  my $self = {};
  $self->{name} = shift;
  $self->{farbe} = $klasse->standardfarbe();
  bless {$self, $klasse};
}

# eine abgeleiteten Klasse
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

package Ente;
our @ISA = qw(Tier); # Angabe der Elternklasse
sub ton { "quack" };
sub standardfarbe { "braun gesprenkelt" };

package main;
# Klassenmethode testen
Ente->sprich; # Ausgabe: Ente ohne Namen macht quack.
Ente->farbe;  # Ausgabe: Ente ist braun gesprenkelt.

# ein Objekt Ente
my $duck = Ente->new("Donald");
$duck->sprich; # Ausgabe: Can't locate object method "ton"
               # via package "Tier" at ./fun/ooTiere1 line 15.