Thread Can't locate object method (6 answers)
Opened by hugenyn at 2011-06-25 22:06

topeg
 2011-06-26 01:05
#149962 #149962
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
So würde ich es Anfangen
ich benutze zusätzlich zwei weitere Module
- CPAN:Scalar::Util aus dem ich blessed nutze um festzustellen ob es sich um ein Objekt handelt
und
- CPAN:base welches den Elternnamen nicht nur in @ISA einfügt sondern auch das Paket lädt, wenn nötig.
Code (perl): (dl )
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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125

#!/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;

View full thread Can't locate object method