Code Comments
Programming Forum and web based access to our favorite programming groups.
Well, I've receive a couple more questions, (and one typo correction)
about my little rant, so let me expound some more on Good Class
Design.
By the way, there are several great inheritable base classes in CPAN,
and there is a good chance you should be using one of them in
production code. By curious circumstances, I happened to develop the
base class that *I* use while I was in the African Jungle without
internet access, so CPAN wasn't an option. I *HAD* to roll my own.
However, designing a good base class is a highly educational
experience, and it does behoove the beginner to at least experiment
with one. Let's jump in.
ABOUT OBJECTS
========================================
================================
Start by thinking about your objects, not from the point of view of
implementation, but from the point of view of the class users.
Imagine a "Fruit" object.
What can we say about a piece of fruit?
It has a color, a texture, and a name. These nouns are attributes of
the fruit.
* name
* color
* texture
* age
What kinds of things can a fruit *do*? These become its methods:
* mature
* peel
And finally, what are some adjectives that can be queried against a
fruit (some boolean methods):
* edible
* rotten
* ripe
At first glance, ripe and edible might seem to be synonyms (and in
the base Fruit class, we may choose to implement them with the same
method.) But in some derived class (Banana) we have to peel the
ripe fruit before it becomes edible; Similarly the Rhubarb must be
cooked to destroy a toxin before you can eat it.
Note that in Perl, *any* scalar value can be used in a boolean
context, but there is a subtle semantic difference - notice that my
three booleans are named after adjectives, while the attributes are
named after verbs.[2]
Okay, enough talk about fruit. Down to implementation.
Herein is a perfectly usable (although absolutely minimal) base-class:
........................................................................
Begin Object.pm
........................................................................
package Object;
use strict;
use warnings;
use Data::Dumper;
sub new {
my $ref = shift;
my $class = ref($ref) || $ref;
my $self = bless({}, $class);
while ( my ($method, $value) = splice(@_, 0, 2 )) {
$self->$method($value);
}
return $self;
}
sub _axom { # access or mutate
my $self = shift;
my $attribute = shift;
my $value = $self->{$attribute};
if (@_) {
$self->{$attribute} = shift;
}
return $value;
}
sub debug {
return Dumper shift;
}
1;
........................................................................
End Object.pm
........................................................................
This is a class that provides only two public methods, and one private
one.
The private method _axom() is a convenience method to save programmers
a lot of typing when building accessor-mutator function in their
derived classes. It only handles simple scalar data, but it would be
easy to write[1] similar methods for accessing/mutating lists or hashes
(storing them inside the object as arrayrefs and hashrefs, that
provides a complete public interface allowing me to say something
like:
# put three toppings on my delicious sundae
$sundae->toppings ( 'chocolate',
'pineapple',
'strawberry' );
There is a public constructor (new()) that uses a pretty common idiom
to allow me to call several methods at construction time. So I could
say:
my $car = new Automobile ( make => 'Ford',
model => 'Escort',
year => 1984 );
Where make(), model(), and year() were all methods of Automobile.
The new() constructor can either be called as a class method
Derived_class->new();
or as an instance method
$some_object->new(); # create a new object of the same type.
You might wish to expand the instance method to be a "clone"
operator.
Finally, a little debug() method for object inspection.
Okay. We have a base Object class. Now, we will write our first
customer of that class, the "Fruit" class.
........................................................................
Begin Fruit.pm
........................................................................
package Fruit;
use base 'Object';
# public attributes
=pod
=head1 ATTRIBUTES
All attributes have a common interface. You can query the current state of
an attribute or set it to a new value.
my $name = $fruit->name; # get current name of this fruit
my $old_name = $fruit->name('kumquat'); # change name, returning old value
=over 4
=item name
Default is 'fruit'.
=item color
Default is 'green'.
=item texture
Default is 'soft'.
=item age
The age of the fruit in arbitrary time units. A fruit is assumed to require
60 of these to reach maturity
and after 180 will become rotten.
=back
=cut
sub name { return shift->_axom('name', @_); }
sub color { return shift->_axom('color', @_); }
sub texture { return shift->_axom('texture', @_); }
sub age { return shift->_axom('age', @_); }
# private attributes (These don't get POD documentation -- 'cuz they're pri
vate )
# _peeled defaults to zero, gets set if the fruit has been stripped of its p
eel.
sub _peeled { return shift->_axom('_peeled', @_); }
sub new {
return shift->SUPER::new( name => 'fruit',
color => 'green',
texture => 'soft',
age => 0,
_peeled => 0,
@_ );
}
=pod
=head1 INSTANCE METHODS
=over
=cut
=pod
=item $fruit->mature();
=item $fruit->mature(30);
Cause the fruit to grow one or more arbitrary-time-units older.
=cut
sub mature {
my $fruit = shift;
my $days = shift || 1;
# make the fruit one unit older
$fruit->age ( $fruit->age() + $days ) ;
return $fruit;
}
=pod
=item $fruit->peel();
Remove the skin from this fruit.
=cut
sub peel {
my $fruit = shift;
$fruit->_peeled(1);
return $fruit;
}
=pod
=back
=head1 BOOLEAN METHODS
=over
=item if ( $fruit->edible ) ...
Is this fruit ready to eat?
=cut
# in the base class, we assume all ripe fruit is ready to eat. This
# should be overridden in derived classes.
sub edible {
my $fruit = shift;
return $fruit->ripe && not($fruit->rotten);
}
=pod
=item if ($fruit->ripe ) ...
Has the fruit sufficiently ripened?
=cut
sub ripe {
my $fruit = shift;
return $fruit->age > 60;
}
=pod
=item if ($fruit->rotten ) ...
Has it become over-ripe?
=cut
sub rotten {
my $fruit = shift;
return $fruit->age > 180;
}
=pod
=back
=cut
1;
........................................................................
End Fruit.pm
........................................................................
There is a lot of code here - and it's got it's pod documentation with
it.
You can read through the POD for this (an online version will be at
http://hummer.cluon.com/~lawrence/fruit/ for y'all ).
First, we have a handful of public attributes that use the private
_axom() method
sub name { return shift->_axom('name', @_); }
sub color { return shift->_axom('color', @_); }
sub texture { return shift->_axom('texture', @_); }
sub age { return shift->_axom('age', @_); }
See- - hardly any typing at all.
This allows you to some day change the color() method from a static
attribute of the object to a complex method, without ever changing the
class users. (Perhaps we want to have the color subtly change as the
fruit grows older.)
There is also a private attribute "_peeled". This is coded exactly
like the public attributes, it is just not included in the POD, and
has that leading underscore that (to quote Tom) "...already conveys
strong feelings of magicalness to a C programmer"
Now, we get to the constructor.
sub new {
return shift->SUPER::new( name => 'fruit',
color => 'green',
texture => 'soft',
age => 0,
_peeled => 0,
@_ );
}
This calls the consstructor for the parent class (Object) passing in
some default values. Notice that because the default method/value
pairs occur BEFORE the passed-in @_ method/value pairs, they will be
overridden. Note also, that if your methods have side effects, they
will be called twice. Keep that in mind as an improvement to make to
the base-class if you use this in an environment where calling the
method multiple times would be a Bad Thing.
I'm not going to line-by-line describe all of the other methods; it is
all pretty straightforward Perl code, so just read it. Notice that
*NOWHERE* in the object do I use the insider knowledge that the class
is implemented as a hashref. Even in the accessor/mutator functions,
I delegate that detail to the parent class.
USING OUR FRUIT CLASS
========================================
================================
Okay... we have a Fruit and an Object. Let's write a little driver
program to do something with it.
........................................................................
Begin tryit
........................................................................
#!/usr/bin/perl
use strict;
use warnings;
use lib '/tmp'; # fix this to suit local custom
use Fruit;
my $fruit = Fruit->new( name => 'apple',
color => 'red',
texture => 'crunchy' ) ;
until ($fruit->edible) {
print "waiting a few days for it to get ripe...\n";
$fruit->mature(3);
}
print $fruit->debug;
........................................................................
End tryit
........................................................................
So, here is a trivial program that instantiates a Fruit (named Apple),
and spins in a loop waiting for it to grow older.
DERIVING FURTHER
........................................................................
Now, let's build on our generic Fruit class with a couple of derived
classes Apple and Banana.
........................................................................
Begin Apple.pm
........................................................................
package Apple;
use base 'Fruit';
sub new {
return shift->SUPER::new(name => 'apple',
color => 'red',
texture => 'crunchy',
@_);
}
1;
........................................................................
End Apple.pm
........................................................................
WOW!
That is short.
Basically, Apple inherits all of its behavior from Fruit, adding none
of its own, with the exception of giving sensible default values in
the constructor.
So, we can alter the little test driver
........................................................................
Begin tryit
........................................................................
#!/usr/bin/perl
use strict;
use warnings;
use lib '/tmp';
use Apple;
my $fruit = Apple->new;
until ($fruit->edible) {
print "waiting a few days for it to get ripe...\n";
$fruit->mature(3);
}
print $fruit->debug;
........................................................................
End tryit
........................................................................
Now, if you run this NEW version of tryit (the changes for those who
weren't paying careful attention: use Fruit became use Apple and
Fruit->new(...) (with lots of parameters) became Apple->new with no
parameters, because the defaults for an apple are already correct.
Run the new driver, and see that the output is very nearly the same.
Okay. A step further -- let's do our Banana.
Remember, the difference between a Banana, and the generic Fruit is:
A banana isn't edible until it's been peeled.
........................................................................
Begin Banana.pm
........................................................................
package Banana;
use base 'Fruit';
sub new {
return shift->SUPER::new(name => 'banana',
color => 'yellow',
texture => 'soft',
@_);
}
sub edible {
my $self = shift;
return $self->SUPER::edible &&
$self->_peeled;
}
1;
........................................................................
End Banana.pm
........................................................................
Differences between the Banana and the Apple. Defaults in the
constructor. And the new edible() method.
Note that we delegate PART of the edibility to the parent (Fruit)
class -- that is to say, a banana is edible when the Fruit is edible
AND the peel has been removed.
Now, if we plug Banana into tryit (I won't bore you with Yet Another
Copy here) you will see that it fails.
Ahhhh -- a subtle bug has been waiting in tryit since the beginning:
We are spinning waiting for the fruit to mature testing its
edibility. But we SHOULD be testing it's maturity.
Okay, edit your local copy of tryit to use "until ($fruit->ripe)"
Ah HAH ... now we can peel() our banana, and test its edibile() status
Add a couple of lines after the maturation loop:
$fruit->peel;
print "Eating a banana!\n" if $fruit->edible;
Rerun, and see the "eating a banana" method.[4]
SUMMARY
........................................................................
* Do not be afraid to build an object heirarchy of many relatively thin
layers[5]
* Be class-user centric.
* Design the interface to your class well -- a lousy implementation
can be fixed in minutes - a lousy interface will haunt you forever.
........................................................................
Footnotes:
[1]: This, along with create world peace is left as an exercise for
the reader.
[2]: One of the things that really loses with English is the fact that
there are many collisions between verb, noun, and adjective forms.
"age" can be a verb or a noun. "mature" can be a verb or an
adjective. This works a lot nicer in Spanish where madurar() is
always a verb and maduro() is always an adjective. [3]
[3] Well, of course not ALWAYS, but if we say "use the infinitive for
all verb forms", then we know that I'm not using the first-person
singular verb for mature, but the masculine adjective form. But this
is turning into a language lecture.
[4] While writing this, I made and ate a fruit salad.
[5] Dare I move from fruit to a pastry metaphor?
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
Lawrence Statton - lawrenabae@abaluon.abaom s/aba/c/g
Computer software consists of only two components: ones and
zeros, in roughly equal proportions. All that is required is to
sort them into the correct order.
Post Follow-up to this message>>>>> "Lawrence" == Lawrence Statton <lawrence@cluon.com> writes: Lawrence> my $class = ref($ref) || $ref; You say "good class design", but then you do this. Shame on you. See the last few paragraphs of <http://www.stonehenge.com/merlyn/UnixReview/col52.html> of why this is a REALLY REALLY bad idea. Lawrence> my $car = new Automobile ( make => 'Ford', Lawrence> model => 'Escort', Lawrence> year => 1984 ); Shame on you again, for using indirect object notation! Lawrence> sub mature { Lawrence> my $fruit = shift; Lawrence> my $days = shift || 1; Lawrence> # make the fruit one unit older Lawrence> $fruit->age ( $fruit->age() + $days ) ; Lawrence> return $fruit; Lawrence> } Lawrence> There is a lot of code here - and it's got it's pod documentation with Lawrence> it. Only a minor typo there. "... it's got its pod ...". Second form is a possessive, not a contraction. -- Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095 <merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/> Perl/Unix/security consulting, Technical writing, Comedy, etc. etc. See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training !
Post Follow-up to this message
Show a Printable Version
Email This Page to Someone!
Receive updates to this thread
Powered by vBulletin
Copyright 2000-2006 Jelsoft Enterprises Limited.