dcsimg

Programming Class-less Classes

Recently, I found myself hacking a web application for a customer. If you've written a web application or two, you know the type: a multi-page web form where the fields need to be validated, stored into session data, and then finally dispatched into the next phase.

Recently, I found myself hacking a web application for a customer. If you’ve written a web application or two, you know the type: a multi-page web form where the fields need to be validated, stored into session data, and then finally dispatched into the next phase.

Since I’m always carping, “Use the CPAN, please,” I thought I’d find something reusable there for my application. However, after I looked at a number of CPAN modules, I didn’t find what I wanted. CGI::Application looked close, but had more knobs and dials than I needed, and yet not enough custom hooks either.

So, I sat down to write my own. I decided to make a clean cut between the Model, View, and Controller (MVC) parts. My Model code would be Class::DBI-based, because I’d gotten a lot of mileage from it on a prior project. My View code would, of course, be Template-Toolkit driven, because it just works. So, all that was left was the Controller code.

I suspected that most of the Controller would look the same for most of the pages. In pseudo-code, it might look something like this:

if (determine_current_page()) {

if (page_fields_validate() and can_store_page()) {

select_next_page();

load_page_data();

} else {

pick_a_default_page();

load_page_data();

}

}

display_the_page();

On the first coding, I decided that this was more than pseudo-code: it was already Perl. (That happens a lot for me.) But I also knew that the steps to validate a page, store a page, load the page data, and pick the next page would be different (but similar) for each page.

Based on prior experience, I started by putting the data into a hash table, with a lot of little coderefs acting as “callbacks.” I’d see if something was there, and if it was, I’d call it.


my %pages = (
initial => {
next_page => sub { ‘personal’ },
},
personal => {
load => sub {
# load session info for personal page
},
validate => sub {
# verify name/address/city
},
store => sub {
# store session info for personal page
},
next_page =>
\&handle_forward_back_buttons,
},

);

So, my top-level code became:


my $page =
get_current_page(); # looks at a param

if ($page) {
if (($pages{$page}{validate} ?
$pages{$page}{validate}->() : 1) and
($pages{$page}{store} ?
$pages{$page}{store}->() : 1)) {
$page = $pages{$page}{next_page}->();
$pages{$page}{load}->() if
$pages{$page}{load};
} else {
$page = default_page();
$pages{$page}{load}->() if $pages{$page}{load};
}
}

display($page);

And this got me far enough along that I could take a first cut at my design. Any page that needed a load, store, or validate would simply get a new entry in the master hash table.

But then I started wanting the same “next page” routine for some of the pages, but not others. And the validate routine was also looking the same for a number of the pages.

What I really wanted wasn’t a table of pages, but a bunch of classes and subclasses, some with callbacks, others with data members, all nested hierarchically and easy to build. Thankfully, one of the last neurons I had left fired in my brain, recalling the Class::Prototyped module, because I now had a situation that precisely fit the “When to Use this Module” paragraph from its man page:

When I reach for Class::Prototyped, it’s generally because I really need it. When the cleanest way of solving a problem is for the code that uses a module to subclass from it, that is generally a sign that Class::Prototyped would be of use. If you find yourself avoiding the problem by passing anonymous subroutines as parameters to the new() method, that’s another good sign that you should be using prototype-based programming. If you find yourself storing anonymous subroutines in databases, configuration files, or text files, and then writing infrastructure to handle calling those anonymous subroutines, that’s yet another sign. When you expect the people using your module to want to change the behavior, override subroutines, and so forth, that’s a sign.

Using Class::Prototyped

What is a Class::Prototyped object? It’s a singleton class, in the sense that each class has its own instance and each instance has its own class.

For example, we can create an object as:


use Class::Prototyped;
my $o = Class::Prototyped->new;

The object in $o is a unique class, using an automatically-generated name. But this object doesn’t have any behavior or values. To do that, we can add some when we create the object, or add them later. For example:


use Class::Prototyped;
my $o = Class::Prototyped->new(
id => 12345,
next_id => sub {
my $self = shift;
$self->id($self->id + 1);
return $self->id;
},
);

Here, the code’s now created an object $o that has a field (member variable) called id and a method called next_id. The fields have traditional setter/getter methods automatically created, so we can get the current value or set it:


print $o->id, “\n”; # prints 12345\n
$o->id(78); # sets id to 78

And we can call the methods of the new object similarly:


print $o->next_id, “\n”; # prints 79\n

The field and methods here are generically called slots in Class::Prototyped‘s documentation, borrowing the terminology from the Self language. Another type of slot is a parent slot, which defines an inheritance. Parent slots are named with a trailing asterisk to distinguish them from field or method slots.

For example, we can “derive a class” from our object like so:


