1Moose::Manual::UnsweeteUnseedr(3C)ontributed Perl DocumeMnotoastei:o:nManual::Unsweetened(3)
2
3
4

NAME

6       Moose::Manual::Unsweetened - Moose idioms in plain old Perl 5 without
7       the sugar
8

VERSION

10       version 2.2013
11

DESCRIPTION

13       If you're trying to figure out just what the heck Moose does, and how
14       it saves you time, you might find it helpful to see what Moose is
15       really doing for you. This document shows you the translation from
16       Moose sugar back to plain old Perl 5.
17

CLASSES AND ATTRIBUTES

19       First, we define two very small classes the Moose way.
20
21         package Person;
22
23         use DateTime;
24         use DateTime::Format::Natural;
25         use Moose;
26         use Moose::Util::TypeConstraints;
27
28         has name => (
29             is       => 'rw',
30             isa      => 'Str',
31             required => 1,
32         );
33
34         # Moose doesn't know about non-Moose-based classes.
35         class_type 'DateTime';
36
37         my $en_parser = DateTime::Format::Natural->new(
38             lang      => 'en',
39             time_zone => 'UTC',
40         );
41
42         coerce 'DateTime'
43             => from 'Str'
44             => via { $en_parser->parse_datetime($_) };
45
46         has birth_date => (
47             is      => 'rw',
48             isa     => 'DateTime',
49             coerce  => 1,
50             handles => { birth_year => 'year' },
51         );
52
53         enum 'ShirtSize' => [qw( 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 an
62       enum type to validate t-shirt sizes because we don't want to end up
63       with 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 "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         sub new {
100             my $class = shift;
101             my %p = ref $_[0] ? %{ $_[0] } : @_;
102
103             exists $p{name}
104                 or confess 'name is a required attribute';
105             $class->_validate_name( $p{name} );
106
107             exists $p{birth_date}
108                 or confess 'birth_date is a required attribute';
109
110             $p{birth_date} = $class->_coerce_birth_date( $p{birth_date} );
111             $class->_validate_birth_date( $p{birth_date} );
112
113             $p{shirt_size} = 'l'
114                 unless exists $p{shirt_size};
115
116             $class->_validate_shirt_size( $p{shirt_size} );
117
118             return bless \%p, $class;
119         }
120
121         sub _validate_name {
122             shift;
123             my $name = shift;
124
125             local $Carp::CarpLevel = $Carp::CarpLevel + 1;
126
127             defined $name
128                 or confess 'name must be a string';
129         }
130
131         {
132             my $en_parser = DateTime::Format::Natural->new(
133                 lang      => 'en',
134                 time_zone => 'UTC',
135             );
136
137             sub _coerce_birth_date {
138                 shift;
139                 my $date = shift;
140
141                 return $date unless defined $date && ! ref $date;
142
143                 my $dt = $en_parser->parse_datetime($date);
144
145                 return $dt ? $dt : undef;
146             }
147         }
148
149         sub _validate_birth_date {
150             shift;
151             my $birth_date = shift;
152
153             local $Carp::CarpLevel = $Carp::CarpLevel + 1;
154
155             $birth_date->isa('DateTime')
156                 or confess 'birth_date must be a DateTime object';
157         }
158
159         sub _validate_shirt_size {
160             shift;
161             my $shirt_size = shift;
162
163             local $Carp::CarpLevel = $Carp::CarpLevel + 1;
164
165             defined $shirt_size
166                 or confess 'shirt_size cannot be undef';
167
168             my %sizes = map { $_ => 1 } qw( s m l xl xxl );
169
170             $sizes{$shirt_size}
171                 or confess "$shirt_size is not a valid shirt size (s, m, l, xl, xxl)";
172         }
173
174         sub name {
175             my $self = shift;
176
177             if (@_) {
178                 $self->_validate_name( $_[0] );
179                 $self->{name} = $_[0];
180             }
181
182             return $self->{name};
183         }
184
185         sub birth_date {
186             my $self = shift;
187
188             if (@_) {
189                 my $date = $self->_coerce_birth_date( $_[0] );
190                 $self->_validate_birth_date( $date );
191
192                 $self->{birth_date} = $date;
193             }
194
195             return $self->{birth_date};
196         }
197
198         sub birth_year {
199             my $self = shift;
200
201             return $self->birth_date->year;
202         }
203
204         sub shirt_size {
205             my $self = shift;
206
207             if (@_) {
208                 $self->_validate_shirt_size( $_[0] );
209                 $self->{shirt_size} = $_[0];
210             }
211
212             return $self->{shirt_size};
213         }
214
215       Wow, that was a mouthful! One thing to note is just how much space the
216       data validation code consumes. As a result, it's pretty common for Perl
217       5 programmers to just not bother. Unfortunately, not validating
218       arguments leads to surprises down the line ("why is birth_date an email
219       address?").
220
221       Also, did you spot the (intentional) bug?
222
223       It's in the "_validate_birth_date()" method. We should check that the
224       value in $birth_date is actually defined and an object before we go and
225       call "isa()" on it! Leaving out those checks means our data validation
226       code could actually cause our program to die. Oops.
227
228       Note that if we add a superclass to Person we'll have to change the
229       constructor to account for that.
230
231       (As an aside, getting all the little details of what Moose does for you
232       just right in this example was really not easy, which emphasizes the
233       point of the example. Moose saves you a lot of work!)
234
235       Now let's see User:
236
237         package User;
238
239         use strict;
240         use warnings;
241
242         use Carp qw( confess );
243         use Email::Valid;
244         use Scalar::Util qw( blessed );
245
246         use parent 'Person';
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, 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
321       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 users
323       and is being actively maintained and developed.
324

AUTHORS

326       ·   Stevan Little <stevan.little@iinteractive.com>
327
328       ·   Dave Rolsky <autarch@urth.org>
329
330       ·   Jesse Luehrs <doy@tozt.net>
331
332       ·   Shawn M Moore <code@sartak.org>
333
334       ·   יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
335
336       ·   Karen Etheridge <ether@cpan.org>
337
338       ·   Florian Ragwitz <rafl@debian.org>
339
340       ·   Hans Dieter Pearcey <hdp@weftsoar.net>
341
342       ·   Chris Prather <chris@prather.org>
343
344       ·   Matt S Trout <mst@shadowcat.co.uk>
345
347       This software is copyright (c) 2006 by Infinity Interactive, Inc.
348
349       This is free software; you can redistribute it and/or modify it under
350       the same terms as the Perl 5 programming language system itself.
351
352
353
354perl v5.32.0                      2020-07-28     Moose::Manual::Unsweetened(3)
Impressum