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