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

# Die Elternklasse
# ~~~~~~~~~~~~~~~~~~~~~~~~~~
package Tier;
use Scalar::Util qw(blessed);
# blessed prüft,
# ob es sich um ein Objekt handelt
# und nicht nur um eine Refenz.

# wie spricht das Tier?
sub sprich
{
  my $self = shift;
  # 'can' prüft ob ein Objekt/Klasse eine Methode hat
  # das ist nötig, falls einer auf die Idee kommen sollte
  # 'Tier' direkt zu nutzen
  if($self->can('ton'))
  {
    print $self->name()." macht ".$self->ton().".\n";
  }
  else
  {
    print $self->name()." ist tonlos!\n";
  }
}

# welche Farbe hat das Tier?
sub farbe
{
  my $self = shift;

  my $farbe=undef;
  $farbe=$self->{farbe} if (blessed($self) && $self->{farbe});
  $farbe=$self->standardfarbe() if(!$farbe && $self->can('standardfarbe'));

  if($farbe)
  {
    print $self->name()." ist $farbe.\n";
  }
  else
  {
    print $self->name()." hat keine Farbe!\n";
  }
}

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

# wie heisst das Tier?
# gibt Objekt- oder Klassennahme an
sub name
{
  my $self = shift;
  return $self->{name} if(blessed($self) && $self->{name});

  # Klassennamen ermitteln wenn nötig
  $self=blessed($self) if(blessed($self));

  return "$self ohne Namen";
}

# neues Tierobjekt anlegen
sub new
{
  my $class = shift;
  $class=blessed($class) if(blessed($class));

  my $self = {};
  $self->{name} = shift;
  $self->{farbe} = undef;
  bless( $self, $class );
}


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

package Ente;
use base 'Tier';
# Angabe der Elternklasse.
# 'use base ...' lädt die angebenen Klassen automatisch wenn nötig

sub ton { return "quack"; }
sub standardfarbe { return "braun gesprenkelt"; }


#######################################################
#######################################################

package main;
# Eltern Klasse testen:
Tier->sprich; # Ausgabe: Tier ohne Namen ist tonlos.
Tier->farbe;  # Ausgabe: Tier ohne Namen hat keine Farbe.
print "#"x30,"\n";

# ein Objekt Tier
my $etwas=Tier->new('wolpertinger');
$etwas->sprich;

# ein Objekt Tier
my $nichts=Tier->new();
$nichts->sprich;

print "#"x30,"\n";

# Klassenmethode testen
Ente->sprich; # Ausgabe: Ente ohne Namen macht quack.
Ente->farbe;  # Ausgabe: Ente ist braun gesprenkelt.
print "#"x30,"\n";

# ein Objekt Ente
my $duck = Ente->new("Donald");
$duck->sprich;

# ein Objekt Ente
my $ente = Ente->new();
$ente->sprich;