1Moose::Manual::UnsweeteUnseedr(3C)ontributed Perl DocumeMnotoastei:o:nManual::Unsweetened(3)
2
6 Moose::Manual::Unsweetened - Moose idioms in plain old Perl 5 without
7 the sugar
8
10 If you're trying to figure out just what the heck Moose does, and how
11 it saves you time, you might find it helpful to see what Moose is
12 really doing for you. This document shows you the translation from
13 Moose sugar back to plain old Perl 5.
14
16 First, we define two very small classes the Moose way.
17 package Person;
19 use DateTime;
21 use DateTime::Format::Natural;
22 use Moose;
23 use Moose::Util::TypeConstraints;
24 has name => (
26 is => 'rw',
27 isa => 'Str',
28 required => 1,
29 );
30 # Moose doesn't know about non-Moose-based classes.
32 class_type 'DateTime';
33 my $en_parser = DateTime::Format::Natural->new(
35 lang => 'en',
36 time_zone => 'UTC',
37 );
38 coerce 'DateTime'
40 => from 'Str'
41 => via { $en_parser->parse_datetime($_) };
42 has birth_date => (
44 is => 'rw',
45 isa => 'DateTime',
46 coerce => 1,
47 handles => { birth_year => 'year' },
48 );
49 subtype 'ShirtSize'
51 => as 'Str'
52 => where { /^(?:s|m|l|xl|xxl)$/i }
53 => message { "$_ is not a valid shirt size (s, m, l, xl, xxl)" };
54 has shirt_size => (
56 is => 'rw',
57 isa => 'ShirtSize',
58 default => 'l',
59 );
60 This is a fairly simple class with three attributes. We also define a
62 type to validate t-shirt sizes because we don't want to end up with
63 something like "blue" for the shirt size!
64 package User;
66 use Email::Valid;
68 use Moose;
69 use Moose::Util::TypeConstraints;
70 extends 'Person';
72 subtype 'Email'
74 => as 'Str'
75 => where { Email::Valid->address($_) }
76 => message { "$_ is not a valid email address" };
77 has email_address => (
79 is => 'rw',
80 isa => 'Email',
81 required => 1,
82 );
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
87 5. For the sake of argument, we won't use any base classes or any
88 helpers like "Class::Accessor".
89 package Person;
91 use strict;
93 use warnings;
94 use Carp qw( confess );
96 use DateTime;
97 use DateTime::Format::Natural;
98 sub new {
101 my $class = shift;
102 my %p = ref $_[0] ? %{ $_[0] } : @_;
103 exists $p{name}
105 or confess 'name is a required attribute';
106 $class->_validate_name( $p{name} );
107 exists $p{birth_date}
109 or confess 'birth_date is a required attribute';
110 $p{birth_date} = $class->_coerce_birth_date( $p{birth_date} );
112 $class->_validate_birth_date( $p{birth_date} );
113 $p{shirt_size} = 'l'
115 unless exists $p{shirt_size}:
116 $class->_validate_shirt_size( $p{shirt_size} );
118 return bless \%p, $class;
120 }
121 sub _validate_name {
123 shift;
124 my $name = shift;
125 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
127 defined $name
129 or confess 'name must be a string';
130 }
131 {
133 my $en_parser = DateTime::Format::Natural->new(
134 lang => 'en',
135 time_zone => 'UTC',
136 );
137 sub _coerce_birth_date {
139 shift;
140 my $date = shift;
141 return $date unless defined $date && ! ref $date;
143 my $dt = $en_parser->parse_datetime($date);
145 return $dt ? $dt : undef;
147 }
148 }
149 sub _validate_birth_date {
151 shift;
152 my $birth_date = shift;
153 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
155 $birth_date->isa('DateTime')
157 or confess 'birth_date must be a DateTime object';
158 }
159 sub _validate_shirt_size {
161 shift;
162 my $shirt_size = shift;
163 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
165 defined $shirt_size
167 or confess 'shirt_size cannot be undef';
168 $shirt_size =~ /^(?:s|m|l|xl|xxl)$/
170 or confess "$shirt_size is not a valid shirt size (s, m, l, xl, xxl)";
171 }
172 sub name {
174 my $self = shift;
175 if (@_) {
177 $self->_validate_name( $_[0] );
178 $self->{name} = $_[0];
179 }
180 return $self->{name};
182 }
183 sub birth_date {
185 my $self = shift;
186 if (@_) {
188 my $date = $self->_coerce_birth_date( $_[0] );
189 $self->_validate_birth_date( $date );
190 $self->{birth_date} = $date;
192 }
193 return $self->{birth_date};
195 }
196 sub birth_year {
198 my $self = shift;
199 return $self->birth_date->year;
201 }
202 sub shirt_size {
204 my $self = shift;
205 if (@_) {
207 $self->_validate_shirt_size( $_[0] );
208 $self->{shirt_size} = $_[0];
209 }
210 return $self->{shirt_size};
212 }
213 Wow, that was a mouthful! One thing to note is just how much space the
215 data validation code consumes. As a result, it's pretty common for Perl
216 5 programmers to just not bother. Unfortunately, not validating
217 arguments leads to surprises down the line ("why is birth_date an email
218 address?").
219 Also, did you spot the (intentional) bug?
221 It's in the "_validate_birth_date()" method. We should check that the
223 value in $birth_date is actually defined and an object before we go and
224 call "isa()" on it! Leaving out those checks means our data validation
225 code could actually cause our program to die. Oops.
226 Note that if we add a superclass to Person we'll have to change the
228 constructor to account for that.
229 (As an aside, getting all the little details of what Moose does for you
231 just right in this example was really not easy, which emphasizes the
232 point of the example. Moose saves you a lot of work!)
233 Now let's see User:
235 package User;
237 use strict;
239 use warnings;
240 use Carp qw( confess );
242 use Email::Valid;
243 use Scalar::Util qw( blessed );
244 use base 'Person';
246 sub new {
249 my $class = shift;
250 my %p = ref $_[0] ? %{ $_[0] } : @_;
251 exists $p{email_address}
253 or confess 'email_address is a required attribute';
254 $class->_validate_email_address( $p{email_address} );
255 my $self = $class->SUPER::new(%p);
257 $self->{email_address} = $p{email_address};
259 return $self;
261 }
262 sub _validate_email_address {
264 shift;
265 my $email_address = shift;
266 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
268 defined $email_address
270 or confess 'email_address must be a string';
271 Email::Valid->address($email_address)
273 or confess "$email_address is not a valid email address";
274 }
275 sub email_address {
277 my $self = shift;
278 if (@_) {
280 $self->_validate_email_address( $_[0] );
281 $self->{email_address} = $_[0];
282 }
283 return $self->{email_address};
285 }
286 That one was shorter, but it only has one attribute.
288 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:
292 package Person;
294 my %Attr = (
296 name => {
297 required => 1,
298 validate => sub { defined $_ },
299 },
300 birth_date => {
301 required => 1,
302 validate => sub { blessed $_ && $_->isa('DateTime') },
303 },
304 shirt_size => {
305 required => 1,
306 validate => sub { defined $_ && $_ =~ /^(?:s|m|l|xl|xxl)$/i },
307 }
308 );
309 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!
313 Of course, there are CPAN modules that do some of what Moose does, like
315 "Class::Accessor", "Class::Meta", and so on. But none of them put
316 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.
320 Moose is a complete OO package in and of itself, and is part of a rich
322 ecosystem of extensions. It also has an enthusiastic community of
323 users, and is being actively maintained and developed.
324
326 Dave Rolsky <autarch@urth.org>
327
329 Copyright 2009 by Infinity Interactive, Inc.
330 <http://www.iinteractive.com>
332 This library is free software; you can redistribute it and/or modify it
334 under the same terms as Perl itself.
335perl v5.12.2 2010-07-02 Moose::Manual::Unsweetened(3)