lib/Moose/Manual/Unsweetened.pod

   1 =pod
   2
   3 =head1 NAME
   4
   5 Moose::Manual::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 the value in C<$birth_date> is actually defined and an object before
 224 we 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 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
 323 users, and is being actively maintained and developed.
 324
 325 =head1 AUTHOR
 326
 327 Dave Rolsky E<lt>autarch@urth.orgE<gt>
 328
 329 =head1 COPYRIGHT AND LICENSE
 330
 331 Copyright 2009 by Infinity Interactive, Inc.
 332
 333 L<http://www.iinteractive.com>
 334
 335 This library is free software; you can redistribute it and/or modify
 336 it under the same terms as Perl itself.
 337
 338 =cut