Map & Reduce

Map Reduce Using Perl

View more presentations from Phil Whelan

Glimpses of Glorious Moose Traits

Anything that makes a software developer's life easier is good. Moose 'traits' fits right in that category.

A diversion .. When I first came upon Perl, what impressed me most was the ease with which data structures could be constructed, manipulated and extended. The ease of stuffing any kind of data - whether an object, array or even another hash - into a hash was a simplification that made coding a breeze! It is features like this in programming languages that free-up a developer's mental infrastructure from book-keeping to creative implementation - so s/he can focus on shaping an application rather than mental retention of myriad mettlesome minutiae.

But therein lies the bug-feature rub, if you catch my drift. This feature extracts a price. You've heard it, don't make me say it - Perl is slow. Perl is a memory-hog. And the inevitable comparisons to to C++ and Java. Needless to say, having more than one tool in one's belt is essential - nay, indispensable!

I can take comfort in that. You see, I love Taekwon-do, am devoted to this Korean martial art, and my sa-bum tells me "To excel in Taekwon-do, you must know Judo." Or Aikido. Or La Savate. Or Muy Thai. Or Rifle Shooting. The point is, unless you immerse yourself into the 'other' side, you risk getting locked into patterns of thinking that ultimately crimp your style.

So hear ye, developers, and be comforted. When slapped with criticism, turn the other cheek. Don't bash Java. Resist the temptation to ridicule .Net. Rather, learn about them! Then, when faced with an interesting problem, make the best choice. Yes, life is tough and there is no other way but to keep at it.

I must say though, as one having ploughed my way through C, C++ and .Net, I know of no other language that gives me as much creative freedom as my beloved Perl. Coding in Perl, particularly with the MOOSE object-oriented framework, is on par with other pleasures in life like watching sunrise from a mountain top or making love to a beautiful woman or making love to a beautiful woman at sunrise on a mountain top.

And with that sanguine thought, onward to traits.

Consider the Remote Control class from the previous example. (See: Command Pattern.) The Remote, which is an 'Invoker', is composed of 'Commands', each of which wraps around a 'Receiver', wherein resides behavior and the methods to access it. Dense though this clap-trap is, cutting to the chase a class is composed of other classes in sets. Savvy?

Consider the typical implementation.

package RemoteControl;
use Moose;

use Command;


has 'onCommands'      =>  ( 
            is        =>  'rw', 
            isa       =>  'ArrayRef[Command]',
            default   =>  sub { [] },
);

has 'offCommands'     =>  ( 
            is        =>  'rw', 
            isa       =>  'ArrayRef[Command]',
            default   =>  sub { [] },
 );

Consider access to the slots in the BUILD method.

sub BUILD {
  my $self = shift;
    for (my $i = 0; $i < 7; $i++) {
      push @{$self->onCommands}, NoCommand->new;
      push @{$self->offCommands}, NoCommand->new;
    }
}

A bit clumsy, don't you think? The sub (which is a method, by the way) unpacks the class to get to the underlying slot. Not a good thing. And this has to happen each time the slot is accessed as a container - to push/pop, count, store at/retrieve from an indexed location, sort, filter via map/grep, etc. Is there a way one could get a handle on this rum business?

There is. Consider the implementation using traits. See the rum.. err, handle?

package RemoteControl;
use Moose;
use Command;


has 'onCommands'      =>  ( 
            traits    =>  ['Array'],
            is        =>  'rw', 
            isa       =>  'ArrayRef[Command]',
            default   =>  sub { [] },
            handles   =>  {
                all_onCommands     =>  'elements',
                add_onCommand      =>  'push',
                map_onCommands     =>  'map',
                filter_onCommands  =>  'grep',
                find_onCommand     =>  'first',
                get_onCommand      =>  'get',
                join_onCommands    =>  'join',
                count_onCommands   =>  'count',
                has_onCommands     =>  'count',
                has_no_onCommands  =>  'is_empty',
                sorted_onCommands  =>  'sort',
            },
);

has 'offCommands'     =>  ( 
            traits    =>  ['Array'],
            is        =>  'rw', 
            isa       =>  'ArrayRef[Command]',
            default   =>  sub { [] },
            handles   =>  {
                all_offCommands    => 'elements',
                add_offCommand     => 'push',
                map_offCommands    => 'map',
                filter_offCommands => 'grep',
                find_offCommand    => 'first',
                get_offCommand     => 'get',
                join_offCommands   => 'join',
                count_offCommands  => 'count',
                has_offCommands    => 'count',
                has_no_offCommands => 'is_empty',
                sorted_offCommands => 'sort',
            },
);

This is what access to containers now looks like, with traits involved:

sub BUILD {
  my $self = shift;
    for (my $i = 0; $i < 7; $i++) {
      $self->add_onCommand(NoCommand->new);
      $self->add_offCommand(NoCommand->new);
    }
}

Amen!

The Command Pattern - SDLC

Ch. 6 from HFDP - Part 03 of 03

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.

How do you write code?

If you are like most software developers in a typical software shop, you write code the way you know to write code. Then you test it. Right? Or sometimes, you skip the tests. I mean, with all the constant pressure to put out code ..

How about a way to code which automatically generates tests and produces all the documentation you ever need? What is it worth to you? What if, this way also improves software quality and reduces the time duration for upgrades in the development life-cycle through the life of the software? What is it worth to you then?

There is a way, and like many other worthwhile things in life, all it requires is commitment to the process. The way consists of building an application starting with the tests, then write code to tests. On this side of the East-West divide, we say that all great truths are paradoxical. So writing tests and then coding to them is turning convention on the head. But it works. And you won't know until you do it. As Yoda tells the disbelieving young Jedi in "Empire Strikes Back" - Try not. Do. Or do not. There is not try.

It gets even better in a paired programming partnership, where one developer writes the tests and the other writes the code to those tests. Then, they switch roles. I have pair-programmed with programmers a level above me and a level below me. In both instances, I have improved my skills - learning new tricks from the better developers in our midst and from the questions of the less-skilled developers.

Mind you, paired programming is not a one-size fits all solution. There will always be lone gun-(wo)men. If you are in my position as the Head of a Software Development Group with a mix or people, personalities and cultures - it is best to open up paired-programming as an additional option that developers can easily avail of. And leave the choice to them. It helps to be flexible in these matters and keep an open mind.

Back to code. So what would the application test suite for the Remote Control look like? Let's start with the low-level APIs - the so-called Receiver classes. The code snippets illustrate sample tests for the Ceiling Fan and Hot Tub. First, the Fan, since it is kinda hot in here. (Or is it just me?)

print "--[ Receiver: Ceiling Fan ]--------------------------------------------";
my $myCeilingFan = CeilingFan->new;
isa_ok($myCeilingFan, 'CeilingFan');
$myCeilingFan->low;
is($myCeilingFan->state, 'low', 
         q{.. Set ceiling fan ON LOW});
$myCeilingFan->medium;
is($myCeilingFan->state, 'medium', 
         q{.. Set ceiling fan ON MED});
$myCeilingFan->high;
is($myCeilingFan->state, 'high', 
         q{.. Set ceiling fan ON HIGH});
