ignore generated recipes
[gitmo/Moose.git] / lib / Moose / Unsweetened.pod
CommitLineData
b8790e44 1=pod
2
3=head1 NAME
4
5Moose::Unsweetened - Moose idioms in plain old Perl 5 without the sugar
6
7=head1 DESCRIPTION
8
9If you're trying to figure out just what the heck Moose does, and how
10it saves you time, you might find it helpful to see what Moose is
11I<really> doing for you. This document shows you the translation from
12Moose sugar back to plain old Perl 5.
13
14=head1 CLASSES AND ATTRIBUTES
15
16First, 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
50 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
55 has shirt_size => (
56 is => 'rw',
57 isa => 'ShirtSize',
58 default => 'l',
59 );
60
61This is a fairly simple class with three attributes. We also define a
62type to validate t-shirt sizes because we don't want to end up with
63something like "blue" for the shirt size!
64
65 package User;
66
67 use Email::Valid;
68 use Moose;
69 use Moose::Util::TypeConstraints;
70
71 extends 'Person';
72
73 subtype 'Email'
74 => as 'Str'
75 => where { Email::Valid->address($_) }
76 => message { "$_ is not a valid email address" };
77
78 has email_address => (
79 is => 'rw',
80 isa => 'Email',
81 required => 1,
82 );
83
84This class subclasses Person to add a single attribute, email address.
85
86Now we will show what these classes would look like in plain old Perl
875. For the sake of argument, we won't use any base classes or any
88helpers like C<Class::Accessor>.
89
90 package Person;
91
92 use strict;
93 use warnings;
94
95 use Carp qw( confess );
96 use DateTime;
97 use DateTime::Format::Natural;
98
99
100 sub new {
101 my $class = shift;
102 my %p = ref $_[0] ? %{ $_[0] } : @_;
103
104 exists $p{name}
105 or confess 'name is a required attribute';
106 $class->_validate_name( $p{name} );
107
108 exists $p{birth_date}
109 or confess 'birth_date is a required attribute';
110
1900b4d1 111 $p{birth_date} = $class->_coerce_birth_date( $p{birth_date} );
112 $class->_validate_birth_date( $p{birth_date} );
b8790e44 113
114 $p{shirt_size} = 'l'
115 unless exists $p{shirt_size}:
116
117 $class->_validate_shirt_size( $p{shirt_size} );
118
1900b4d1 119 return bless \%p, $class;
b8790e44 120 }
121
122 sub _validate_name {
123 shift;
124 my $name = shift;
125
126 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
127
128 defined $name
129 or confess 'name must be a string';
130 }
131
132 {
133 my $en_parser = DateTime::Format::Natural->new(
134 lang => 'en',
135 time_zone => 'UTC',
136 );
137
138 sub _coerce_birth_date {
139 shift;
140 my $date = shift;
141
50c221c5 142 return $date unless defined $date && ! ref $date;
b8790e44 143
144 my $dt = $en_parser->parse_datetime($date);
145
146 return $dt ? $dt : undef;
147 }
148 }
149
150 sub _validate_birth_date {
151 shift;
152 my $birth_date = shift;
153
154 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
155
156 $birth_date->isa('DateTime') )
157 or confess 'birth_date must be a DateTime object';
158 }
159
160 sub _validate_shirt_size {
161 shift;
162 my $shirt_size = shift;
163
164 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
165
166 defined $shirt_size
167 or confess 'shirt_size cannot be undef';
168
169 $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
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
223that value in C<$birth_date> is actually defined and object before we
224go and call C<isa()> on it! Leaving out those checks means our data
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
247
248 sub new {
249 my $class = shift;
250 my %p = ref $_[0] ? %{ $_[0] } : @_;
251
252 exists $p{email_address}
253 or confess 'email_address is a required attribute';
254 $class->_validate_email_address( $p{email_address} );
255
256 my $self = $class->SUPER::new(%p);
257
258 $self->{email_address} = $p{email_address};
259
260 return $self;
261 }
262
263 sub _validate_email_address {
264 shift;
265 my $email_address = shift;
266
267 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
268
269 defined $email_address
270 or confess 'email_address must be a string';
271
272 Email::Valid->address($email_address)
273 or confess "$email_address is not a valid email address";
274 }
275
276 sub email_address {
277 my $self = shift;
278
279 if (@_) {
280 $self->_validate_email_address( $_[0] );
281 $self->{email_address} = $_[0];
282 }
283
284 return $self->{email_address};
285 }
286
287That one was shorter, but it only has one attribute.
288
289Between the two classes, we have a whole lot of code that doesn't do
290much. We could probably simplify this by defining some sort of
291"attribute and validation" hash, like this:
292
293 package Person;
294
295 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
310Then we could define a base class that would accept such a definition,
e3494ea7 311and do the right thing. Keep that sort of thing up and we're well on
312our way to writing a half-assed version of Moose!
b8790e44 313
314Of course, there are CPAN modules that do some of what Moose does,
315like C<Class::Accessor>, C<Class::Meta>, and so on. But none of them
316put together all of Moose's features along with a layer of declarative
b650ff44 317sugar, nor are these other modules designed for extensibility in the
318same way as Moose. With Moose, it's easy to write a MooseX module to
319replace or extend a piece of built-in functionality.
b8790e44 320
321=head1 AUTHOR
322
323Dave Rolsky E<lt>autarch@urth.orgE<gt>
324
325=head1 COPYRIGHT AND LICENSE
326
2840a3b2 327Copyright 2009 by Infinity Interactive, Inc.
b8790e44 328
329L<http://www.iinteractive.com>
330
331This library is free software; you can redistribute it and/or modify
332it under the same terms as Perl itself.
333
334=cut