Commit | Line | Data |
b8790e44 |
1 | =pod |
2 | |
3 | =head1 NAME |
4 | |
d68b26d1 |
5 | Moose::Manual::Unsweetened - Moose idioms in plain old Perl 5 without the sugar |
b8790e44 |
6 | |
7 | =head1 DESCRIPTION |
8 | |
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. |
13 | |
14 | =head1 CLASSES AND ATTRIBUTES |
15 | |
16 | First, we define two very small classes the Moose way. |
17 | |
18 | package Person; |
19 | |
20 | use DateTime; |
21 | use DateTime::Format::Natural; |
22 | use Moose; |
23 | use Moose::Util::TypeConstraints; |
24 | |
25 | has name => ( |
26 | is => 'rw', |
27 | isa => 'Str', |
28 | required => 1, |
29 | ); |
30 | |
31 | # Moose doesn't know about non-Moose-based classes. |
32 | class_type 'DateTime'; |
33 | |
34 | my $en_parser = DateTime::Format::Natural->new( |
35 | lang => 'en', |
36 | time_zone => 'UTC', |
37 | ); |
38 | |
39 | coerce 'DateTime' |
40 | => from 'Str' |
41 | => via { $en_parser->parse_datetime($_) }; |
42 | |
43 | has birth_date => ( |
b1ff769c |
44 | is => 'rw', |
45 | isa => 'DateTime', |
46 | coerce => 1, |
47 | handles => { birth_year => 'year' }, |
b8790e44 |
48 | ); |
49 | |
609daa48 |
50 | enum 'ShirtSize' => qw( s m l xl xxl ); |
b8790e44 |
51 | |
52 | has shirt_size => ( |
53 | is => 'rw', |
54 | isa => 'ShirtSize', |
55 | default => 'l', |
56 | ); |
57 | |
609daa48 |
58 | This is a fairly simple class with three attributes. We also define an enum |
59 | type to validate t-shirt sizes because we don't want to end up with something |
60 | like "blue" for the shirt size! |
b8790e44 |
61 | |
62 | package User; |
63 | |
64 | use Email::Valid; |
65 | use Moose; |
66 | use Moose::Util::TypeConstraints; |
67 | |
68 | extends 'Person'; |
69 | |
70 | subtype 'Email' |
71 | => as 'Str' |
72 | => where { Email::Valid->address($_) } |
73 | => message { "$_ is not a valid email address" }; |
74 | |
75 | has email_address => ( |
76 | is => 'rw', |
77 | isa => 'Email', |
78 | required => 1, |
79 | ); |
80 | |
81 | This class subclasses Person to add a single attribute, email address. |
82 | |
83 | Now we will show what these classes would look like in plain old Perl |
84 | 5. For the sake of argument, we won't use any base classes or any |
85 | helpers like C<Class::Accessor>. |
86 | |
87 | package Person; |
88 | |
89 | use strict; |
90 | use warnings; |
91 | |
92 | use Carp qw( confess ); |
93 | use DateTime; |
94 | use DateTime::Format::Natural; |
95 | |
b8790e44 |
96 | sub new { |
97 | my $class = shift; |
98 | my %p = ref $_[0] ? %{ $_[0] } : @_; |
99 | |
100 | exists $p{name} |
101 | or confess 'name is a required attribute'; |
102 | $class->_validate_name( $p{name} ); |
103 | |
104 | exists $p{birth_date} |
105 | or confess 'birth_date is a required attribute'; |
106 | |
1900b4d1 |
107 | $p{birth_date} = $class->_coerce_birth_date( $p{birth_date} ); |
108 | $class->_validate_birth_date( $p{birth_date} ); |
b8790e44 |
109 | |
110 | $p{shirt_size} = 'l' |
111 | unless exists $p{shirt_size}: |
112 | |
113 | $class->_validate_shirt_size( $p{shirt_size} ); |
114 | |
1900b4d1 |
115 | return bless \%p, $class; |
b8790e44 |
116 | } |
117 | |
118 | sub _validate_name { |
119 | shift; |
120 | my $name = shift; |
121 | |
122 | local $Carp::CarpLevel = $Carp::CarpLevel + 1; |
123 | |
124 | defined $name |
125 | or confess 'name must be a string'; |
126 | } |
127 | |
128 | { |
129 | my $en_parser = DateTime::Format::Natural->new( |
130 | lang => 'en', |
131 | time_zone => 'UTC', |
132 | ); |
133 | |
134 | sub _coerce_birth_date { |
135 | shift; |
136 | my $date = shift; |
137 | |
50c221c5 |
138 | return $date unless defined $date && ! ref $date; |
b8790e44 |
139 | |
140 | my $dt = $en_parser->parse_datetime($date); |
141 | |
142 | return $dt ? $dt : undef; |
143 | } |
144 | } |
145 | |
146 | sub _validate_birth_date { |
147 | shift; |
148 | my $birth_date = shift; |
149 | |
150 | local $Carp::CarpLevel = $Carp::CarpLevel + 1; |
151 | |
f9b1ab71 |
152 | $birth_date->isa('DateTime') |
b8790e44 |
153 | or confess 'birth_date must be a DateTime object'; |
154 | } |
155 | |
156 | sub _validate_shirt_size { |
157 | shift; |
158 | my $shirt_size = shift; |
159 | |
160 | local $Carp::CarpLevel = $Carp::CarpLevel + 1; |
161 | |
162 | defined $shirt_size |
163 | or confess 'shirt_size cannot be undef'; |
164 | |
609daa48 |
165 | my %sizes = map { $_ => 1 } qw( s m l xl xxl ); |
166 | |
167 | $sizes{$shirt_size} |
b8790e44 |
168 | or confess "$shirt_size is not a valid shirt size (s, m, l, xl, xxl)"; |
169 | } |
170 | |
171 | sub name { |
172 | my $self = shift; |
173 | |
174 | if (@_) { |
175 | $self->_validate_name( $_[0] ); |
176 | $self->{name} = $_[0]; |
177 | } |
178 | |
179 | return $self->{name}; |
180 | } |
181 | |
182 | sub birth_date { |
183 | my $self = shift; |
184 | |
185 | if (@_) { |
50c221c5 |
186 | my $date = $self->_coerce_birth_date( $_[0] ); |
b8790e44 |
187 | $self->_validate_birth_date( $date ); |
50c221c5 |
188 | |
b8790e44 |
189 | $self->{birth_date} = $date; |
190 | } |
191 | |
192 | return $self->{birth_date}; |
193 | } |
194 | |
b1ff769c |
195 | sub birth_year { |
196 | my $self = shift; |
197 | |
198 | return $self->birth_date->year; |
199 | } |
200 | |
b8790e44 |
201 | sub shirt_size { |
202 | my $self = shift; |
203 | |
204 | if (@_) { |
205 | $self->_validate_shirt_size( $_[0] ); |
206 | $self->{shirt_size} = $_[0]; |
207 | } |
208 | |
209 | return $self->{shirt_size}; |
210 | } |
211 | |
212 | Wow, that was a mouthful! One thing to note is just how much space the |
213 | data validation code consumes. As a result, it's pretty common for |
34ee223f |
214 | Perl 5 programmers to just not bother. Unfortunately, not validating |
215 | arguments leads to surprises down the line ("why is birth_date an |
216 | email address?"). |
b8790e44 |
217 | |
34ee223f |
218 | Also, did you spot the (intentional) bug? |
b8790e44 |
219 | |
220 | It's in the C<_validate_birth_date()> method. We should check that |
dab94063 |
221 | the value in C<$birth_date> is actually defined and an object before |
222 | we go and call C<isa()> on it! Leaving out those checks means our data |
b8790e44 |
223 | validation code could actually cause our program to die. Oops. |
224 | |
34ee223f |
225 | Note that if we add a superclass to Person we'll have to change the |
226 | constructor to account for that. |
b8790e44 |
227 | |
228 | (As an aside, getting all the little details of what Moose does for |
34ee223f |
229 | you just right in this example was really not easy, which emphasizes |
230 | the point of the example. Moose saves you a lot of work!) |
b8790e44 |
231 | |
232 | Now let's see User: |
233 | |
234 | package User; |
235 | |
236 | use strict; |
237 | use warnings; |
238 | |
239 | use Carp qw( confess ); |
240 | use Email::Valid; |
241 | use Scalar::Util qw( blessed ); |
242 | |
243 | use base 'Person'; |
244 | |
b8790e44 |
245 | sub new { |
246 | my $class = shift; |
247 | my %p = ref $_[0] ? %{ $_[0] } : @_; |
248 | |
249 | exists $p{email_address} |
250 | or confess 'email_address is a required attribute'; |
251 | $class->_validate_email_address( $p{email_address} ); |
252 | |
253 | my $self = $class->SUPER::new(%p); |
254 | |
255 | $self->{email_address} = $p{email_address}; |
256 | |
257 | return $self; |
258 | } |
259 | |
260 | sub _validate_email_address { |
261 | shift; |
262 | my $email_address = shift; |
263 | |
264 | local $Carp::CarpLevel = $Carp::CarpLevel + 1; |
265 | |
266 | defined $email_address |
267 | or confess 'email_address must be a string'; |
268 | |
269 | Email::Valid->address($email_address) |
270 | or confess "$email_address is not a valid email address"; |
271 | } |
272 | |
273 | sub email_address { |
274 | my $self = shift; |
275 | |
276 | if (@_) { |
277 | $self->_validate_email_address( $_[0] ); |
278 | $self->{email_address} = $_[0]; |
279 | } |
280 | |
281 | return $self->{email_address}; |
282 | } |
283 | |
284 | That one was shorter, but it only has one attribute. |
285 | |
286 | Between the two classes, we have a whole lot of code that doesn't do |
287 | much. We could probably simplify this by defining some sort of |
288 | "attribute and validation" hash, like this: |
289 | |
290 | package Person; |
291 | |
292 | my %Attr = ( |
293 | name => { |
294 | required => 1, |
295 | validate => sub { defined $_ }, |
296 | }, |
297 | birth_date => { |
298 | required => 1, |
299 | validate => sub { blessed $_ && $_->isa('DateTime') }, |
300 | }, |
301 | shirt_size => { |
302 | required => 1, |
303 | validate => sub { defined $_ && $_ =~ /^(?:s|m|l|xl|xxl)$/i }, |
304 | } |
305 | ); |
306 | |
307 | Then we could define a base class that would accept such a definition, |
e3494ea7 |
308 | and do the right thing. Keep that sort of thing up and we're well on |
309 | our way to writing a half-assed version of Moose! |
b8790e44 |
310 | |
311 | Of course, there are CPAN modules that do some of what Moose does, |
312 | like C<Class::Accessor>, C<Class::Meta>, and so on. But none of them |
313 | put together all of Moose's features along with a layer of declarative |
b650ff44 |
314 | sugar, nor are these other modules designed for extensibility in the |
315 | same way as Moose. With Moose, it's easy to write a MooseX module to |
316 | replace or extend a piece of built-in functionality. |
b8790e44 |
317 | |
4593e788 |
318 | Moose is a complete OO package in and of itself, and is part of a rich |
319 | ecosystem of extensions. It also has an enthusiastic community of |
320 | users, and is being actively maintained and developed. |
321 | |
b8790e44 |
322 | =head1 AUTHOR |
323 | |
324 | Dave Rolsky E<lt>autarch@urth.orgE<gt> |
325 | |
326 | =head1 COPYRIGHT AND LICENSE |
327 | |
2840a3b2 |
328 | Copyright 2009 by Infinity Interactive, Inc. |
b8790e44 |
329 | |
330 | L<http://www.iinteractive.com> |
331 | |
332 | This library is free software; you can redistribute it and/or modify |
333 | it under the same terms as Perl itself. |
334 | |
335 | =cut |