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