ignore generated recipes
[gitmo/Moose.git] / lib / Moose / Unsweetened.pod
1 =pod
2
3 =head1 NAME
4
5 Moose::Unsweetened - Moose idioms in plain old Perl 5 without the sugar
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 => (
44       is      => 'rw',
45       isa     => 'DateTime',
46       coerce  => 1,
47       handles => { birth_year => 'year' },
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
61 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
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
84 This class subclasses Person to add a single attribute, email address.
85
86 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 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
111       $p{birth_date} = $class->_coerce_birth_date( $p{birth_date} );
112       $class->_validate_birth_date( $p{birth_date} );
113
114       $p{shirt_size} = 'l'
115           unless exists $p{shirt_size}:
116
117       $class->_validate_shirt_size( $p{shirt_size} );
118
119       return bless \%p, $class;
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
142           return $date unless defined $date && ! ref $date;
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 (@_) {
188           my $date = $self->_coerce_birth_date( $_[0] );
189           $self->_validate_birth_date( $date );
190
191           $self->{birth_date} = $date;
192       }
193
194       return $self->{birth_date};
195   }
196
197   sub birth_year {
198       my $self = shift;
199
200       return $self->birth_date->year;
201   }
202
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
214 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
216 Perl 5 programmers to just not bother. Unfortunately, not validating
217 arguments leads to surprises down the line ("why is birth_date an
218 email address?").
219
220 Also, did you spot the (intentional) bug?
221
222 It's in the C<_validate_birth_date()> method. We should check that
223 that value in C<$birth_date> is actually defined and object before we
224 go and call C<isa()> on it! Leaving out those checks means our data
225 validation code could actually cause our program to die. Oops.
226
227 Note that if we add a superclass to Person we'll have to change the
228 constructor to account for that.
229
230 (As an aside, getting all the little details of what Moose does for
231 you just right in this example was really not easy, which emphasizes
232 the point of the example. Moose saves you a lot of work!)
233
234 Now 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
287 That one was shorter, but it only has one attribute.
288
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:
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
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!
313
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.
320
321 =head1 AUTHOR
322
323 Dave Rolsky E<lt>autarch@urth.orgE<gt>
324
325 =head1 COPYRIGHT AND LICENSE
326
327 Copyright 2009 by Infinity Interactive, Inc.
328
329 L<http://www.iinteractive.com>
330
331 This library is free software; you can redistribute it and/or modify
332 it under the same terms as Perl itself.
333
334 =cut