$myCeilingFan->off;
is($myCeilingFan->state, 'off', 
         q{.. Set ceiling fan OFF});

This generates output like:


Now the 'ot tub:

print "--[ Receiver: Hot Tub ]------------------------------------------------";
my $myHotTub = HotTub->new;
isa_ok($myHotTub, 'HotTub');
$myHotTub->on;
is($myHotTub->state, 1, 
         q{.. Hot tub is on});
$myHotTub->off;
is($myHotTub->state, 0, 
         q{.. Hot tub is off});
$myHotTub->on;
$myHotTub->circulate;
$myHotTub->temperature(50);
is($myHotTub->temperature, 50, 
         q{.. Hot tub temperature is set to 50 degrees});
$myHotTub->temperature(150);
is($myHotTub->temperature, 150, 
         q{.. Hot tub temperature is set to 150 degrees});
$myHotTub->temperature(90);
is($myHotTub->temperature, 90, 
         q{.. Hot tub temperature is set to 90 degrees});

Which generates the output:


Quite a screenful, eh? Nothing too sophisticated though. All we are doing is testing class labels with 'isa_ok' and get/set (i.e. accessor/mutator) methods with 'is'. So what's the big deal?

Let's examine the output.

First, note how the documentation is implicit. The 'isa_ok' tests provide a good opportunity to explain the constructor calls. The 'is' tests present an opportunity for one-liners as succinct documentation of the get/set methods - at least the important ones. Any other methods can be tested - and documented - in the same manner.

Note that these tests are based on Perl's utilitarian 'Test::More' package. (The 'use' declaration is not shown in the snippets posted above. Refer to the code for these details.) Some handy utilities from the 'Test::More' package are 'like' for tests based on a pattern match, 'can_ok' to test if an object or class has a method, 'is_deeply' for validating data structures with XML-style nested organization.

The Command APIs are similarly tested. Take a look at the Ceiling Fan - being a state machine, its tests are interesting!

print "--[ Command: Ceiling Fan Hi / Lo / Med / Off]--------------------------";
my $myTestCeilingFan = CeilingFan->new;
print "-----------------------------------------------------------< ON HI >---";
$myTestCeilingFan->medium;    # fan set randomly at medium 
is($myTestCeilingFan->state, 'medium', 
         q{Fan is ON MED at start.});
my $myCeilingFanHighCommand = 
         CeilingFanHighCommand->new(ceilingFan => $myTestCeilingFan);
isa_ok($myCeilingFanHighCommand, 'CeilingFanHighCommand');
$myCeilingFanHighCommand->execute;
is($myCeilingFanHighCommand->ceilingFan->state, 'high', 
         q{Fan (re)set ON HI via Command.});
$myCeilingFanHighCommand->undo;
is($myCeilingFanHighCommand->ceilingFan->state, 'medium', 
         q{Fan (re)set ON MED via undo.});
print "----------------------------------------------------------< ON MED >---";
$myTestCeilingFan->low;    # fan set randomly at low 
is($myTestCeilingFan->state, 'low', 
         q{Fan is ON LO at start.});
my $myCeilingFanMediumCommand = 
         CeilingFanMediumCommand->new(ceilingFan => $myTestCeilingFan);
isa_ok($myCeilingFanMediumCommand, 'CeilingFanMediumCommand');
$myCeilingFanMediumCommand->execute;
is($myCeilingFanMediumCommand->ceilingFan->state, 'medium', 
         q{Fan (re)set ON MED via Command.});
$myCeilingFanMediumCommand->undo;
is($myCeilingFanMediumCommand->ceilingFan->state, 'low', 
         q{Fan (re)set ON LO via undo.});
print "----------------------------------------------------------< ON LO >---";
$myTestCeilingFan->high;    # fan set randomly at high
is($myTestCeilingFan->state, 'high', 
         q{Fan is ON HI at start.});
my $myCeilingFanLowCommand = 
         CeilingFanLowCommand->new(ceilingFan => $myTestCeilingFan);
isa_ok($myCeilingFanLowCommand, 'CeilingFanLowCommand');
$myCeilingFanLowCommand->execute;
is($myCeilingFanLowCommand->ceilingFan->state, 'low', 
         q{Fan (re)set ON LO via Command.});
$myCeilingFanLowCommand->undo;
is($myCeilingFanLowCommand->ceilingFan->state, 'high', 
         q{Fan (re)set ON HI via undo.});
print "-------------------------------------------------------------< OFF >---";
$myTestCeilingFan->high;    # fan set randomly at high
is($myTestCeilingFan->state, 'high', 
         q{Fan is ON HI at start.});
my $myCeilingFanOffCommand = 
         CeilingFanOffCommand->new(ceilingFan => $myTestCeilingFan);
isa_ok($myCeilingFanOffCommand, 'CeilingFanOffCommand');
$myCeilingFanOffCommand->execute;
is($myCeilingFanLowCommand->ceilingFan->state, 'off', 
         q{Fan (re)set OFF via Command.});
$myCeilingFanOffCommand->undo;
is($myCeilingFanLowCommand->ceilingFan->state, 'high', 
         q{Fan (re)set ON HI via undo.});

Notice how each Command is given a starting state that is changed upon invocation of the 'execute' method, and restored with 'undo'? Nifty!



One can continue on in this manner. For this example, the Invoker (i.e Remote) is tested by means of a dry-run. See the code for details.

Epilogue:
Unit-testing in this way looks tedious and time-consuming. Yes, it can be that. Particularly if code is written first and tests later. That's why it is very, very, very, very, very, very, very, very, very, very, very important to write the tests first. Web-Application Frameworks in Perl such as Catalyst are designed with this approach in mind.

Writing tests first gives rise to lots of questions. That's because the coder is likely to ask the tester about the architectural features of the system as he/she gets their mind around the design. Perhaps there are some inconsistencies of the architecture that come to light. This way, there is a far greater chance that difficulties are noticed early, before a lot of code is written. That can be majorly beneficial.

Yet another benefit is that there is always a benchmark for changes made during the life-cycle of the application. The test-suite, which is continually updated, serves as a basis for regression testing.

For example, while writing this little application, I decided to upgrade the Remote Control class implementation with traits - a feature of Moose 1.05+. After working this into the code, I immediately ran the application test suite to ensure nothing was broken. Sure enough, things were mis-shapen. But with regression testing to guide the development process, it the process was far easier.

Always built testing into your process. It is key to developing an application incrementally, in small and consistent steps. Now that's bringing Kaizen to the software world.

All code in this series may be downloaded from:
http://sites.google.com/site/sanjaybhatikar/codeunquote/designpatterns-1

The Command Pattern - Abstraction by Command

Ch. 6 from HFDP - Part 02 of 03

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.

So you want to replace your messy callback scripts with clean Command objects. Wise!

A Command implements an 'execute' or 'do' method that wraps around functionality implemented in the proletarian low-level API classes. We choose to call this wrapper-method 'execute'. Sticking with the Remote Control analogy, there is one command per button. So in case of an appliance such as a Light, there is one button for switching ON and another for switching OFF. One Command class for each operation.

