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($_) };
50 => where { /^(?:s|m|l|xl|xxl)$/i }
51 => message { "$_ is not a valid shirt size (s, m, l, xl, xxl)" };
59 This is a fairly simple class with three attributes. We also define a
60 type to validate t-shirt sizes because we don't want to end up with
61 something like "blue" for the shirt size!
67 use Moose::Util::TypeConstraints;
73 => where { Email::Valid->address($_) }
74 => message { "$_ is not a valid email address" };
76 has email_address => (
82 This class subclasses Person to add a single attribute, email address.
84 Now we will show what these classes would look like in plain old Perl
85 5. For the sake of argument, we won't use any base classes or any
86 helpers like C<Class::Accessor>.
93 use Carp qw( confess );
95 use DateTime::Format::Natural;
100 my %p = ref $_[0] ? %{ $_[0] } : @_;
103 or confess 'name is a required attribute';
104 $class->_validate_name( $p{name} );
106 exists $p{birth_date}
107 or confess 'birth_date is a required attribute';
109 $p{birth_date} = $class->_coerce_birth_date($date );
110 $class->_validate_birth_date( $date );
113 unless exists $p{shirt_size}:
115 $class->_validate_shirt_size( $p{shirt_size} );
117 my %self = map { $_ => $p{$_} } qw( name shirt_size );
118 $self{birth_date} = $date;
120 return bless \%self, $class;
127 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
130 or confess 'name must be a string';
134 my $en_parser = DateTime::Format::Natural->new(
139 sub _coerce_birth_date {
143 return $date unless defined $date && ! ref $date;
145 my $dt = $en_parser->parse_datetime($date);
147 return $dt ? $dt : undef;
151 sub _validate_birth_date {
153 my $birth_date = shift;
155 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
157 $birth_date->isa('DateTime') )
158 or confess 'birth_date must be a DateTime object';
161 sub _validate_shirt_size {
163 my $shirt_size = shift;
165 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
168 or confess 'shirt_size cannot be undef';
170 $shirt_size =~ /^(?:s|m|l|xl|xxl)$/
171 or confess "$shirt_size is not a valid shirt size (s, m, l, xl, xxl)";
178 $self->_validate_name( $_[0] );
179 $self->{name} = $_[0];
182 return $self->{name};
189 my $date = $self->_coerce_birth_date( $_[0] );
190 $self->_validate_birth_date( $date );
192 $self->{birth_date} = $date;
195 return $self->{birth_date};
202 $self->_validate_shirt_size( $_[0] );
203 $self->{shirt_size} = $_[0];
206 return $self->{shirt_size};
209 Wow, that was a mouthful! One thing to note is just how much space the
210 data validation code consumes. As a result, it's pretty common for
211 Perl 5 programmers to just not bother, which results in much more
214 Did you spot the (intentional) bug?
216 It's in the C<_validate_birth_date()> method. We should check that
217 that value in C<$birth_date> is actually defined and object before we
218 go and call C<isa()> on it! Leaving out those checks means our data
219 validation code could actually cause our program to die. Oops.
221 There's one bit of code in there worth explaining, which is the
222 handling of the birth date for coercion. In both the constructor and
223 accessor, we first take a copy of the birth date before passing it to
224 the coercion routine. This is to avoid changing the value as it was
225 passed to those methods, which could cause problems for the caller.
227 Also note that if we add a superclass to Person we'll have to change
228 the constructor to account for that.
230 (As an aside, getting all the little details of what Moose does for
231 you just right in this code was not easy, which just emphasizes the
232 point, that Moose saves you a lot of work!)
241 use Carp qw( confess );
243 use Scalar::Util qw( blessed );
250 my %p = ref $_[0] ? %{ $_[0] } : @_;
252 exists $p{email_address}
253 or confess 'email_address is a required attribute';
254 $class->_validate_email_address( $p{email_address} );
256 my $self = $class->SUPER::new(%p);
258 $self->{email_address} = $p{email_address};
263 sub _validate_email_address {
265 my $email_address = shift;
267 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
269 defined $email_address
270 or confess 'email_address must be a string';
272 Email::Valid->address($email_address)
273 or confess "$email_address is not a valid email address";
280 $self->_validate_email_address( $_[0] );
281 $self->{email_address} = $_[0];
284 return $self->{email_address};
287 That one was shorter, but it only has one attribute.
289 Between the two classes, we have a whole lot of code that doesn't do
290 much. We could probably simplify this by defining some sort of
291 "attribute and validation" hash, like this:
298 validate => sub { defined $_ },
302 validate => sub { blessed $_ && $_->isa('DateTime') },
306 validate => sub { defined $_ && $_ =~ /^(?:s|m|l|xl|xxl)$/i },
310 Then we could define a base class that would accept such a definition,
311 and do the right thing. Keep that sort of thing up and we're well on
312 our way to writing a half-assed version of Moose!
314 Of course, there are CPAN modules that do some of what Moose does,
315 like C<Class::Accessor>, C<Class::Meta>, and so on. But none of them
316 put together all of Moose's features along with a layer of declarative
317 sugar, nor are these other modules designed for extensibility in the
318 same way as Moose. With Moose, it's easy to write a MooseX module to
319 replace or extend a piece of built-in functionality.
323 Dave Rolsky E<lt>autarch@urth.orgE<gt>
325 =head1 COPYRIGHT AND LICENSE
327 Copyright 2008 by Infinity Interactive, Inc.
329 L<http://www.iinteractive.com>
331 This library is free software; you can redistribute it and/or modify
332 it under the same terms as Perl itself.