lib/Moose/Manual/Unsweetened.pod

   1 package Moose::Manual::Unsweetened;
   2
   3 # ABSTRACT: Moose idioms in plain old Perl 5 without the sugar
   4
   5 __END__
   6
   7 =pod
   8
   9 =head1 DESCRIPTION
  10
  11 If you're trying to figure out just what the heck Moose does, and how
  12 it saves you time, you might find it helpful to see what Moose is
  13 I<really> doing for you. This document shows you the translation from
  14 Moose sugar back to plain old Perl 5.
  15
  16 =head1 CLASSES AND ATTRIBUTES
  17
  18 First, we define two very small classes the Moose way.
  19
  20   package Person;
  21
  22   use DateTime;
  23   use DateTime::Format::Natural;
  24   use Moose;
  25   use Moose::Util::TypeConstraints;
  26
  27   has name => (
  28       is       => 'rw',
  29       isa      => 'Str',
  30       required => 1,
  31   );
  32
  33   # Moose doesn't know about non-Moose-based classes.
  34   class_type 'DateTime';
  35
  36   my $en_parser = DateTime::Format::Natural->new(
  37       lang      => 'en',
  38       time_zone => 'UTC',
  39   );
  40
  41   coerce 'DateTime'
  42       => from 'Str'
  43       => via { $en_parser->parse_datetime($_) };
  44
  45   has birth_date => (
  46       is      => 'rw',
  47       isa     => 'DateTime',
  48       coerce  => 1,
  49       handles => { birth_year => 'year' },
  50   );
  51
  52   enum 'ShirtSize' => qw( 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 an enum
  61 type to validate t-shirt sizes because we don't want to end up with something
  62 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   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( $p{birth_date} );
 110       $class->_validate_birth_date( $p{birth_date} );
 111
 112       $p{shirt_size} = 'l'
 113           unless exists $p{shirt_size}:
 114
 115       $class->_validate_shirt_size( $p{shirt_size} );
 116
 117       return bless \%p, $class;
 118   }
 119
 120   sub _validate_name {
 121       shift;
 122       my $name = shift;
 123
 124       local $Carp::CarpLevel = $Carp::CarpLevel + 1;
 125
 126       defined $name
 127           or confess 'name must be a string';
 128   }
 129
 130   {
 131       my $en_parser = DateTime::Format::Natural->new(
 132           lang      => 'en',
 133           time_zone => 'UTC',
 134       );
 135
 136       sub _coerce_birth_date {
 137           shift;
 138           my $date = shift;
 139
 140           return $date unless defined $date && ! ref $date;
 141
 142           my $dt = $en_parser->parse_datetime($date);
 143
 144           return $dt ? $dt : undef;
 145       }
 146   }
 147
 148   sub _validate_birth_date {
 149       shift;
 150       my $birth_date = shift;
 151
 152       local $Carp::CarpLevel = $Carp::CarpLevel + 1;
 153
 154       $birth_date->isa('DateTime')
 155           or confess 'birth_date must be a DateTime object';
 156   }
 157
 158   sub _validate_shirt_size {
 159       shift;
 160       my $shirt_size = shift;
 161
 162       local $Carp::CarpLevel = $Carp::CarpLevel + 1;
 163
 164       defined $shirt_size
 165           or confess 'shirt_size cannot be undef';
 166
 167       my %sizes = map { $_ => 1 } qw( s m l xl xxl );
 168
 169       $sizes{$shirt_size}
 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   sub new {
 248       my $class = shift;
 249       my %p = ref $_[0] ? %{ $_[0] } : @_;
 250
 251       exists $p{email_address}
 252           or confess 'email_address is a required attribute';
 253       $class->_validate_email_address( $p{email_address} );
 254
 255       my $self = $class->SUPER::new(%p);
 256
 257       $self->{email_address} = $p{email_address};
 258
 259       return $self;
 260   }
 261
 262   sub _validate_email_address {
 263       shift;
 264       my $email_address = shift;
 265
 266       local $Carp::CarpLevel = $Carp::CarpLevel + 1;
 267
 268       defined $email_address
 269           or confess 'email_address must be a string';
 270
 271       Email::Valid->address($email_address)
 272           or confess "$email_address is not a valid email address";
 273   }
 274
 275   sub email_address {
 276       my $self = shift;
 277
 278       if (@_) {
 279           $self->_validate_email_address( $_[0] );
 280           $self->{email_address} = $_[0];
 281       }
 282
 283       return $self->{email_address};
 284   }
 285
 286 That one was shorter, but it only has one attribute.
 287
 288 Between the two classes, we have a whole lot of code that doesn't do
 289 much. We could probably simplify this by defining some sort of
 290 "attribute and validation" hash, like this:
 291
 292   package Person;
 293
 294   my %Attr = (
 295       name => {
 296           required => 1,
 297           validate => sub { defined $_ },
 298       },
 299       birth_date => {
 300           required => 1,
 301           validate => sub { blessed $_ && $_->isa('DateTime') },
 302       },
 303       shirt_size => {
 304           required => 1,
 305           validate => sub { defined $_ && $_ =~ /^(?:s|m|l|xl|xxl)$/i },
 306       }
 307   );
 308
 309 Then we could define a base class that would accept such a definition,
 310 and do the right thing. Keep that sort of thing up and we're well on
 311 our way to writing a half-assed version of Moose!
 312
 313 Of course, there are CPAN modules that do some of what Moose does,
 314 like C<Class::Accessor>, C<Class::Meta>, and so on. But none of them
 315 put together all of Moose's features along with a layer of declarative
 316 sugar, nor are these other modules designed for extensibility in the
 317 same way as Moose. With Moose, it's easy to write a MooseX module to
 318 replace or extend a piece of built-in functionality.
 319
 320 Moose is a complete OO package in and of itself, and is part of a rich
 321 ecosystem of extensions. It also has an enthusiastic community of
 322 users, and is being actively maintained and developed.
 323
 324 =cut