The beginnings of a different take on OOP Perl tutorials:
=head1 Data First OOP
=head2 Introduction
It's pretty common to hear people extolling the virtues of Object Orie
+nted Programming, or OOP. Usually they talk about the wonders of inh
+eritance and polymorphism. This is great if you have a background in
+ computer science and know what these things are and why they are des
+irable.
My take on OOP is different. OOP is great because it makes it easy to
+work with data. Everything else is just a side benefit.
In my view, the most important thing about OOP is that B<Objects tie d
+ata to behaviors>.
=head2 Caught in a BIND
Before I did a lot of OOP, I often found myself with a big nested data
+ structure or two at the heart my code. These things are such a pain
+that I find the nickname BIND (BIg Nested Data) appropriate.
If you've ever tried to work with a hash of arrays of hashes or someth
+ing similar, you know how unpleasant it can be. Now go two or three
+levels deeper. Add some non-uniform layers where some elements are h
+ashes, others arrays or scalars. It very quickly becomes tedious to
+write routines operate on BINDs. What routine has to reach into wha
+t part? Oh no, I need to restructure a bit, and I have 15 subroutines
+ to modify now! Not to mention all the debugging when I absent-minde
+dly use the wrong subscript or access the wrong part of the BIND.
This is where objects come to the rescue.
=head2 Example Acme Cab Company
Rather than go into a big theoretical discussion, I'll start with an e
+xample.
Let's consider an application that generates reports for a taxi compan
+y. At the end of each shift, each driver turns in a log with a list
+of his fares. We are putting together a program to read in these log
+s and produce some reports.
my $shift_data = {
'DAY' => {
'George Smith' => [
[ pickup => [ '08:12:30', '123 Anystreet' ]
dropoff => [ '08:45:19', '432 Otherstreet' ]
fare => '$25.62',
source => 'dispatch',
],
[ pickup => [ '09:02:05', '23 Maple Ave' ]
dropoff => [ '10:45:19', '32 Box Bvd' ]
fare => '$175.20',
source => 'flagged',
],
],
'Ralph Stone' => [
[ pickup => [ '08:12:30', '123 Anystreet' ]
dropoff => [ '08:45:19', '432 Otherstreet' ]
fare => '$25.62',
source => 'dispatch',
],
[ pickup => [ '09:02:05', '23 Maple Ave' ]
dropoff => [ '10:45:19', '32 Box Bvd' ]
fare => '$175.20',
source => 'flagged',
],
],
},
'SWING' => {
'Frank Franklin' => [
[ pickup => [ '08:12:30', '123 Anystreet' ]
dropoff => [ '08:45:19', '432 Otherstreet' ]
fare => '$25.62',
source => 'dispatch',
],
[ pickup => [ '09:02:05', '23 Maple Ave' ]
dropoff => [ '10:45:19', '32 Box Bvd' ]
fare => '$175.20',
source => 'flagged',
],
],
'Jack Jones' => [
[ pickup => [ '08:12:30', '123 Anystreet' ]
dropoff => [ '08:45:19', '432 Otherstreet' ]
fare => '$25.62',
source => 'dispatch',
],
[ pickup => [ '09:02:05', '23 Maple Ave' ]
dropoff => [ '10:45:19', '32 Box Bvd' ]
fare => '$175.20',
source => 'flagged',
],
],
},
'GRAVEYARD' => {
'Amy Ericson' => [
[ pickup => [ '08:12:30', '123 Anystreet' ]
dropoff => [ '08:45:19', '432 Otherstreet' ]
fare => '$25.62',
source => 'dispatch',
],
[ pickup => [ '09:02:05', '23 Maple Ave' ]
dropoff => [ '10:45:19', '32 Box Bvd' ]
fare => '$175.20',
source => 'flagged',
],
],
'Patrick Brown' => [
[ pickup => [ '08:12:30', '123 Anystreet' ]
dropoff => [ '08:45:19', '432 Otherstreet' ]
fare => '$25.62',
source => 'dispatch',
],
[ pickup => [ '09:02:05', '23 Maple Ave' ]
dropoff => [ '10:45:19', '32 Box Bvd' ]
fare => '$175.20',
source => 'flagged',
],
],
},
};
A nice clean structure. Easy enough to see that for a given day we ha
+ve three shifts. Each shift has a few drivers who have a few fares.
+ Each fare has some information about where and when it started and e
+nded, as well as the money collected and whether the fare came from c
+entral dispatch or from being flagged down on the street.
On the downside, it is complicated enough that it will be tricky to wr
+ite code to dig into it.
This is where we turn the structure into a group of objects and save o
+urselves some confusion.
How do we break this BIND into objects? The same way we broke it down
+when reading it. I like to do this kinds of conversion from the deep
+est layer out to the top layer.
Our deepest data structure is an array of two values labeled as either
+ C<pickup> or C<dropoff>. What are pickups and dropoffs? They are t
+imes when the cab stops. So let's call the object 'Stop'. We now ha
+ve a name, what information is important about a stop? Well, we have
+ a location and a time. So we define a stop as an object with a loca
+tion and a time.
package AcmeCab::Stop;
use strict;
use warnings;
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
# Initialize any attributes
$self->$_( $arg{$_} ) for keys %arg;
return $self;
}
sub location {
my $self = shift;
if( @_ ) {
my $loc = shift;
# Add some validation here.
$self->{location} = $loc;
}
return $self->{location};
}
sub time {
my $self = shift;
if( @_ ) {
my $time = shift;
# Add some validation here.
$self->{time} = $time;
}
return $self->{time};
}
1;
Now a fare can be thought of as:
[ pickup => AcmeCab::Stop->new( time => '08:12:30', location =>
+ '123 Anystreet' ),
dropoff => AcmeCab::Stop->new( time => '08:45:19', location =>
+ '432 Otherstreet' ),
fare => '$25.62',
source => 'dispatch',
],
Which brings us to the next level of the structure: The Fare. So let'
+s make AcmeCab::Fare. Each fare has two stops, an amount charged and
+ source. So we write:
package AcmeCab::Fare;
use strict;
use warnings;
use Carp qw(croak);
use constant SOURCES => qw( dispatch flagged cabstand );
my %SOURCES; @SOURCES{ SOURCES() } = ();
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
# Initialize any attributes
$self->$_( $arg{$_} ) for keys %arg;
return $self;
}
sub pickup {
my $self = shift;
if( @_ ) {
my $pu = shift;
croak 'pickup must be an AcmeCab::Stop object'
unless $pu->isa('AcmeCab::Stop');
$self->{pickup} = $pu;
}
return $self->{pickup};
}
sub dropoff {
my $self = shift;
if( @_ ) {
my $do = shift;
croak 'dropoff must be an AcmeCab::Stop object'
unless $do->isa('AcmeCab::Stop');
$self->{dropoff} = $do;
}
return $self->{dropoff};
}
sub source {
my $self = shift;
if( @_ ) {
my $source = shift;
croak 'source must be one of ' . join(",", map " '$_'", SOURCE
+S)
unless exists $SOURCES{$source};
$self->{source} = $source;
}
return $self->{source};
}
sub fare {
my $self = shift;
if( @_ ) {
my $fare = shift;
$self->{fare} = $fare;
}
return $self->{fare};
}
1;
What else do we want know about a fare? What about how long it lasted
+? Add a subroutine/method called 'duration' and you've got it.
=head2 Results
"So what?" you may be asking. There's a lot of code, and it doesn't do
+ anything.
Let's consider what would be needed to calculate total earning time fo
+r each driver on a given shift.
First with the bind:
for my $shift ( qw( DAY NIGHT GRAVEYARD ) ) {
}
Lady_Aleena, here's my version of your Base::Hosts in object form.
package Base::Hosts;
use strict;
use warnings;
# Make your host objects
my @hosts = map Base::Host->new( $_ ), (
{ directory => 'C:/Documents and Settings/ME/My Documents/fantas
+y',
'link' => q(http://localhost),
user => q(ME),
name => q(My Domain),
mail => q(ME@localhost),
},
{ directory => '/ftp/pub/www/fantasy',
'link' => q(http://www.xecu.net/fantasy),
user => q(Fantasy),
name => q(Fantasy's Realm),
mail => q(fantasy@xecu.net),
},
{ directory => '/home/lady_aleena/var/www',
'link' => q(http://lady_aleena.perlmonk.org),
user => q(Lady Aleena),
name => q(Lady Aleena's Home),
mail => q(lady_aleena@perlmonk.org),
},
);
# Put them in a hash by directory
my %hosts_by_dir = map { $_->directory, $_ } @hosts;
# Host class definition.
BEGIN {
package Base::Host;
use strict;
use warnings;
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
my %arg = @_;
for my $attr ( qw/ link user name mail directory / )
croak "Required attribute '$attr' not supplied"
unless exists $arg{$attr};
$self->{$attr} = $arg{$attr};
}
return $class;
}
sub link {
my $self = shift;
return $self->{'link'};
}
sub user {
my $self = shift;
return $self->{user};
}
sub name {
my $self = shift;
return $self->{name};
}
sub mail {
my $self = shift;
return $self->{mail};
}
sub directory {
my $self = shift;
return $self->{directory};
}
1;
}
|