[1.] Base Command Class
The base class has an undefined execute() method that is defined in the classes that inherit.
Let's lay out what we have set about doing. The Remote Control is the invoker - what the end-user sees and manipulates. This contrivance utilizes Command intermediaries that wrap around the meaty (but messy) methods in the devices - the Receivers. Why are the device methods messy? That is part of the plan. Because devices (i.e. Receivers) are of distinct types and the device manufacturers have the freedom of implementation. And that makes them messy to integrate in a Universal Remote Control. The problem is solved by using Command intermediaries that wrap a unified API around the device methods.

The 'execute' method is one element of this API. Can you figure out the other?

package Command;
use Moose;

use HouseholdDevices;

sub execute {};

sub undo {};

Right, 'undo' is the another. Like 'execute', it simply wraps around the appropriate behavior of the underlying Receiver (i.e. device).

[2.] Light On / Off Commands
Let's dive into a simple Command class starting with the Light class of devices.

Each Command class (on, off) has a slot to hold a light device - object of Light class. Implementation of execute() is straightforward. So is undo().

package LightOnCommand;
use Moose;

extends 'Command';

has 'light'       =>  (
  is              =>  'rw',
  isa             =>  'Light',
);

sub execute {
  print q{< Command id='LightOnCommand' >};
  my $self = shift;
  $self->light->on;
  print q{< /Command >};
}

sub undo {
  print q{< Command id='LightOnCommand' >};
  my $self = shift;
  $self->light->off;
  print q{< /Command >};
}

package LightOffCommand;
use Moose;

extends 'Command';

has 'light'       =>  (
  is              =>  'rw',
  isa             =>  'Light',
);

