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($date );
 112       $class->_validate_birth_date( $date );
 113
 114       $p{shirt_size} = 'l'
 115           unless exists $p{shirt_size}:
 116
 117       $class->_validate_shirt_size( $p{shirt_size} );
 118
 119       my %self = map { $_ => $p{$_} } qw( name shirt_size );
 120       $self{birth_date} = $date;
 121
 122       return bless \%self, $class;
 123   }
 124
 125   sub _validate_name {
 126       shift;
 127       my $name = shift;
 128
 129       local $Carp::CarpLevel = $Carp::CarpLevel + 1;
 130
 131       defined $name
 132           or confess 'name must be a string';
 133   }
 134
 135   {
 136       my $en_parser = DateTime::Format::Natural->new(
 137           lang      => 'en',
 138           time_zone => 'UTC',
 139       );
 140
 141       sub _coerce_birth_date {
 142           shift;
 143           my $date = shift;
 144
 145           return $date unless defined $date && ! ref $date;
 146
 147           my $dt = $en_parser->parse_datetime($date);
 148
 149           return $dt ? $dt : undef;
 150       }
 151   }
 152
 153   sub _validate_birth_date {
 154       shift;
 155       my $birth_date = shift;
 156
 157       local $Carp::CarpLevel = $Carp::CarpLevel + 1;
 158
 159       $birth_date->isa('DateTime') )
 160           or confess 'birth_date must be a DateTime object';
 161   }
 162
 163   sub _validate_shirt_size {
 164       shift;
 165       my $shirt_size = shift;
 166
 167       local $Carp::CarpLevel = $Carp::CarpLevel + 1;
 168
 169       defined $shirt_size
 170           or confess 'shirt_size cannot be undef';
 171
 172       $shirt_size =~ /^(?:s|m|l|xl|xxl)$/
 173           or confess "$shirt_size is not a valid shirt size (s, m, l, xl, xxl)";
 174   }
 175
 176   sub name {
 177       my $self = shift;
 178
 179       if (@_) {
 180           $self->_validate_name( $_[0] );
 181           $self->{name} = $_[0];
 182       }
 183
 184       return $self->{name};
 185   }
 186
 187   sub birth_date {
 188       my $self = shift;
 189
 190       if (@_) {
 191           my $date = $self->_coerce_birth_date( $_[0] );
 192           $self->_validate_birth_date( $date );
 193
 194           $self->{birth_date} = $date;
 195       }
 196
 197       return $self->{birth_date};
 198   }
 199
 200   sub birth_year {
 201       my $self = shift;
 202
 203       return $self->birth_date->year;
 204   }
 205
 206   sub shirt_size {
 207       my $self = shift;
 208
 209       if (@_) {
 210           $self->_validate_shirt_size( $_[0] );
 211           $self->{shirt_size} = $_[0];
 212       }
 213
 214       return $self->{shirt_size};
 215   }
 216
 217 Wow, that was a mouthful! One thing to note is just how much space the
 218 data validation code consumes. As a result, it's pretty common for
 219 Perl 5 programmers to just not bother, which results in much more
 220 fragile code.
 221
 222 Did you spot the (intentional) bug?
 223
 224 It's in the C<_validate_birth_date()> method. We should check that
 225 that value in C<$birth_date> is actually defined and object before we
 226 go and call C<isa()> on it! Leaving out those checks means our data
 227 validation code could actually cause our program to die. Oops.
 228
 229 There's one bit of code in there worth explaining, which is the
 230 handling of the birth date for coercion. In both the constructor and
 231 accessor, we first take a copy of the birth date before passing it to
 232 the coercion routine. This is to avoid changing the value as it was
 233 passed to those methods, which could cause problems for the caller.
 234
 235 Also note that if we add a superclass to Person we'll have to change
 236 the constructor to account for that.
 237
 238 (As an aside, getting all the little details of what Moose does for
 239 you just right in this code was not easy, which just emphasizes the
 240 point, that Moose saves you a lot of work!)
 241
 242 Now let's see User:
 243
 244   package User;
 245
 246   use strict;
 247   use warnings;
 248
 249   use Carp qw( confess );
 250   use Email::Valid;
 251   use Scalar::Util qw( blessed );
 252
 253   use base 'Person';
 254
 255
 256   sub new {
 257       my $class = shift;
 258       my %p = ref $_[0] ? %{ $_[0] } : @_;
 259
 260       exists $p{email_address}
 261           or confess 'email_address is a required attribute';
 262       $class->_validate_email_address( $p{email_address} );
 263
 264       my $self = $class->SUPER::new(%p);
 265
 266       $self->{email_address} = $p{email_address};
 267
 268       return $self;
 269   }
 270
 271   sub _validate_email_address {
 272       shift;
 273       my $email_address = shift;
 274
 275       local $Carp::CarpLevel = $Carp::CarpLevel + 1;
 276
 277       defined $email_address
 278           or confess 'email_address must be a string';
 279
 280       Email::Valid->address($email_address)
 281           or confess "$email_address is not a valid email address";
 282   }
 283
 284   sub email_address {
 285       my $self = shift;
 286
 287       if (@_) {
 288           $self->_validate_email_address( $_[0] );
 289           $self->{email_address} = $_[0];
 290       }
 291
 292       return $self->{email_address};
 293   }
 294
 295 That one was shorter, but it only has one attribute.
 296
 297 Between the two classes, we have a whole lot of code that doesn't do
 298 much. We could probably simplify this by defining some sort of
 299 "attribute and validation" hash, like this:
 300
 301   package Person;
 302
 303   my %Attr = (
 304       name => {
 305           required => 1,
 306           validate => sub { defined $_ },
 307       },
 308       birth_date => {
 309           required => 1,
 310           validate => sub { blessed $_ && $_->isa('DateTime') },
 311       },
 312       shirt_size => {
 313           required => 1,
 314           validate => sub { defined $_ && $_ =~ /^(?:s|m|l|xl|xxl)$/i },
 315       }
 316   );
 317
 318 Then we could define a base class that would accept such a definition,
 319 and do the right thing. Keep that sort of thing up and we're well on
 320 our way to writing a half-assed version of Moose!
 321
 322 Of course, there are CPAN modules that do some of what Moose does,
 323 like C<Class::Accessor>, C<Class::Meta>, and so on. But none of them
 324 put together all of Moose's features along with a layer of declarative
 325 sugar, nor are these other modules designed for extensibility in the
 326 same way as Moose. With Moose, it's easy to write a MooseX module to
 327 replace or extend a piece of built-in functionality.
 328
 329 =head1 AUTHOR
 330
 331 Dave Rolsky E<lt>autarch@urth.orgE<gt>
 332
 333 =head1 COPYRIGHT AND LICENSE
 334
 335 Copyright 2008 by Infinity Interactive, Inc.
 336
 337 L<http://www.iinteractive.com>
 338
 339 This library is free software; you can redistribute it and/or modify
 340 it under the same terms as Perl itself.
 341
 342 =cut