dcsimg

The Moose is Flying, Part One

Build better classes faster with the new Perl package named Moose.

Perl’s object system is very” flexible,” meaning that you get to build it from the ground up. You can build traditional hash-based objects, or more exotic forms, such as array-based or inside-out objects. However, in the two latter cases, you also have the onus to create the accessors, define access policies, and write a lot of repetitive code.

Luckily, Perl is introspective enough that you can get it to do most of the hard, boring work for you. Indeed, a number of simplifying” class frameworks” can now be found in the CPAN. The Moose framework appeared about a year ago, and I initially dismissed it as” yet another class framework”, much as I feel about yet another template system and yet another object-relational mapper (ORM).

However, I recently took a look at what Moose has become and was pleasantly surprised. As I started playing with it, I exclaimed frequently that Moose would have saved me quite a bit of time on some past projects, such as the text I wrote for the Intermediate Perl course and book, parts of which have been included as the perlboot man page in the Perl distribution.

Let’s recreate the” animal” classes from that text, using Moose, to see how this emerging framework simplifies things.

First, create a horse class in Horse.pm that has a name and a color:

package Horse;
use Moose;
has 'name' => (is => 'rw');
has 'color' => (is => 'rw');
1;

Importing Moose defines has, which takes the name of an attribute and its properties. Here, the two attributes are” read/write.” You can now use this class as you would any other:

use Horse;
my $talking = Horse->new(name => "Mr. Ed");
print $talking->name; # prints Mr. Ed
$talking->color("grey"); # sets the color

There’s no new() method: Moose creates that for me.

Now, in the original text of the book, Horse inherited from Animal. You can do that rather simply. If Animal.pm looks llke this…

package Animal;
use Moose;
has 'name' => (is => 'rw');
has 'color' => (is => 'rw');
1;

… the updated Horse.pm looks ike this:

package Horse;
use Moose;
extends 'Animal';
1;

extends replaces the traditional use base and completely sets @ISA, rather than add to it. (It may be preferable to place this code this inside a BEGIN block, although I’ve not seen any examples that require it yet.)

At this point, Horse and Animal are identical. Both can be instantiated, and both have the two given attributes.

In the original example, what distinguished a horse was the sound it made, which you can add here:

package Horse;
use Moose;
extends 'Animal';
sub sound { 'neigh' }
1;

You can then reference that in the common speak method in Animal:

package Animal;
use Moose;
has 'name' => (is => 'rw');
has 'color' => (is => 'rw');

sub speak {
	 my $self = shift;
  print $self->name, " goes ", $self->sound, "\n";
}

sub sound {
	   confess shift, " should have defined sound!"
}

1;

confess is another freebie from Moose. If the derived class fails to define a sound() method, I want to complain. But since Horse defines sound, I’ll never see that for a horse.

With this code, I can create my classic talking horse:

my $talking = Horse->new(name => 'Mr. Ed');
$talking->speak; # says "Mr. Ed goes neigh"

So far, I’m still coding things that would be simple without Moose, so let’s diverge a bit to see the package’s full power. First, an Animal is really an abstract class, being used only to provide common attributes and methods to a concrete class (in this case, the Horse class). In Moose-terminology, this can best be described as a role. A role is like a mix-in, providing a collection of attributes and methods that use those attributes. A role never has any instances, because it’s not a complete class.

When you make Animal a role, you also get some additional support:

package Animal;
use Moose::Role;
has 'name' => (is => 'rw');
has 'color' => (is => 'rw');

sub speak {
	  my $self = shift;
  print $self->name, " goes ", $self->sound, "\n";
}

requires 'sound';
1;

The previous code snippet replaces the confess- including stub with requires. This informs Moose that this role must now be used with a class that provides a sound() method, which will be checked at compile-time. To pull in a role, use with rather than extends:

package Horse;
use Moose;
with 'Animal';
sub sound { 'neigh' }
1;

Had you failed to define a sound() method, you’d get notification very early on. Cool. At this point, Horse otherwise still works as before.

What about those with and requires keywords? Because both are defined by the Moose and Moose::Role imports, the keywords remain as part of the package. For the purists who don’t like that kind of pollution, you can throw them away when you’re done, using the correponding no keyword (similiar to use strict and no strict).

For example, to clean up Horse.pm, try:

package Horse;
use Moose;
with 'Animal';
sub sound { 'neigh' }
no Moose; # gets rid of scaffolding
1;

And similarly, Animal.pm has the statement no Moose::Role at the end.

Moose supports the notion of a default value. Let’s add in the default color, and make that a class responsibility as well:

package Animal;

…
has 'color' => (is => 'rw', default => sub { shift->default_color });
requires 'default_color';
…

If the color isn’t provided, the default color of the class is consulted, and requires ensures that the concrete class provides this default color.

The derived animal classes now look like:

## Cow.pm:
package Cow;
use Moose;
with 'Animal';
sub default_color { 'spotted' }
sub sound { 'moooooo' }
no Moose;
1;

## Horse.pm:
package Horse;
use Moose;
with 'Animal';
sub default_color { 'brown' }
sub sound { 'neigh' }
no Moose;
1;

