1Moose::Manual::UnsweeteUnseedr(3C)ontributed Perl DocumeMnotoastei:o:nManual::Unsweetened(3)
2
6 Moose::Manual::Unsweetened - Moose idioms in plain old Perl 5 without
7 the sugar
8
10 version 2.2013
11
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
19 First, we define two very small classes the Moose way.
20 package Person;
22 use DateTime;
24 use DateTime::Format::Natural;
25 use Moose;
26 use Moose::Util::TypeConstraints;
27 has name => (
29 is => 'rw',
30 isa => 'Str',
31 required => 1,
32 );
33 # Moose doesn't know about non-Moose-based classes.
35 class_type 'DateTime';
36 my $en_parser = DateTime::Format::Natural->new(
38 lang => 'en',
39 time_zone => 'UTC',
40 );
41 coerce 'DateTime'
43 => from 'Str'
44 => via { $en_parser->parse_datetime($_) };
45 has birth_date => (
47 is => 'rw',
48 isa => 'DateTime',
49 coerce => 1,
50 handles => { birth_year => 'year' },
51 );
52 enum 'ShirtSize' => [qw( s m l xl xxl )];
54 has shirt_size => (
56 is => 'rw',
57 isa => 'ShirtSize',
58 default => 'l',
59 );
60 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 package User;
66 use Email::Valid;
68 use Moose;
69 use Moose::Util::TypeConstraints;
70 extends 'Person';
72 subtype 'Email'
74 => as 'Str'
75 => where { Email::Valid->address($_) }
76 => message { "$_ is not a valid email address" };
77 has email_address => (
79 is => 'rw',
80 isa => 'Email',
81 required => 1,
82 );
83 This class subclasses Person to add a single attribute, email address.
85 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 package Person;
91 use strict;
93 use warnings;
94 use Carp qw( confess );
96 use DateTime;
97 use DateTime::Format::Natural;
98 sub new {
100 my $class = shift;
101 my %p = ref $_[0] ? %{ $_[0] } : @_;
102 exists $p{name}
104 or confess 'name is a required attribute';
105 $class->_validate_name( $p{name} );
106 exists $p{birth_date}
108 or confess 'birth_date is a required attribute';
109 $p{birth_date} = $class->_coerce_birth_date( $p{birth_date} );
111 $class->_validate_birth_date( $p{birth_date} );
112 $p{shirt_size} = 'l'
114 unless exists $p{shirt_size};
115 $class->_validate_shirt_size( $p{shirt_size} );
117 return bless \%p, $class;
119 }
120 sub _validate_name {
122 shift;
123 my $name = shift;
124 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
126 defined $name
128 or confess 'name must be a string';
129 }
130 {
132 my $en_parser = DateTime::Format::Natural->new(
133 lang => 'en',
134 time_zone => 'UTC',
135 );
136 sub _coerce_birth_date {
138 shift;
139 my $date = shift;
140 return $date unless defined $date && ! ref $date;
142 my $dt = $en_parser->parse_datetime($date);
144 return $dt ? $dt : undef;
146 }
147 }
148 sub _validate_birth_date {
150 shift;
151 my $birth_date = shift;
152 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
154 $birth_date->isa('DateTime')
156 or confess 'birth_date must be a DateTime object';
157 }
158 sub _validate_shirt_size {
160 shift;
161 my $shirt_size = shift;
162 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
164 defined $shirt_size
166 or confess 'shirt_size cannot be undef';
167 my %sizes = map { $_ => 1 } qw( s m l xl xxl );
169 $sizes{$shirt_size}
171 or confess "$shirt_size is not a valid shirt size (s, m, l, xl, xxl)";
172 }
173 sub name {
175 my $self = shift;
176 if (@_) {
178 $self->_validate_name( $_[0] );
179 $self->{name} = $_[0];
180 }
181 return $self->{name};
183 }
184 sub birth_date {
186 my $self = shift;
187 if (@_) {
189 my $date = $self->_coerce_birth_date( $_[0] );
190 $self->_validate_birth_date( $date );
191 $self->{birth_date} = $date;
193 }
194 return $self->{birth_date};
196 }
197 sub birth_year {
199 my $self = shift;
200 return $self->birth_date->year;
202 }
203 sub shirt_size {
205 my $self = shift;
206 if (@_) {
208 $self->_validate_shirt_size( $_[0] );
209 $self->{shirt_size} = $_[0];
210 }
211 return $self->{shirt_size};
213 }
214 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 Also, did you spot the (intentional) bug?
222 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 Note that if we add a superclass to Person we'll have to change the
229 constructor to account for that.
230 (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 Now let's see User:
236 package User;
238 use strict;
240 use warnings;
241 use Carp qw( confess );
243 use Email::Valid;
244 use Scalar::Util qw( blessed );
245 use parent 'Person';
247 sub new {
249 my $class = shift;
250 my %p = ref $_[0] ? %{ $_[0] } : @_;
251 exists $p{email_address}
253 or confess 'email_address is a required attribute';
254 $class->_validate_email_address( $p{email_address} );
255 my $self = $class->SUPER::new(%p);
257 $self->{email_address} = $p{email_address};
259 return $self;
261 }
262 sub _validate_email_address {
264 shift;
265 my $email_address = shift;
266 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
268 defined $email_address
270 or confess 'email_address must be a string';
271 Email::Valid->address($email_address)
273 or confess "$email_address is not a valid email address";
274 }
275 sub email_address {
277 my $self = shift;
278 if (@_) {
280 $self->_validate_email_address( $_[0] );
281 $self->{email_address} = $_[0];
282 }
283 return $self->{email_address};
285 }
286 That one was shorter, but it only has one attribute.
288 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 package Person;
294 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 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 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 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
326 · Stevan Little <stevan.little@iinteractive.com>
327 · Dave Rolsky <autarch@urth.org>
329 · Jesse Luehrs <doy@tozt.net>
331 · Shawn M Moore <code@sartak.org>
333 · יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
335 · Karen Etheridge <ether@cpan.org>
337 · Florian Ragwitz <rafl@debian.org>
339 · Hans Dieter Pearcey <hdp@weftsoar.net>
341 · Chris Prather <chris@prather.org>
343 · Matt S Trout <mst@shadowcat.co.uk>
345
347 This software is copyright (c) 2006 by Infinity Interactive, Inc.
348 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.
351perl v5.32.0 2020-07-28 Moose::Manual::Unsweetened(3)