Target Audience: This series is pitched at developers interested in Object Oriented Design Patterns using the Moose framework in Perl. I cover the examples from the Head First Design Patterns book, replicating Java implementation in Moose. You need to obtain a copy of the book, which is not hard to come by.
[1.] Container
First, the one Package that serves as a container for the low-level API classes, so a simple 'use' declaration may suffice to import all of this functionality into an application.
package HouseholdDevices;
use Moose;
[2.] Class - Light
And God said, "Let there be light!" And there was light. Have a look.
It can be switched on and off - that's what you would expect, isn't it? But there's more! Notice the dimmer? An extra thrown in for that romantic rendezvous with your special someone. Just so you can impress her (or him) - at no extra cost! Made possible by type-constraints (Moose::Util::TypeConstraints) using 'subtype'.
And the get/set methods are separated for your convenience when embedding the Light in your own custom application. In case you want to.
package Light;
use Moose;
use Moose::Util::TypeConstraints;
subtype 'lightScale'
=> as Num
=> where {
($_ >= 0) && ($_ <= 100);
};
has 'level' => (
is => 'rw',
isa => 'lightScale',
reader => 'getLevel',
writer => 'setLevel',
default => 0,
);
sub on {
my $self = shift;
$self->setLevel(100);
print q{Light switched on.};
};
sub off {
my $self = shift;
$self->setLevel(0);
print q{Light switched off.};
};
sub dim {
my ($self, $level) = @_;
$self->setLevel($level);
print q{Light dimmed to }.$self->getLevel.q{%};
};
[3.] Class - Bang-Bang Light
So you want an on/off light for the garden. I have just the thing for you.
The subtype 'boolscale' is now boolean. A subtype is basically a custom type, but not a class in its own right. This comes in handy for validating the slots of a class. When it comes to validating the state of a class at construction time, where relationships among slot data come into play, use BUILD.
package BangBangLight;
use Moose;
use Moose::Util::TypeConstraints;
subtype 'boolScale'
=> as Num
=> where {
($_ == 0) || ($_ == 1);
};
has 'state' => (
is => 'rw',
isa => 'boolScale',
default => 0,
);
sub on {
my $self = shift;
$self->state(1);
print q{Bang-bang light switched on.};
};
sub off {
my $self = shift;
$self->state(0);
print q{Bang-bang light switched off.};
};
[4.] Class - Garden Light
The Garden Light is a Bang-Bang Light with a timer - so it comes on at dusk and turns itself off at dawn. As such, it is a special kind of Bang-Bang Light. Inheritance is indicated. The class comes complete with manual over-ride.
A word on Inheritance - extends. (One word, I said. See? If you don't get it, look in the code below.)
The method modifiers 'before' and 'after' are used to add behavior. Use of method modifiers is not exclusive to inheritance, mind you. They can be used with any bit of code wrapped in a sub. It is time for a reminder that a method modifier ('before', 'after') discards changes to the argument list with respect to the target method. Do not invoke the method modified in a method modifier or attempt to modify the argument list. The first has unhealthy consequences and the second has no effect other than increasing your carbon footprint by a wee bit. Also, the return value of a method modifier suffers the same fate as your ardent wooing - it is ignored.
However, 'around' behavior is different. There, you can (or indeed, should) invoke the target method and you can even modify the argument list. Or the return value. Or both.
Backing off from the heavy stuff now, note that the type-constraint is a regular expression.
package GardenLight;
use Moose;
use Moose::Util::TypeConstraints;
extends 'BangBangLight';
subtype 'lightTime'
=> as Str
=> where { /^\d+:\d\d\s+[PA]M$/i };
has 'duskTime' => (
is => 'rw',
isa => 'lightTime',
default => '8:30 PM',
);
has 'dawnTime' => (
is => 'rw',
isa => 'lightTime',
default => '6:30 AM',
);
before 'on', 'off' => sub {
print "Garden>";
};
after 'on', 'off' => sub {
print "< nedraG";
};
sub manualOn {
my $self = shift;
$self->on;
print q{Garden light auto on / off at }
. $self->duskTime . ' / ' . $self->dawnTime;
};
sub manualOff {
my $self = shift;
$self->off;
print q{Garden light auto on / off at }
. $self->duskTime . ' / ' . $self->dawnTime;
};
[5-6.] Class - Celing Fan, Hot Tub
The Ceiling Fan is a state machine. The Hot Tub is jet-age! (What with all the jets! But I jest!)
A casual look at the Hot Tub is revealing - it shows how messy an implementation can get and points to the need for abstraction. Can you fit the Hot Tub's functionality can fit into an execute() or do() method? That's what is coming up in the discussion upon the mid-level API in the next session.
Something else to note, the type-constraint of Ceiling Fan is an enumerated list (enum). That is consistent with the behavior of fan as a state machine.
And the 'around' modifier makes an appearance in the Hot Tub, hooking around the tub's 'temperature' method. Notice it receives a handle to the target method, whereby the method modified can be invoked in the scope of the modifier.
An explicit return in the modifier modifies the return value of the target. Don't have an explicit return in the 'around' modifier unless that is what you intend.
package CeilingFan;
use Moose;
use Moose::Util::TypeConstraints;
enum 'fanState' => qw(high medium low off);
has 'state' => (
is => 'rw',
isa => 'fanState',
default => 'off',
);
sub low {
my $self = shift;
$self->state('low');
print q{Ceiling fan is on [} . $self->state . q{].} ;
};
sub medium {
my $self = shift;
$self->state('medium');
print q{Ceiling fan is on [} . $self->state . q{].} ;
};
sub high {
my $self = shift;
$self->state('high');
print q{Ceiling fan is on [} . $self->state . q{].} ;
};
sub off {
my $self = shift;
$self->state('off');
print q{Ceiling fan is off.};
};
package HotTub;
use Moose;
use Moose::Util::TypeConstraints;
subtype 'tubState'
=> as Num
=> where {
($_ == 0) || ($_ == 1);
};
has 'state' => (
is => 'rw',
isa => 'tubState',
default => 0,
);
subtype 'tubTemperature'
=> as Num
=> where {
($_ >= 0) && ($_ <= 250);
};
has 'temperature' => (
is => 'rw',
isa => 'tubTemperature',
default => 0,
);
sub on {
my $self = shift;
$self->state(1);
print q{Hot tub is on.};
};
sub off {
my $self = shift;
$self->state(0);
print q{Hot tub is off.};
};
sub circulate {
my $self = shift;
print q{Hot tub is bubbling} if $self->state;
};
sub jetsOn {
my $self = shift;
print q{Jets are on} if $self->state;
};
sub jetsOff {
my $self = shift;
print q{Jets are off} if $self->state;
};
around 'temperature' => sub {
my $originalMethod = shift;
my $self = shift;
my $newValue = shift;
my $oldValue = $self->$originalMethod;
# Note: $self->temperature would lead to deep recursion
return $oldValue unless $newValue;
print "Steaming it up to $newValue degrees"
if ($newValue > $oldValue);
print "Cooling it down to $newValue degrees"
unless ($newValue > $oldValue);
$self->$originalMethod($newValue);
print "Temperature is now: " . $self->$originalMethod;
# safe to call, no deep recursion
};
[7-8.] Class - Stereo, TV
My attitude to TV is shaped by this gem of a dialogue between John Travolta as Vincent Vega and Samuel Jackson as Jules - two hit-men in the Tarantino classic, "Pulp Fiction".
Jules: You know the shows on TV?
Vincent: I don't watch TV.
Jules: Yeah, but, you are aware that there's an invention called television, and on this invention they show shows, right?
A trigger is set on the stereo volume. A trigger is a sub-ref, fired when the slot is set via setter. The trigger isn't set off by the 'default' method. Or BUILDER. Note the idiomatic $_[0] for reference to the 'self' object in the definition of the trigger sub.
package Stereo;
use Moose;
use Moose::Util::TypeConstraints;
enum 'stereoState' => qw(CD DVD Radio);
has 'state' => (
is => 'rw',
isa => 'stereoState',
default => 'Radio',
);
subtype 'stereoScale'
=> as Num
=> where {
($_ >= 0) && ($_ <= 11);
};
has 'volume' => (
is => 'rw',
isa => 'stereoScale',
default => 7,
trigger => sub {print q{Volume reset to } . $_[0]->volume},
);
sub on {
my $self = shift;
print q{Stereo is on [Volume: } . $self->volume . q{]};
};
sub off {
my $self = shift;
print q{Stereo is off [Volume: } . $self->volume . q{]};
};
sub setCD {
my $self = shift;
$self->state('CD');
};
sub setDVD {
my $self = shift;
$self->state('DVD');
};
sub setRadio {
my $self = shift;
$self->state('Radio');
};
package TV;
use Moose;
use Moose::Util::TypeConstraints;
subtype 'tvChannel'
=> as Int
=> where {
($_ >= 1) && ($_ <= 999);
};
has 'channel' => (
is => 'rw',
isa => 'tvChannel',
default => 7,
trigger => sub {print "Channel " . $_[0]->channel},
);
sub on {
my $self = shift;
print q{TV is on.};
};
sub off {
my $self = shift;
print q{TV is off.};
};
[x.] Prototype
It helps, when writing low-level APIs, to have some prototypes around that can be refactored into classes. Here is what I used.
package ApplianceControl;
use Moose;
# Prototyping to see what a Household Device looks like
sub on {
print q{Appliance is switched on.};
};
sub off {
print q{Appliance is switched off.};
};
In the next session, we shall look at the Command classes.
All code in this series may be downloaded from:
http://sites.google.com/site/sanjaybhatikar/codeunquote/designpatterns-1
http://sites.google.com/site/sanjaybhatikar/codeunquote/designpatterns-1
No comments:
Post a Comment