Copyright Notice

This text is copyright by InfoStrada Communications, Inc., and is used with their permission. Further distribution or use is not permitted.

This text has appeared in an edited form in Linux Magazine magazine. However, the version you are reading here is as the author originally submitted the article for publication, not after their editors applied their creativity.

Please read all the information in the table of contents before using this article.

Linux Magazine Column 56 (Feb 2004)

[suggested title: ``Prototype Programming for Classless Classes'']

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

I figured that with the number of times I tell other people to ``use the CPAN, please'', that I'd find something reusable there for my application. I looked at a number of CPAN modules, but 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 had decided to make a clean cut between the MVC (Model, View, Controller) parts. My Model code would be Class::DBI-based, because I had gotten a lot of mileage from using that on a prior project. My View code would of course be Template-Toolkit driven, just because it just works. So, I was writing the Controller code.

I had suspected that most of the controller would look the same for most of the pages, in pseudo-code something like:

    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 the 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 picking 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 then 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, and nested hierarchically and easy to build. Thankfully, one of the last untired neurons fired in my brain, recalling the Class::Prototyped module, because I had a situation that precisely fit the When to Use this Module paragraph from the manpage:

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 autogenerated 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;
      },
    );

We've 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 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 id 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, 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" },
    );

And 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. Surely, 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. Schwartz is a renowned expert on the Perl programming language (the lifeblood of the Internet), having contributed to a dozen top-selling books on the subject, and over 200 magazine articles. Schwartz runs a Perl training and consulting company (Stonehenge Consulting Services, Inc of Portland, Oregon), and is a highly sought-after speaker for his masterful stage combination of technical skill, comedic timing, and crowd rapport. And he's a pretty good Karaoke singer, winning contests regularly.

Schwartz can be reached for comment at merlyn@stonehenge.com or +1 503 777-0095, and welcomes questions on Perl and other related topics.