5 Moose::Unsweetened - Moose idioms in plain old Perl 5 without the sugar
9 If you're trying to figure out just what the heck Moose does, and how
10 it saves you time, you might find it helpful to see what Moose is
11 I<really> doing for you. This document shows you the translation from
12 Moose sugar back to plain old Perl 5.
14 =head1 CLASSES AND ATTRIBUTES
16 First, we define two very small classes the Moose way.
21 use DateTime::Format::Natural;
23 use Moose::Util::TypeConstraints;
31 # Moose doesn't know about non-Moose-based classes.
32 class_type 'DateTime';
34 my $en_parser = DateTime::Format::Natural->new(
41 => via { $en_parser->parse_datetime($_) };
51 => where { /^(?:s|m|l|xl|xxl)$/i }
52 => message { "$_ is not a valid shirt size (s, m, l, xl, xxl)" };
60 This is a fairly simple class with three attributes. We also define a
61 type to validate t-shirt sizes because we don't want to end up with
62 something like "blue" for the shirt size!
68 use Moose::Util::TypeConstraints;
74 => where { Email::Valid->address($_) }
75 => message { "$_ is not a valid email address" };
77 has email_address => (
83 This class subclasses Person to add a single attribute, email address.
85 Now we will show what these classes would look like in plain old Perl
86 5. For the sake of argument, we won't use any base classes or any
87 helpers like C<Class::Accessor>.
94 use Carp qw( confess );
96 use DateTime::Format::Natural;
101 my %p = ref $_[0] ? %{ $_[0] } : @_;
104 or confess 'name is a required attribute';
105 $class->_validate_name( $p{name} );
107 exists $p{birth_date}
108 or confess 'birth_date is a required attribute';
110 $p{birth_date} = $class->_coerce_birth_date($date );
111 $class->_validate_birth_date( $date );
114 unless exists $p{shirt_size}:
116 $class->_validate_shirt_size( $p{shirt_size} );
118 my %self = map { $_ => $p{$_} } qw( name shirt_size );
119 $self{birth_date} = $date;
121 return bless \%self, $class;
128 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
131 or confess 'name must be a string';
135 my $en_parser = DateTime::Format::Natural->new(
140 sub _coerce_birth_date {
144 return $date unless defined $date && ! ref $date;
146 my $dt = $en_parser->parse_datetime($date);
148 return $dt ? $dt : undef;
152 sub _validate_birth_date {
154 my $birth_date = shift;
156 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
158 $birth_date->isa('DateTime') )
159 or confess 'birth_date must be a DateTime object';
162 sub _validate_shirt_size {
164 my $shirt_size = shift;
166 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
169 or confess 'shirt_size cannot be undef';
171 $shirt_size =~ /^(?:s|m|l|xl|xxl)$/
172 or confess "$shirt_size is not a valid shirt size (s, m, l, xl, xxl)";
179 $self->_validate_name( $_[0] );
180 $self->{name} = $_[0];
183 return $self->{name};
190 my $date = $self->_coerce_birth_date( $_[0] );
191 $self->_validate_birth_date( $date );
193 $self->{birth_date} = $date;
196 return $self->{birth_date};
203 $self->_validate_shirt_size( $_[0] );
204 $self->{shirt_size} = $_[0];
207 return $self->{shirt_size};
210 Wow, that was a mouthful! One thing to note is just how much space the
211 data validation code consumes. As a result, it's pretty common for
212 Perl 5 programmers to just not bother, which results in much more
215 Did you spot the (intentional) bug?
217 It's in the C<_validate_birth_date()> method. We should check that
218 that value in C<$birth_date> is actually defined and object before we
219 go and call C<isa()> on it! Leaving out those checks means our data
220 validation code could actually cause our program to die. Oops.
222 There's one bit of code in there worth explaining, which is the
223 handling of the birth date for coercion. In both the constructor and
224 accessor, we first take a copy of the birth date before passing it to
225 the coercion routine. This is to avoid changing the value as it was
226 passed to those methods, which could cause problems for the caller.
228 Also note that if we add a superclass to Person we'll have to change
229 the constructor to account for that.
231 (As an aside, getting all the little details of what Moose does for
232 you just right in this code was not easy, which just emphasizes the
233 point, that Moose saves you a lot of work!)
242 use Carp qw( confess );
244 use Scalar::Util qw( blessed );
251 my %p = ref $_[0] ? %{ $_[0] } : @_;
253 exists $p{email_address}
254 or confess 'email_address is a required attribute';
255 $class->_validate_email_address( $p{email_address} );
257 my $self = $class->SUPER::new(%p);
259 $self->{email_address} = $p{email_address};
264 sub _validate_email_address {
266 my $email_address = shift;
268 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
270 defined $email_address
271 or confess 'email_address must be a string';
273 Email::Valid->address($email_address)
274 or confess "$email_address is not a valid email address";
281 $self->_validate_email_address( $_[0] );
282 $self->{email_address} = $_[0];
285 return $self->{email_address};
288 That one was shorter, but it only has one attribute.
290 Between the two classes, we have a whole lot of code that doesn't do
291 much. We could probably simplify this by defining some sort of
292 "attribute and validation" hash, like this:
299 validate => sub { defined $_ },
303 validate => sub { blessed $_ && $_->isa('DateTime') },
307 validate => sub { defined $_ && $_ =~ /^(?:s|m|l|xl|xxl)$/i },
311 Then we could define a base class that would accept such a definition,
312 and do the right thing. Keep that sort of thing up and we're well on
313 our way to writing a half-assed version of Moose!
315 Of course, there are CPAN modules that do some of what Moose does,
316 like C<Class::Accessor>, C<Class::Meta>, and so on. But none of them
317 put together all of Moose's features along with a layer of declarative
318 sugar, nor are these other modules designed for extensibility in the
319 same way as Moose. With Moose, it's easy to write a MooseX module to
320 replace or extend a piece of built-in functionality.
324 Dave Rolsky E<lt>autarch@urth.orgE<gt>
326 =head1 COPYRIGHT AND LICENSE
328 Copyright 2008 by Infinity Interactive, Inc.
330 L<http://www.iinteractive.com>
332 This library is free software; you can redistribute it and/or modify
333 it under the same terms as Perl itself.