[Dresden-pm] Objektorientierung unter Perl

[Torsten Knorr]

On Thu, 19 Feb 2009, at 17:04:09, Thomas Rittsche <thomas.rittsche at gmail.com> wrote:

>Hallo Mongers,
>hatten heute einen Dozenten hier, der uns in Sachen Objektorientiertes
>Perl fit machen sollte. Leider ist der schon an einem der ersten
>Beispiele gescheitert. Die Aufgabe war, eine Klasse "Auto" anzulegen,
>die von einer Klasse "Motor" erbt bzw. abgeleitet ist. Irgendwie ist
>da wohl was schief gegangen, am Ende war die Verwirrung perfekt,
>keiner wusste mehr, wann wo und warum zu blessen ist... ;)
>

 Vielleicht können wir dieses schöne Thema noch etwas fortführen?
 Hier mal ein bissel Code.

#------------------------------------------------
#/usr/bin/perl -w
#*** file: vehicle.pl ***#
#-------------------------------------------------
 use strict;
 use Car 0.01;
#-------------------------------------------------
 my $car = Car->new(
 	color		=> 'green',
 	size		=> 'big',
 	speed		=> 200,
 	running		=> 0,
 	oillevel		=> 'ok',
 	type		=> 'TDI'
 	);
 $car->Start();
 print("$_ : $car->{$_}\n") for(keys(%$car));
#-------------------------------------------------
#*** file: Car.pm ***#
#-------------------------------------------------
 package Car;
 use Motor 0.01;
 @Car::ISA = qw(Motor);
 $Car::VERSION = '0.01';
#-------------------------------------------------
 sub new
 	{
 	my ($class, %args) = @_;
 	my $self = $class->SUPER::new(%args);
 	$self->{_ . $_} = $_ for(keys(%args));
 	return $self;
 	}
#-------------------------------------------------
 sub DESTROY
 	{
 	my ($self) = @_;
 	return if($self->{DESTROY}{__PACKAGE__}++);
 	print("Car::DESTROY called\n");
 	$self->Motor::DESTROY();
 	}
#-------------------------------------------------
 1;
#-------------------------------------------------
#*** file: Motor.pm ***#
 package Motor;
 $Motor::VERSION = '0.01';
#-------------------------------------------------
 sub new
 	{
 	my ($class, %args) = @_;
 	bless(
 		{
 _running => defined($args{running}) ? delete($args{running}) : 'status unknown' ,
 _oillevel => defined($args{oillevel}) ? delete($args{oillevel}) : 'oillevel unknown',
 _type => defined($args{type}) ? delete($args{type}) : 'type unknown'
 		}
 		, ref($class) || $class
 		);
 	}
#-------------------------------------------------
 sub Status
 	{
 	my ($self, %args) = @_;
 	if(defined($args{running}))
 		{
 		$self->{_running} = $args{running};
 		}
 	return $self->{_running};
 	}
#-------------------------------------------------
 sub Start
 	{
 	my ($self) = @_;
 	$self->{_running} = 1;
 	print("Gestartet\n");
 	}
#-------------------------------------------------
 sub DESTROY
 	{
 	my ($self) = @_;
 	print("Motor::DESTROY called\n");
 	}
#-------------------------------------------------
 1;
#-------------------------------------------------

 G. Torsten