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