sub execute {
  print q{< Command id='LightOffCommand >};
  my $self = shift;
  $self->light->off;
  print q{< /Command >};
}

sub undo {
  print q{< Command id='LightOffCommand >};
  my $self = shift;
  $self->light->on;
  print q{< /Command >};
}

[3.] Light On / Off Commands - Living Room
More of the same. Just a different setting - the Living Room.

package LivingRoomLightOnCommand;
use Moose;

extends 'Command';

has 'light'     =>  (
  is            =>  'rw',
  isa           =>  'Light',
);

sub execute {
  print q{< Command id='LivingRoomLightOnCommand' >};
  my $self = shift;
  $self->light->on;
  print q{< /Command >};
}

sub undo {
  print q{< Command id='LivingRoomLightOnCommand' >};
  my $self = shift;
  $self->light->off;
  print q{< /Command >};
}

package LivingRoomLightOffCommand;
use Moose;

extends 'Command';

has 'light'     =>  (
  is            =>  'rw',
  isa           =>  'Light',
);

sub execute {
  print q{< Command id='LivingRoomLightOffCommand >};
  my $self = shift;
  $self->light->off;
  print q{< /Command >};
}

sub undo {
  print q{< Command id='LivingRoomLightOffCommand >};
  my $self = shift;
  $self->light->on;
  print q{< /Command >};
}

[4.] Fan Commands - On, off and everything in between
The fan presents an interesting case. It is a state machine - with four states as 'high', 'medium', 'low', 'off'. This means, four Command classes, one for each state, the execute() method being mapped accordingly. Implementation of the Commands for 'high' and 'off' states is reproduced below, the implementation of the remaining two states ('medium', 'low') following similar lines.

The slot 'backstate' is by virtue of the Ceiling Fan being a state machine. The previous state is saved - which happens every time a state-change operation (i.e. Fan Command) is executed. The undo() method is thus in business.

package CeilingFanHighCommand;
use Moose;
use Moose::Util::TypeConstraints;

extends 'Command';

has 'ceilingFan' => (
  is            =>  'rw',
  isa           =>  'CeilingFan',
);

enum 'fanState' => qw(high medium low off);

has 'backState' =>  (
  is            =>  'rw',
  isa           =>  'fanState',
  default       =>  'off',
);

sub execute {
  print q{};
  my $self = shift;
  $self->backState($self->ceilingFan->state);
  $self->ceilingFan->high;
  print q{};
}

sub undo {
  print q{};
  my $self = shift;
  $self->ceilingFan->low      if ($self->backState eq 'low');
  $self->ceilingFan->medium   if ($self->backState eq 'medium');
  $self->ceilingFan->off      if ($self->backState eq 'off');
  print q{};
}

package CeilingFanOffCommand;
use Moose;
use Moose::Util::TypeConstraints;

extends 'Command';

has 'ceilingFan' => (
  is            =>  'rw',
  isa           =>  'CeilingFan',
);

enum 'fanState' => qw(high medium low off);

has 'backState' => (
  is            =>  'rw',
  isa           =>  'fanState',
  default       =>  'off',
);

sub execute {
  print q{};
  my $self = shift;
  $self->backState($self->ceilingFan->state);
  $self->ceilingFan->off;
  print q{};
}

sub undo {
  print q{};
  my $self = shift;
  $self->ceilingFan->high       if ($self->backState eq 'high');
  $self->ceilingFan->medium     if ($self->backState eq 'medium');
  $self->ceilingFan->low        if ($self->backState eq 'low');
  print q{};
}

[5.] Fan Commands - with Roles
Notice anything questionable about the Commands for the Ceiling Fan? What is really dissatisfying is repetition of code. Analyzing the four Command classes, it is easily seen that the only change from class to class is in the implementation of the execute() method - the other slots and methods do not vary.

What can be done about it? In the first place, is it required to do anything? From the standpoint of the principles underlying object-oriented design, the implementation is really bad. The repetition of code across classes is symptomatic of design failure - we have failed to package code for reuse. Imagine if a new state is added to the Ceiling Fan class via Inheritance. For the new Ceiling Fan to work with the Fan Command classes, code has to be rewritten in four different places just to maintain the application. Not good!

And here is where Roles come in handy. Ever indulged in role-play? Nevermind, I just thought I'd ask ..

Let's visit the new implementation now. We already identified what bits of code vary and what stays the same in the implementation. I've moved the common bits to a Role called 'Fanable'.

package Fanable;
use Moose::Role;
use Moose::Util::TypeConstraints;

requires 'execute';

has 'ceilingFan' => (
  is            =>  'rw',
  isa           =>  'CeilingFan',
);

enum 'fanState' => qw(high medium low off);

has 'backState' =>  (
  is            =>  'rw',
  isa           =>  'fanState',
  default       =>  'off',
);

before 'execute' => sub {
  my $self = shift;
  $self->backState($self->ceilingFan->state);
};

sub undo {
  print q{};
  my $self = shift;
  $self->ceilingFan->high       if ($self->backState eq 'high');
  $self->ceilingFan->medium     if ($self->backState eq 'medium');
  $self->ceilingFan->low        if ($self->backState eq 'low');
  $self->ceilingFan->off        if ($self->backState eq 'off');
  print q{};
}

Observe that a Role, like a class, may have slots for data as well as methods. But it is not a class in the sense that are no objects of a Role. A Role is composed into a class - a principle called 'mix-in' in some object-oriented circles.

What of 'requires'? It means that for a Class to consume a Role correctly, the method qualified by the 'requires' clause must be implemented therein. Otherwise, an exception is raised.

That means all Fan Command classes need to provide a defined execute() method.

Here then are the Commands for 'high' and 'off' states. See the difference?All it takes to consume the 'Fanable' Role is a 'with' clause. Define the execute() method .. and we're done! Ain't that neat?

package CeilingFanHighCommand;
use Moose;

with 'Fanable';

extends 'Command';

sub execute {
  print q{};
  my $self = shift;
  $self->ceilingFan->high;
  print q{};
};

package CeilingFanOffCommand;
use Moose;

with 'Fanable';

extends 'Command';

sub execute {
  print q{};
  my $self = shift;
  $self->ceilingFan->off;
  print q{};
};

[6.] Hot Tub
The Hot Tub serves as an excellent illustration of encapsulation. Here goes:

package HotTubOnCommand;
use Moose;

extends 'Command';

has 'hotTub'    => (
  is            =>  'rw',
  isa           =>  'HotTub',
);

sub execute {
  print q{};
  my $self = shift;
  $self->hotTub->on;
  $self->hotTub->temperature(87);
  $self->hotTub->circulate;
  print q{};
}

sub undo {
  print q{};
  my $self = shift;
  $self->hotTub->off;
  print q{};
}

package HotTubOffCommand;
use Moose;

extends 'Command';

has 'hotTub'    => (
  is            =>  'rw',
  isa           =>  'HotTub',
);

sub execute {
  print q{};
  my $self = shift; 
  $self->hotTub->temperature(35);
  $self->hotTub->off;
  print q{};
}

sub undo {
  print q{};
  my $self = shift;
  $self->hotTub->on;
  print q{};
} 

[7.] No Command
I am skipping over the Television and Stereo. I never liked Televisions. Like Vincent Vega - from the Tarantino classic "Pulp Fiction", starring Uma Therman, John Travolta (Vincent) and Samuel Jackson (Jules).

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? ..

The only times when I've had a Television have been those when a girlfriend forced one upon me. Not that I am boring or anything. (I did love the Stereo though - A man that hath no music in himself is fit for treasons, spoils and strategems. A man that hath no stereo in his house is fit for iPods.)

What I shall move on to now is the No Command. In the Vedas, there is mention of 'shunya' - nothing. Nothing as in null. A non-entity. Not even an entity that stands for nothing of something, like zero. Much can go wrong if one ignores shunya. Civilizations have been known to crumble. Let's not make that mistake.

The No Command is what happens (or rather, what does not happen) when one presses a button on the Remote Control that isn't assigned (or rather, that is assigned to a No Command.) The idea is to leave no button unassigned - even when it does nothing, it does something that amounts to nothing. Here it is then, the No Command, which by now you know as well as the back of your hand.

package NoCommand;
use Moose;

extends 'Command';

sub execute {
  print q{};
  print q{};
}

sub undo {
  print q{};
  print q{};
}

That wasn't so tough, was it? ;o)

[8.] Macro Command
The last of the Commands is the Macro. It is a container for Commands, and yet, it is a Command itself. Remember Inheritance?

Before that starts to sounds scarier than it really is, here is the definition of the Macro.

package MacroCommand;
use Moose;

extends 'Command';

has 'Commands'  =>  ( 
  is            =>  'rw', 
  isa           =>  'ArrayRef[Command]',
  default       =>  sub { [] },
);

sub BUILD {
  my $self = shift;
  push @{$self->Commands}, NoCommand->new;
}   

sub execute {
  my $self = shift;
  print q{};
  foreach my $thisCommand (@{$self->Commands}) {
      $thisCommand->execute;
  } 
  print q{};
}

sub undo {
  my $self = shift;
  print q{};
  foreach my $thisCommand (@{$self->Commands}) {
      $thisCommand->undo;
  } 
  print q{};
}

Note the use of BUILD to produce a valid initial state. Note also that the Macro is initialized with a No Command. The execute() method simply iterates over the array and invokes the execute() method of each Command. Isn't that neat? That's the power of abstraction - a container need not know anything about the Command objects contained in it. It simply iterates over those objects one by one, invoking the execute() method each time.

All code in this series may be downloaded from:
http://sites.google.com/site/sanjaybhatikar/codeunquote/designpatterns-1

The Command Pattern - Low-Level API

Ch. 6 from HFDP - Part 01 of 03

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

Your wish is my command! The Command Pattern - A Foreword

Ch. 6 from HFDP - Part 00 of 03

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.

Long, long ago, (in a Galaxy far, far away,) we developers wrote code for command-line applications. Whatever data the application required from the user, it collected through a questionnaire with the user. Though we took a certain amount of justifiable pride in the usability of our applications, the problems of the command-line format were obvious to all but purists. For one, the Q&A format gives the user only one opportunity to get it right - or abort start all over again. On occasion, the Q&A format results in a long form that is about as tiresome to fill as doing taxes. But all of that, one could live with as along as the application beautifully (and dutifully) delivered results as expected. The hurt came when from the challenge of managing relationships among the components of data. There was no good way to manage that, since a Q&A format confines the human-machine interaction to a linear script.

Imagine two people having a conversation in a linear format, where one can talk at a time and they may only talk in turns. Might work, hmm? Unless it's a United States law-maker fillibustering Congress. Now imagine half-a-dozen people sitting across from each other and trying to have a conversation following the same linear structure - only one may talk at a time and they talk by turn, in a fixed order. Can you see how that limits the range and variety of topics in the discussion? No? I have a punch-card machine that might interest you ..

(Or take a word-processor, for example, that enquires, "Should I insert an image now?" after each and every line you type. Or asks for style elements after each and ever word .. you get the picture.)

As the world moved into an information age and attention spans shrank reducing humans to tittering twittering twits, Graphical User Interfaces became the dominant paradigm of human-machine interaction.

Enter the Command pattern. A GUI is nothing but a collection of elements that receive data and fire actions. The data are pushed into a structure that resembles a tree and is global in application scope. The action wired to a GUI button typically takes the shape of a script - the so-called 'Callback' - that can access (and modify) the tree data-structure. Nifty! But that is how it used to be. Life has become better since then. And that is where the Command pattern really shines.

The folks at HFDP use a remote control as a metaphor for a software application with GUI. This homily doesn't detract (or distract) from the principle, which is that an application with GUI has a structure as follows:

1. A high-level API
representing functionality presented to the end-user; in the book, it is the Remote Control.
2. A low-level API
representing the proletariat - the classes that implement the methods required to execute the work; in the book, this layer comprises the Household Devices - appliances such as ceiling fan, hot tub, stereo, etc;
3. A mid-level API
representing an abstract layer between the low-level API and the high-level API; The classes at this level each present a generic method like execute() or do() that wraps around the methods of the low-level API.

We shall start with the low-level API. It is instructive to follow the implementation here - usage of Moose attributes is amply illustrated. Next, the mid-level API. There is an interesting illustration or Roles lurking here. And finally, the high-level API - I intend to use this as an illustration of the Life-Cycle approach to Software Development.

On to the code then.

All code in this series may be downloaded from:
http://sites.google.com/site/sanjaybhatikar/codeunquote/designpatterns-1

The Lazy Moose - Finale!

When Laziness is a Virtue - Part 03 of 03

Target Audience: This series is pitched at developers interested in Object Oriented Design Patterns using the Moose framework in Perl.

My implementation consists of three class. Four, if you consider inheritance. The main class is EarnedValue - I call it main as this class exposes the application API. That's the main point.

The two other classes manage the work, divided along the lines of schedule and cost - handling and processing. The class for schedule is Schedule and cost is Cost. Schedule works off the Gantt chart whereas Cost works off the time-log. (Both of these are described in Part 02.)

So where would you expect to find the basic functionality for pulling data out of a spreadsheet? In Cost and Schedule, right?

My implementation actually deposits this functionality in EarnedValue - the main class. Why do I do that? Partly, to avoid duplication of code. I know that both Cost and Schedule require this functionality - so I put it in a third place, and give both these clients hooks into that functionality by passing a reference. So whenever data is to be pulled off a spreadsheet, the client object delegates the fetching operation to the main class.

If you've been following my other presentations in this series, you would think that I need to use Roles, no? Well, that's exactly what I have done here. I haven't used Roles in the purist, didactic sense, of course - which is why you don't see 'Moose::Role' anywhere. Remember, like much of everything else in the Object-oriented way of going about life, Roles are about the concept rather than a specific, narrowly-defined implementation.

The Japanese have a saying "Bolt what you can weld, tape what you can bolt, hold what you can tape." When you see a concept, free yourself from any particular implementation of it. That way, you can do much more. Even though it may not look like you are doing much at all.

So here's the output:

And the code the EarnedValue class that generates it - it's a bunch of code, an eyeful, and please follow it with the handy 10-step guide below :o)

[1.]
First the business, as usual. 'use Moose' and all that. Par for the course. The exception handling is based on object-oriented Exception::Class. Following best-practices (documented in this blog), the $SIG{__DIE__} event-handler is overloaded.

package EarnedValue;
use Moose;
use OLE;
use Win32::OLE::Const "Microsoft Excel";
use File::Spec;
use Moose::Util::TypeConstraints;
use Params::Coerce ();
use Data::Dumper;

use Exception::Class (
  'EV::Exception::Base' => {
    description => 'Base Exception Class',
  },
  'EV::Exception::Base::Logger' => {
    isa => 'EV::Exception::Base',
      description => 'Simply logging!',
  },
  'EV::Exception::Base::InvalidState' => {
    isa   => 'EV::Exception::Base',
      fields  => [ 'EV', 'PV', 'AC'],
        description => 'Invalid state',
  },
  'EV::Exception::Base::MissingData' => {
    isa   => 'EV::Exception::Base',
      fields  => [ 'EV', 'PV', 'AC'],
        description => 'Incomplete information',
  },
);

local $SIG{__DIE__} = sub {
  my $err = shift;
  if ($err->isa('EV::Exception::Base')) {
    die $err; 
  } elsif ($err->isa('Cost::Exception::Base')) {
    die $err; 
  } elsif ($err->isa('Schedule::Exception::Base')) {
    die $err;
  } else {
    EV::Exception::Base->throw($@);
  }
  print $@;
};

[2.]
Data - Sources of information: (a.) Spreadsheet_Schedule, (b.) Spreadsheet_Cost, and (c.) activeSpreadsheet.
The results are generated by scraping these two spreadsheets. Naturally, these need to be supplied by the user. Note that a constraint is set on the slot via subtype, to enforce that the user-supplied document exists on disk. If not, exception is thrown.

subtype 'extantFile'
  => as Str
  => where {
      (    -e $_  );
    };

has 'activeSpreadsheet' => (
    is         =>  'rw',
    isa        =>  'extantFile',
    predicate  =>  'has_activeSpreadsheet',
#   trigger    =>  \&timeStamped_copy
);

has 'Spreadsheet_Schedule' => (
    is         =>  'rw',
    isa        =>  'extantFile',
    predicate  =>  'has_spreadsheetSchedule',
    default    =>  \&evGantt,
);

has 'Spreadsheet_Cost' => (
    is         =>  'rw',
    isa        =>  'extantFile',
    predicate  =>  'has_spreadsheetCost',
    default    =>  \&evBasecamp,
);

[3.]
Data - Results-on-demand: EV, PV, AC, SPI, CPI
The meat! These slots hold the results of scraping spreadsheets and other skulldruggery. The mother-lode, if you will. Note that each has attribute 'lazy' set to '1', implementing lazy-loading. The 'default' attribute of each variable is set to a method that - this is how the chain of events is triggered when a value is demanded.

has 'EV'       =>  (
    is         =>  'rw',
    isa        =>  'Num',       
    default    =>  \&calculateEV,
    lazy       =>  1,  
);

has 'PV'       =>  (
    is         =>  'rw',
    isa        =>  'Num',
    default    =>  \&calculatePV,
    lazy       =>  1,  
);

has 'AC'       =>  (
    is         =>  'rw',
    isa        =>  'Num',     
    default    =>  \&calculateAC,
    lazy       =>  1,
);

has 'SPI'      =>  (
    is         =>  'rw',
    isa        =>  'Num', 
    default    =>  \&calculateSPI,
    lazy       =>  1,
);

has 'CPI'      => (
    is         =>  'rw',
    isa        =>  'Num',       
    default    =>  \&calculateCPI,
    lazy       =>  1,    
);

[4.]
Objects - MySchedule, MyCost
These are slots for objects encapsulating the requisite functionality for handling and processing time and cost information. Information is parceled into neat intermediate components here for assembly in the final step by main (EarnedValue) class.

has 'MySchedule' => (
    is         =>  'rw',
    isa        =>  'Schedule',    
);

has 'MyCost' => (
    is         =>  'rw',
    isa        =>  'Cost',    
);

[5.]
Data - Diary
This is an interesting one. It goes with an associated method 'log_Me', which is the exception handler for the application. Any planned exceptions are handled here and a log of key events with time-date stamp is maintained. The slot is for the log-file that 'log_Me' utilizes.

has 'Diary'    => (
    is         =>  'rw',
    isa        =>  'Str',
    default    =>  \&evLog,
    predicate  =>  'has_Diary',
    clearer    =>  'clear_Diary',
);

[6.]
Data - Other
Note the use of subtype to enforce a constraint. The specification of cell range is constrained by subtype that checks by a regular expression. The range of cells associated with an Excel spreadsheet query is stashed away here for use by querying methods.

subtype 'CellRange'
 => as Str
 => where {
   (    /^[a-zA-Z]{1,2}\d+$/  ||  /^[a-zA-Z]{1,2}\d+?:[a-zA-Z]{1,2}\d+$/);
  };

has 'Range'    =>  (
    is         =>  'rw',
#   isa        =>  'CellRange',
    isa        =>  'Str',
    predicate  =>  'has_Range',
    clearer    =>  'clear_Range',
);

has 'multiplying_factor'  => (
    is         =>  'rw',
    isa        =>  'Num',       
    default    =>  1000,
);

[7.]
Methods - calculateEV, calculatePV, calculateAC, calculateSPI, calculateCPI
The high-level methods recruit these middle-level methods. The structure set-up by these methods is critical. As mention in [3.], each method implements a 'default' attribute set upon a lazy variable. What does that mumbo-jumbo mean? Only that the method is fired automatically when the slot is accessed the first time.
Note the exception handling mechanism. The 'log_Me' method is invoked both for logging and handling any exception originating from the invocation of a high-level method.

sub calculateEV {
  my $self = shift;
  my $EV;
  eval {
    $EV = $self->MySchedule->tally_EVnumbers->[0] * $self->multiplying_factor;
  };
  my $e;
  if ($e = Schedule::Exception::Base->caught) {
    $self->log_Me($e);
  } else { 
    $self->log_Me if $self->has_Diary;
  }
 
  return  $EV;
};

sub calculatePV {
  my $self = shift;
  my $PV;
  eval {
    $PV = $self->MySchedule->tally_PVnumbers->[0] * $self->multiplying_factor;
  };
  my $e;
  if ($e = Schedule::Exception::Base->caught) {
    $self->log_Me($e);
  } else { 
    $self->log_Me if $self->has_Diary;
  }
 
  return $PV;
};

sub calculateAC {
  my $self = shift;
  my $AC;
 
  eval {
    $AC = $self->MyCost->tally_ACnumbers;
  };
  my $e;
  if ($e = Cost::Exception::Base->caught) {
    $self->log_Me($e);
  } else {
    $self->log_Me if $self->has_Diary;
  };  
 
  return $AC;
};

sub calculateSPI {
  my $self = shift;
  my ($netEV,$netPV);
  my $SPI;
  eval {
    $netEV = $self->EV;
    $netPV = $self->PV;
  };
  my $e;
  if (   ($e = Cost::Exception::Base->caught) 
      || ($e = Schedule::Exception::Base->caught)) {
    $self->log_Me($e);
  } else {
    $self->log_Me if $self->has_Diary;
    $SPI = $netEV/$netPV;
  };
 
  return $SPI;
};

sub calculateCPI {
  my $self = shift;
  my ($netEV,$netAC);
  my $CPI;
  eval {
    $netEV = $self->EV;
    $netAC = $self->AC;
  };
  my $e;
  if (   ($e = Cost::Exception::Base->caught) 
      || ($e =   Schedule::Exception::Base->caught)) {
    $self->log_Me($e);
  } else {
    $self->log_Me if $self->has_Diary;
    $CPI = $netEV/$netAC;
  };
 
  return $CPI;
};

[8.]
Methods - printExecutiveSummary, printCostStructure
The high-level methods - for formatted reporting. The output generated is a report with a very simple structure. It is easy to see how this can be pumped up with all the bling from Google visualization API and other JavaScript/Ajay frameworks.

 
sub printExecutiveSummary {
  my $self = shift;
  printf("%10s %12s\n", 'ITEM', 'INR Value');
  printf("%10s-%12s\n", '----------', '------------');
  printf("%10s %12.2f\n", 'EV', $self->EV);
  printf("%10s %12.2f\n", 'PV', $self->PV);
  printf("%10s %12.2f\n", 'AC', $self->AC);
  printf("%10s-%12s\n", '----------', '------------');
  printf("%10s %12.2f\n", 'SPI', $self->SPI);
  printf("%10s %12.2f\n", 'CPI', $self->CPI);
  printf("%10s-%12s\n", '----------', '------------');
  print "\n";
  $self->log_Me if $self->has_Diary;
};

sub printCostStructure {
  my $self = shift;
  my $dashboard;
  return unless $self->MyCost->can('ActivityCost');
  $dashboard = $self->MyCost->ActivityCost; 
 
  printf(" %10s %12s\n", 'ACTIVITY', 'INR Value');
  printf(" %10s-%12s\n", '----------', '------------');
  my @theItems = sort(keys(%{$dashboard}));
  foreach my $thisItem (@theItems) {
    printf(" %-10s %12.2f\n", $thisItem, $dashboard->{$thisItem});
  };
  printf(" %10s-%12s\n", '----------', '------------');
  return $dashboard;
}

[9.]
Methods - queryMe, _querySpreadsheet_singleCell, _querySpreadsheet_Range
The are querying methods that use Win32 automation (Win32::OLE) to work with Microsoft Excel data. The wrapper method 'queryMe' is invoked with the value stashed in 'Range' and returns the content as a data-structure (reference). It deploys the internal 'helper' functions (name beginning with an underscore) where the spreadsheet operations actually take place. The wrapper determines what is the appropriate functionality to use based on the arguments passed.

 
sub queryMe {
# method returns contents of a cell or the cells in a specified range as 2D array.
  my $self = shift; my $sheet = shift;
  return unless $self->has_Range;
  $sheet = 1 unless $sheet;
 
  my $myRange = $self->Range;
  if ($myRange =~ /:/ ) {
    $self->_querySpreadsheet_Range($myRange, $sheet);
  } else {
    $self->_querySpreadsheet_singleCell($myRange, $sheet);
  };
 
};

sub _querySpreadsheet_singleCell {
# method returns contents of a single cell.
  my $self = shift;
  my $cell = shift;
  my $sheet = shift;
  $sheet = 1 unless $sheet;

  my $excel = OLE->CreateObject("Excel.Application");
  my $source = $self->activeSpreadsheet;
         
  my $workbook = $excel->Workbooks->Open($source) || die "Unable to open!";
  my $evSheet_namu =  $workbook->Worksheets($sheet)->{Name};
  my $evSheet =   $workbook->Worksheets($evSheet_namu);

  my $data = $evSheet->Range($cell);  my $dataValue = $data->{Value};
# print '| ' . $evSheet_namu . ' | ' . $cell . ' | ' . $dataValue . ' |';
  $workbook->Close; 

  return $dataValue;
};

sub _querySpreadsheet_Range {
# method returns contents of a range of cells (2D array).
  my $self = shift;
  my $range = shift; 
  my $sheet = shift;
  $sheet = 1 unless $sheet;

  my $excel = OLE->CreateObject("Excel.Application");
  my $source = $self->activeSpreadsheet;
        
  my $workbook = $excel->Workbooks->Open($source) || die "Unable to open ($source)!";
  my $evSheet_namu =  $workbook->Worksheets($sheet)->{Name};
  my $evSheet =   $workbook->Worksheets($evSheet_namu);

  my $data = $evSheet->Range($range);  my $dataValue = $data->{Value};
# print '| ' . $evSheet_namu . ' | ' . $range . ' |';
  $workbook->Close; 

  return $dataValue;
};

[10.]
Methods - log_Me
This is an Exception Central - uses Exception::Class stack-trace functionality to record logs and (of course) to imprint the stack trace upon the logs when exceptions occur and the code breaks. Did you notice 'EV::Exception::Base::Logger' in Exception::Class? That's what this is about.

 
sub log_Me {
  my $self = shift;
  my $e = shift;
  my $diary = $self->Diary;
  my $eMsg = '';
 
  open(INFO, ">>$diary");  
  unless ($e) {            
    print INFO &timeStamp, " OK ";
    eval {
      EV::Exception::Base::Logger->throw;  
    };
    my $e;
    if ($e = EV::Exception::Base::Logger->caught) { 
      my @lines = ();
      foreach my $thisLine (split("\n", $e->trace)) { 
        push @lines, $thisLine  if ($thisLine =~ 'EarnedValue::'); 
      }
      print INFO join(' | ', @lines);
    } #fi
  } elsif ($e->isa('Cost::Exception::Base')) {
    $eMsg = Cost::Exception::Base->description . " -> ";
    $eMsg .= Cost::Exception::Base::MissingData->description 
                if $e->isa('Cost::Exception::Base::MissingData');
    print INFO &timeStamp, " ERROR ";
    print INFO $e->error;
    print INFO $e->trace;
    print INFO $eMsg;
  } elsif ($e->isa('Schedule::Exception::Base')) {
    $eMsg = Schedule::Exception::Base->description . " ";
    $eMsg .= Schedule::Exception::Base::InvalidState->description
                if $e->isa('Schedule::Exception::Base::InvalidState');
    print INFO &timeStamp, " ERROR ";
    print INFO $e->error;
    print INFO $e->trace;
    print INFO $eMsg;
  }
  close INFO;
}

So how did laziness become a virtue in these 10 simple steps? The complete code is provided below, and may also be downloaded from the site. We have seen how all computation is triggered by access - Just In Time (JIT). No computational resources are wasted loading data that is not required. No inventory is maintained, unless required. Let's reinforce this with a scenario:

1. A request for SPI (EarnedValue::SPI)..
2. triggers a JIT request for EV, PV (EarnedValue::EV, EarnedValue::PV) ..
3. setting off Schedule accessors: Schedule::EVnumbers, Schedule::PVnumbers
4. that consume Roles defined in the main EarnedValue class: EarnedValue::queryMe
5. to pull data off spreadsheet into Object slots:
Schedule::EVnumbers, Schedule::PVnumbers
6. for processing into interim results via Schedule methods:
Schedule::tally_EVnumbers, Schedule::tally_PVnumbers
7. which are then stuffed into slots in the main EarnedValue class:
EarnedValue::EV, EarnedValue::PV
8. thus stuffing the slot EarnedValue::SPI
9. and producing the desired result.

The complete class-def for EarnedValue is reproduced below. For Schedule and Cost implementation, please refer the code posted on the Google site (link at the end of page).

Here is what the complete EarnedValue module looks like:

package EarnedValue;
use Moose;
use OLE;
use Win32::OLE::Const "Microsoft Excel";
use File::Spec;
use Moose::Util::TypeConstraints;
use Params::Coerce ();
use Data::Dumper;

use Exception::Class (
  'EV::Exception::Base' => {
    description => 'Base Exception Class',
  },
  'EV::Exception::Base::Logger' => {
    isa   => 'EV::Exception::Base',
    description => 'Simply logging!',
  },
  'EV::Exception::Base::InvalidState' => {
    isa   => 'EV::Exception::Base',
    fields  => [ 'EV', 'PV', 'AC'],
    description => 'Invalid state',
  },
  'EV::Exception::Base::MissingData' => {
    isa   => 'EV::Exception::Base',
    fields  => [ 'EV', 'PV', 'AC'],
    description => 'Incomplete information',
  },
);

local $SIG{__DIE__} = sub {
  my $err = shift;
  if ($err->isa('EV::Exception::Base')) {
    die $err; 
  } elsif ($err->isa('Cost::Exception::Base')) {
    die $err; 
  } elsif ($err->isa('Schedule::Exception::Base')) {
    die $err;
  } else {
    EV::Exception::Base->throw($@);
  }
  print $@;
};

subtype 'extantFile'
  => as Str
  => where {
      (    -e $_  );
    };

has 'activeSpreadsheet'   => (
    is        =>  'rw',
    isa       =>  'extantFile',
    predicate =>  'has_activeSpreadsheet',
#   trigger   =>  \&timeStamped_copy
);

has 'Spreadsheet_Schedule'   => (
    is        =>  'rw',
    isa       =>  'extantFile',
    predicate =>  'has_spreadsheetSchedule',
    default   =>  \&evGantt,
);

has 'Spreadsheet_Cost'    => (
    is        =>  'rw',
    isa       =>  'extantFile',
    predicate =>  'has_spreadsheetCost',
    default   =>  \&evBasecamp,
);

has 'Diary'   => (
    is        =>  'rw',
    isa       =>  'Str',
    default   =>  \&evLog,
    predicate =>  'has_Diary',
    clearer   =>  'clear_Diary',
);

has 'EV'      => (
    is        =>  'rw',
    isa       =>  'Num',       
    default   =>  \&calculateEV,
    lazy      =>  1,  
);

has 'PV'      => (
    is        =>  'rw',
    isa       =>  'Num',
    default   =>  \&calculatePV,
    lazy      =>  1,  
);

has 'AC'      => (
    is        =>  'rw',
    isa       =>  'Num',     
    default   =>  \&calculateAC,
    lazy      =>  1,
);

has 'SPI'     => (
    is        =>  'rw',
    isa       =>  'Num', 
    default   =>  \&calculateSPI,
    lazy      =>  1,
);

has 'CPI'     => (
    is        =>  'rw',
    isa       =>  'Num',       
    default   =>  \&calculateCPI,
    lazy      =>  1,    
);

has 'MySchedule'    => (
    is        =>  'rw',
    isa       =>  'Schedule',    
);

has 'MyCost'  => (
     is       =>  'rw',
     isa      =>  'Cost',    
);

has 'multiplying_factor'  => (
    is        =>  'rw',
    isa       =>  'Num',       
    default   =>  1000,
);

subtype 'CellRange'
 => as Str
 => where {
     (    /^[a-zA-Z]{1,2}\d+$/  ||  /^[a-zA-Z]{1,2}\d+?:[a-zA-Z]{1,2}\d+$/);
    };

has 'Range'   =>  (
    is        =>  'rw',
#   isa       => 'CellRange',
    isa       => 'Str',
    predicate => 'has_Range',
    clearer   => 'clear_Range',
);

sub calculateEV {
  my $self = shift;
  my $EV;
  eval {
    $EV = $self->MySchedule->tally_EVnumbers->[0] * $self->multiplying_factor;
  };
  my $e;
  if ($e = Schedule::Exception::Base->caught) {
    $self->log_Me($e);
  } else { 
    $self->log_Me if $self->has_Diary;
  }
 
  return  $EV;
};

sub calculatePV {
  my $self = shift;
  my $PV;
  eval {
    $PV = $self->MySchedule->tally_PVnumbers->[0] * $self->multiplying_factor;
  };
  my $e;
  if ($e = Schedule::Exception::Base->caught) {
    $self->log_Me($e);
  } else { 
    $self->log_Me if $self->has_Diary;
  }
 
  return $PV;
};

sub calculateAC {
  my $self = shift;
  my $AC;
 
  eval {
    $AC = $self->MyCost->tally_ACnumbers;
  };
  my $e;
  if ($e = Cost::Exception::Base->caught) {
    $self->log_Me($e);
  } else {
    $self->log_Me if $self->has_Diary;
  };  
 
  return $AC;
};

sub calculateSPI {
  my $self = shift;
  my ($netEV,$netPV);
  my $SPI;
  eval {
    $netEV = $self->EV;
    $netPV = $self->PV;
  };
  my $e;
  if (   ($e = Cost::Exception::Base->caught) 
      || ($e =   Schedule::Exception::Base->caught)) {
    $self->log_Me($e);
  } else {
    $self->log_Me if $self->has_Diary;
    $SPI = $netEV/$netPV;
  };
 
  return $SPI;
};

sub calculateCPI {
  my $self = shift;
  my ($netEV,$netAC);
  my $CPI;
  eval {
    $netEV = $self->EV;
    $netAC = $self->AC;
  };
  my $e;
  if    (($e = Cost::Exception::Base->caught) 
      || ($e = Schedule::Exception::Base->caught)) {
    $self->log_Me($e);
  } else {
    $self->log_Me if $self->has_Diary;
    $CPI = $netEV/$netAC;
  };
 
  return $CPI;
};

sub printExecutiveSummary {
  my $self = shift;
  printf("%10s %12s\n", 'ITEM', 'INR Value');
  printf("%10s-%12s\n", '----------', '------------');
  printf("%10s %12.2f\n", 'EV', $self->EV);
  printf("%10s %12.2f\n", 'PV', $self->PV);
  printf("%10s %12.2f\n", 'AC', $self->AC);
  printf("%10s-%12s\n", '----------', '------------');
  printf("%10s %12.2f\n", 'SPI', $self->SPI);
  printf("%10s %12.2f\n", 'CPI', $self->CPI);
  printf("%10s-%12s\n", '----------', '------------');
  print "\n";
  $self->log_Me if $self->has_Diary;
};

sub printCostStructure {
  my $self = shift;
  my $dashboard;
  return unless $self->MyCost->can('ActivityCost');
  $dashboard = $self->MyCost->ActivityCost; 
 
  printf(" %10s %12s\n", 'ACTIVITY', 'INR Value');
  printf(" %10s-%12s\n", '----------', '------------');
  my @theItems = sort(keys(%{$dashboard}));
  foreach my $thisItem (@theItems) {
    printf(" %-10s %12.2f\n", $thisItem, $dashboard->{$thisItem});
  };
  printf(" %10s-%12s\n", '----------', '------------');
  return $dashboard;
}

sub evGantt {
  my $folder = File::Spec->curdir();
  my $file = q{Dashboard.xls};
  return File::Spec->rel2abs(File::Spec->catfile($folder, $file));
};

sub evBasecamp {
  my $folder = File::Spec->curdir();
  my $file = q{time-export.csv};
  return File::Spec->rel2abs(File::Spec->catfile($folder, $file));
}

sub evLog {
  my $folder = File::Spec->curdir();
  my $file = q{main.log};
  return File::Spec->rel2abs(File::Spec->catfile($folder, $file));
};

sub timeStamped_copy {
# for safety, make a time-stamped copy before the spreadsheet is accessed.
  my $self = shift;
};

sub queryMe {
# method returns contents of a cell or the cells in a specified range as 2D array.
  my $self = shift; my $sheet = shift;
  return unless $self->has_Range;
  $sheet = 1 unless $sheet;

 
  my $myRange = $self->Range;
  if ($myRange =~ /:/ ) {
    $self->_querySpreadsheet_Range($myRange, $sheet);
  } else {
    $self->_querySpreadsheet_singleCell($myRange, $sheet);
  };
 
};

sub _querySpreadsheet_singleCell {
# method returns contents of a single cell.
  my $self = shift;
  my $cell = shift;
  my $sheet = shift;
  $sheet = 1 unless $sheet;

  my $excel = OLE->CreateObject("Excel.Application");
  my $source = $self->activeSpreadsheet;
        
  my $workbook = $excel->Workbooks->Open($source) || die "Unable to open!";
  my $evSheet_namu =  $workbook->Worksheets($sheet)->{Name};
  my $evSheet =   $workbook->Worksheets($evSheet_namu);

  my $data = $evSheet->Range($cell);  my $dataValue = $data->{Value};
# print '| ' . $evSheet_namu . ' | ' . $cell . ' | ' . $dataValue . ' |';
  $workbook->Close; 

  return $dataValue;
};

sub _querySpreadsheet_Range {
# method returns contents of a range of cells (2D array).
  my $self = shift;
  my $range = shift; 
  my $sheet = shift;
  $sheet = 1 unless $sheet;

  my $excel = OLE->CreateObject("Excel.Application");
  my $source = $self->activeSpreadsheet;
         
  my $workbook = $excel->Workbooks->Open($source) || die "Unable to open ($source)!";
  my $evSheet_namu =  $workbook->Worksheets($sheet)->{Name};
  my $evSheet =   $workbook->Worksheets($evSheet_namu);

  my $data = $evSheet->Range($range);  my $dataValue = $data->{Value};
# print '| ' . $evSheet_namu . ' | ' . $range . ' |';
  $workbook->Close; 

  return $dataValue;
};

sub log_Me {
  my $self = shift;
  my $e = shift;
  my $diary = $self->Diary;
  my $eMsg = '';
 
  open(INFO, ">>$diary");
  unless ($e) {
    print INFO &timeStamp, " OK ";
    eval {
      EV::Exception::Base::Logger->throw; 
    };
    my $e;
    if ($e = EV::Exception::Base::Logger->caught) { 
      my @lines = ();
      foreach my $thisLine (split("\n", $e->trace)) {
        push @lines, $thisLine  if ($thisLine =~ 'EarnedValue::'); 
      }
      print INFO join(' | ', @lines);
    } #fi
  } elsif ($e->isa('Cost::Exception::Base')) {
    $eMsg = Cost::Exception::Base->description . " -> ";
    $eMsg .= Cost::Exception::Base::MissingData->description 
                if $e->isa('Cost::Exception::Base::MissingData');
    print INFO &timeStamp, " ERROR ";
    print INFO $e->error;
    print INFO $e->trace;
    print INFO $eMsg;
  } elsif ($e->isa('Schedule::Exception::Base')) {
    $eMsg = Schedule::Exception::Base->description . " ";
    $eMsg .= Schedule::Exception::Base::InvalidState->description
                if $e->isa('Schedule::Exception::Base::InvalidState');
    print INFO &timeStamp, " ERROR ";
    print INFO $e->error;
    print INFO $e->trace;
    print INFO $eMsg;
  }
  close INFO;
}

sub timeStamp {
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
  my $tstamp = sprintf 
               "\[%02d\-%02d\-%4d : %02d\-%02d\-%02d\]",
               mon+1,$mday,$year+1900,$hour,$min,$sec;
  return $tstamp;
}

All code in this series may be downloaded from:
http://sites.google.com/site/sanjaybhatikar/codeunquote/designpatterns-1