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   );
  47
  48   subtype 'ShirtSize'
  49       => as 'Str'
  50       => where { /^(?:s|m|l|xl|xxl)$/i }
  51       => message { "$_ is not a valid shirt size (s, m, l, xl, xxl)" };
  52
  53   has shirt_size => (
  54       is      => 'rw',
  55       isa     => 'ShirtSize',
  56       default => 'l',
  57   );
  58
  59 This is a fairly simple class with three attributes. We also define a
  60 type to validate t-shirt sizes because we don't want to end up with
  61 something like "blue" for the shirt size!
  62
  63   package User;
  64
  65   use Email::Valid;
  66   use Moose;
  67   use Moose::Util::TypeConstraints;
  68
  69   extends 'Person';
  70
  71   subtype 'Email'
  72       => as 'Str'
  73       => where { Email::Valid->address($_) }
  74       => message { "$_ is not a valid email address" };
  75
  76   has email_address => (
  77       is       => 'rw',
  78       isa      => 'Email',
  79       required => 1,
  80   );
  81
  82 This class subclasses Person to add a single attribute, email address.
  83
  84 Now we will show what these classes would look like in plain old Perl
  85 5. For the sake of argument, we won't use any base classes or any
  86 helpers like C<Class::Accessor>.
  87
  88   package Person;
  89
  90   use strict;
  91   use warnings;
  92
  93   use Carp qw( confess );
  94   use DateTime;
  95   use DateTime::Format::Natural;
  96
  97
  98   sub new {
  99       my $class = shift;
 100       my %p = ref $_[0] ? %{ $_[0] } : @_;
 101
 102       exists $p{name}
 103           or confess 'name is a required attribute';
 104       $class->_validate_name( $p{name} );
 105
 106       exists $p{birth_date}
 107           or confess 'birth_date is a required attribute';
 108
 109       $p{birth_date} = $class->_coerce_birth_date($date );
 110       $class->_validate_birth_date( $date );
 111
 112       $p{shirt_size} = 'l'
 113           unless exists $p{shirt_size}:
 114
 115       $class->_validate_shirt_size( $p{shirt_size} );
 116
 117       my %self = map { $_ => $p{$_} } qw( name shirt_size );
 118       $self{birth_date} = $date;
 119
 120       return bless \%self, $class;
 121   }
 122
 123   sub _validate_name {
 124       shift;
 125       my $name = shift;
 126
 127       local $Carp::CarpLevel = $Carp::CarpLevel + 1;
 128
 129       defined $name
 130           or confess 'name must be a string';
 131   }
 132
 133   {
 134       my $en_parser = DateTime::Format::Natural->new(
 135           lang      => 'en',
 136           time_zone => 'UTC',
 137       );
 138
 139       sub _coerce_birth_date {
 140           shift;
 141           my $date = shift;
 142
 143           return $date unless defined $date && ! ref $date;
 144
 145           my $dt = $en_parser->parse_datetime($date);
 146
 147           return $dt ? $dt : undef;
 148       }
 149   }
 150
 151   sub _validate_birth_date {
 152       shift;
 153       my $birth_date = shift;
 154
 155       local $Carp::CarpLevel = $Carp::CarpLevel + 1;
 156
 157       $birth_date->isa('DateTime') )
 158           or confess 'birth_date must be a DateTime object';
 159   }
 160
 161   sub _validate_shirt_size {
 162       shift;
 163       my $shirt_size = shift;
 164
 165       local $Carp::CarpLevel = $Carp::CarpLevel + 1;
 166
 167       defined $shirt_size
 168           or confess 'shirt_size cannot be undef';
 169
 170       $shirt_size =~ /^(?:s|m|l|xl|xxl)$/
 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 shirt_size {
 199       my $self = shift;
 200
 201       if (@_) {
 202           $self->_validate_shirt_size( $_[0] );
 203           $self->{shirt_size} = $_[0];
 204       }
 205
 206       return $self->{shirt_size};
 207   }
 208
 209 Wow, that was a mouthful! One thing to note is just how much space the
 210 data validation code consumes. As a result, it's pretty common for
 211 Perl 5 programmers to just not bother, which results in much more
 212 fragile code.
 213
 214 Did you spot the (intentional) bug?
 215
 216 It's in the C<_validate_birth_date()> method. We should check that
 217 that value in C<$birth_date> is actually defined and object before we
 218 go and call C<isa()> on it! Leaving out those checks means our data
 219 validation code could actually cause our program to die. Oops.
 220
 221 There's one bit of code in there worth explaining, which is the
 222 handling of the birth date for coercion. In both the constructor and
 223 accessor, we first take a copy of the birth date before passing it to
 224 the coercion routine. This is to avoid changing the value as it was
 225 passed to those methods, which could cause problems for the caller.
 226
 227 Also note that if we add a superclass to Person we'll have to change
 228 the 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 code was not easy, which just emphasizes the
 232 point, that 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 2008 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