my $p = Class::Prototyped->new(
‘parent*’ => $o,
prev_id => sub {
my $self = shift;
$self->id($self->id – 1);
return $self->id;
},
);

Now, calling the idc) method on $p ripples up through the parent slot, finding the value 79. And calling prev_id or next_id() alters this shared value. If you don’t want the slots shared, you can instantiate a new one:


my $p = Class::Prototyped->new(
‘parent*’ => $o,
id => $o->id,
prev_id => sub {
my $self = shift;
$self->id($self->id – 1);
return $self->id;
},
);

Now, although the next_id() method on $p gets its code from $o (because of the parent slot), the actions are performed on the member variable in $p. If I really wanted to remove any linkage from $p to $o, but make $p be “like” $o initially, I can call clone instead:


my $p = $o->clone(
prev_id => sub {
my $self = shift;
$self->id($self->id – 1);
return $self->id;
},
);

Now there’s no lingering relationship between the objects. $p starts out with a copy of everything that $o knew how to do and then branches out adding its own additional method to decrement the id. Slots can also have attributes. For example, if the id should have been a read-only field, we can add that by using an arrayref instead of a scalar for the slot name:


my $c = Class::Prototyped->new(
[qw(id FIELD constant)] => 35,
);

Now, any attempt to change id is an error:


$c->id(56); # not permitted

A slot can also be marked autoload, which causes its coderef to be run on the first access to compute the actual value:


my $d = Class::Prototyped->new(
[qw(expensive FIELD autoload)] => sub {
# code to compute $self->expensive
return $final_value,
},
);

The advantage is that the value is lazily computed, deferring the expensive calculation until runtime.

Behind the scenes, Class::Prototyped is creating traditional packages and using standard @ISA searching and method lookup, so once the “classless” classes are established, the object accesses are as fast as normal Perl objects.

Slots can be added after the object is instantiated as well. We do this using a mirror, which is a simple mechanism to keep the meta-messages about the object separated cleanly from messages to the object itself. A mirror is created by calling reflect. To add the prev_id method directly to the $o object created earlier, we can call:


$o->reflect->addSlots(
prev_id => sub {
my $self = shift;
$self->id($self->id – 1);
return $self->id;
},
);

The mirror can also be used to remove slots, change parent inheritance or order of search, and provide introspection into the slots (including parent slots).

Now, Back to Our Programming

Now, getting back to the original task at hand, let’s look at how I solved it with Class::Prototyped. I created a prototype object/class to perform the core of my application:


use Class::Prototyped;
my $proto = Class::Prototyped->new(
activate => sub {
my $self = shift;
my $page = $self->current_page;
if ($page) { #
it’s a response
if ($page->validate and
$page->store) {
$page = $page->next_page;
$page->fetch;
}
} else {
# it’s an initial call
$page = $self->default_page;
$page->fetch;
}
$page->render;
# show the selected page
},
[qw(fetch constant)] => 1,
# do nothing by default
[qw(store constant)] => 1,
# return 1 to say it stored OK
[qw(validate constant)] => 1,
# return 1 to say it validated
next_page => sub { return shift; },
# stay here
render => sub { die “subclass
responsibility” },
current_page => sub { die
“subclass responsibility” },
default_page => sub { die
“subclass responsibility” },
);

Then I could specialize this in multiple layers. For example, the generic behavior for rendering all pages could be added like:


use CGI qw(param);

my $app = Class::Prototyped->new(
‘parent*’ => $proto, # inherit
values/behavior
render => sub { # invoke template
toolkit here
},
pages => {}, # hash of pages by name
current_page => sub {
my $self = shift;
$self->pages->{param(‘_page’)};
},
default_page => sub {
my $self = shift;
$self->pages->{initial};
},
};

I’d then populate the $app->pages hash with page objects, which would be further derived from $app:


$app->pages->{initial} = Class::Prototyped->new(
‘parent*’ => $app,
load => sub { … },
# specialized load routine
);

When I have a bunch of pages that all have the same next_page method, I can create a separate template for them:


my $middle_form = Class::Prototyped->new(
‘parent*’ => $app,
next_page => sub { … },
};
$app->pages->{middle_form1} =
Class::Prototyped->new(
‘parent*’ => $middle_form,
…,
);

$app->pages->{middle_form2} =
Class::Prototyped->new(
‘parent*’ => $middle_form,
…,
);

$app->pages->{middle_form3} =
Class::Prototyped->new(
‘parent*’ => $middle_form,
…,
);

Using this pattern, I end up with behavior and values inheriting in a manageable, but ad hoc fashion. Sure, I could have done this all with named classes, but it just seemed faster and simpler using Class::Prototyped.

So, consider this interesting module the next time you’re faced with far too many callbacks. Until next time, enjoy!



Randal L. Schwarz can be reached at merlyn@stonehenge.com.

Comments are closed.