## Sheep.pm:
package Sheep;
use Moose;
with 'Animal';
sub default_color { 'black' }
sub sound { 'baaaah' }
no Moose;
1;

Now you can count Sheep as one of the implemented classes:

use Sheep;
my $baab = Sheep->new(color => 'white', name => 'Baab');
$baab->speak; # prints "Baab goes baaaah"

Well, this is pretty straightforward. Let’s solve a few other problems from the original material.

The Mouse class was special, because it extended the speak method with an additional line of output. While you could use traditional SUPER::- based method calls to call parent-class behaviors, this doesn’t work with roles. (Roles don’t end up in @ISA, because they’re” glued in” rather than” tacked above”.)

Luckily, Moose provides the convenient after call to append additional steps to an existing subroutine. Moose does this by replacing the original subroutine with a new subroutine that calls the original routine and then calls the additional code. The context (list, scalar, or void) is properly preserved, as is the original return value.

The amended speak looks something like:

package Mouse;
use Moose;
with 'Animal';
sub default_color { 'white' }
sub sound { 'squeak' }
after 'speak' => sub {
	print "[but you can barely hear it!]\n";
};

no Moose;

1;

This yields a properly functioning Mouse…

my $mickey = Mouse->new(name => 'Mickey');
$mickey->speak;

… which results in:

Mickey goes squeak
[but you can barely hear it!]

You can also use before and around to precede the original behavior or control the calling of the original behavior, as necessary. For example, to allow name to be used as both an accessor and still return an unnamed Horse when used as a class method, you can” around” the resulting name accessor:

package Animal;
...
has 'name' => (is => 'rw');
around 'name' => sub {
		my $next = shift;
  my $self = shift;
  blessed $self ? $self->$next(@_) : "an unnamed $self";
};

The has creates the original behavior. The around intercepts the original subroutine name, causing the original coderef to be passed as the first parameter to this new subroutine, which is captured in $next. The original $self is shifted away and tested to see if it’s an object or not via blessed (conveniently exported via Moose). For a blessed object, you get the original behavior (a getter or setter), but for a class, you get the literal string.

What if we never gave the animal a name? You’d receive warnings about undefined values. You can give a default name just as you did a default color:

has 'name' => (
	is => 'rw',
	  default => sub { 'an unnamed ' . ref shift },
);

Again, you want that around immediately following this step.

If you don’t want people setting the color after the initial instance creation, you can declare the attribute as read-only:

has 'color' => (is => 'ro', default => sub { shift->default_color });

Now an attempt to set the color is aborted with Cannot assign a value to a read-only accessor.... If you really wanted a way to occasionally set the color, you can define a separately named writer:

has 'color' => (
	   is => 'ro',
	  writer => 'private_set_color',
   default => sub { shift->default_color },
);

Thus, you can’t change the color of a Mouse directly:

my $m = Mouse->new;
my $color = $m->color; # gets the color
$m->color('green'); # DIES

Instead, use the private name instead:

$m->private_set_color('green'); # sets the color to green

By using a long name, I’m less likely to accidentally call it, except to intentionally change the color.

Let’s create a RaceHorse by adding” race features” to a Horse.

First, define the” race features” as, yes, another role:

package Racer;
use Moose::Role;
has $_ => (is => 'rw', default => 0)
foreach qw(wins places shows losses);
no Moose::Role;
1;

Since has is just a subroutine call, you can use

traditional Perl control structures (here, a foreach loop). With a bit of code, another four attributes have been added. The initial value of 0 means you don’t have to write separate initialization code in the constructor.

Next, add some accessors:

package Racer;
…
sub won { my $self = shift; $self->wins($self->wins + 1) }
sub placed { my $self = shift; $self->places($self->places + 1) }
sub showed { my $self = shift; $self->shows($self->shows + 1) }
sub lost { my $self = shift; $self->losses($self->losses + 1) }

sub standings {
		my $self = shift;
  join ", ", map { $self->$_ . " $_" } qw(wins places shows losses);
}

Each call to won increments the number of wins. This would be simpler if you presumed that these objects are implemented as hashes (which they are by default), as:

sub won { shift->{wins}++; }

However, by using the public interface (a method call), you could change the internal implementation later to inside-out objects or array-based objects without breaking this code. This is especially important when creating a generic role, which could be mixed in to any kind of object.

To create the race horse, we just mix a Horse with a racer:

package RaceHorse;
use Moose;
extends 'Horse';
with 'Racer';
no Moose;
1;

And now, you can ride the ponies:

use RaceHorse;
my $s = RaceHorse->new(name => 'Seattle Slew');
$s->won; $s->won; $s->won; $s->placed; $s->lost; # run some races
print $s->standings, "\n"; # 3 wins, 1 places, 0 shows, 1 losses

So far, I’ve just scratched the surface of what Moose provides. Next month, I’ll look at some of the more advanced features of Moose that help keep the complex things relatively simple. Until then, enjoy!

Fatal error: Call to undefined function aa_author_bios() in /opt/apache/dms/b2b/linux-mag.com/site/www/htdocs/wp-content/themes/linuxmag/single.php on line 62