Add an example of delegation too.

[gitmo/Moose.git] / lib / Moose / Unsweetened.pod

=pod

=head1 NAME

Moose::Unsweetened - Moose idioms in plain old Perl 5 without the sugar

=head1 DESCRIPTION

If you're trying to figure out just what the heck Moose does, and how
it saves you time, you might find it helpful to see what Moose is
I<really> doing for you. This document shows you the translation from
Moose sugar back to plain old Perl 5.

=head1 CLASSES AND ATTRIBUTES

First, we define two very small classes the Moose way.

  package Person;

  use DateTime;
  use DateTime::Format::Natural;
  use Moose;
  use Moose::Util::TypeConstraints;

  has name => (
      is       => 'rw',
      isa      => 'Str',
      required => 1,
  );

  # Moose doesn't know about non-Moose-based classes.
  class_type 'DateTime';

  my $en_parser = DateTime::Format::Natural->new(
      lang      => 'en',
      time_zone => 'UTC',
  );

  coerce 'DateTime'
      => from 'Str'
      => via { $en_parser->parse_datetime($_) };

  has birth_date => (
      is      => 'rw',
      isa     => 'DateTime',
      coerce  => 1,
      handles => { birth_year => 'year' },
  );

  subtype 'ShirtSize'
      => as 'Str'
      => where { /^(?:s|m|l|xl|xxl)$/i }
      => message { "$_ is not a valid shirt size (s, m, l, xl, xxl)" };

  has shirt_size => (
      is      => 'rw',
      isa     => 'ShirtSize',
      default => 'l',
  );

This is a fairly simple class with three attributes. We also define a
type to validate t-shirt sizes because we don't want to end up with
something like "blue" for the shirt size!

  package User;

  use Email::Valid;
  use Moose;
  use Moose::Util::TypeConstraints;

  extends 'Person';

  subtype 'Email'
      => as 'Str'
      => where { Email::Valid->address($_) }
      => message { "$_ is not a valid email address" };

  has email_address => (
      is       => 'rw',
      isa      => 'Email',
      required => 1,
  );

This class subclasses Person to add a single attribute, email address.

Now we will show what these classes would look like in plain old Perl
5. For the sake of argument, we won't use any base classes or any
helpers like C<Class::Accessor>.

  package Person;

  use strict;
  use warnings;

  use Carp qw( confess );
  use DateTime;
  use DateTime::Format::Natural;


  sub new {
      my $class = shift;
      my %p = ref $_[0] ? %{ $_[0] } : @_;

      exists $p{name}
          or confess 'name is a required attribute';
      $class->_validate_name( $p{name} );

      exists $p{birth_date}
          or confess 'birth_date is a required attribute';

      $p{birth_date} = $class->_coerce_birth_date($date );
      $class->_validate_birth_date( $date );

      $p{shirt_size} = 'l'
          unless exists $p{shirt_size}:

      $class->_validate_shirt_size( $p{shirt_size} );

      my %self = map { $_ => $p{$_} } qw( name shirt_size );
      $self{birth_date} = $date;

      return bless \%self, $class;
  }

  sub _validate_name {
      shift;
      my $name = shift;

      local $Carp::CarpLevel = $Carp::CarpLevel + 1;

      defined $name
          or confess 'name must be a string';
  }

  {
      my $en_parser = DateTime::Format::Natural->new(
          lang      => 'en',
          time_zone => 'UTC',
      );

      sub _coerce_birth_date {
          shift;
          my $date = shift;

          return $date unless defined $date && ! ref $date;

          my $dt = $en_parser->parse_datetime($date);

          return $dt ? $dt : undef;
      }
  }

  sub _validate_birth_date {
      shift;
      my $birth_date = shift;

      local $Carp::CarpLevel = $Carp::CarpLevel + 1;

      $birth_date->isa('DateTime') )
          or confess 'birth_date must be a DateTime object';
  }

  sub _validate_shirt_size {
      shift;
      my $shirt_size = shift;

      local $Carp::CarpLevel = $Carp::CarpLevel + 1;

      defined $shirt_size
          or confess 'shirt_size cannot be undef';

      $shirt_size =~ /^(?:s|m|l|xl|xxl)$/
          or confess "$shirt_size is not a valid shirt size (s, m, l, xl, xxl)";
  }

  sub name {
      my $self = shift;

      if (@_) {
          $self->_validate_name( $_[0] );
          $self->{name} = $_[0];
      }

      return $self->{name};
  }

  sub birth_date {
      my $self = shift;

      if (@_) {
          my $date = $self->_coerce_birth_date( $_[0] );
          $self->_validate_birth_date( $date );

          $self->{birth_date} = $date;
      }

      return $self->{birth_date};
  }

  sub birth_year {
      my $self = shift;

      return $self->birth_date->year;
  }

  sub shirt_size {
      my $self = shift;

      if (@_) {
          $self->_validate_shirt_size( $_[0] );
          $self->{shirt_size} = $_[0];
      }

      return $self->{shirt_size};
  }

Wow, that was a mouthful! One thing to note is just how much space the
data validation code consumes. As a result, it's pretty common for
Perl 5 programmers to just not bother, which results in much more
fragile code.

Did you spot the (intentional) bug?

It's in the C<_validate_birth_date()> method. We should check that
that value in C<$birth_date> is actually defined and object before we
go and call C<isa()> on it! Leaving out those checks means our data
validation code could actually cause our program to die. Oops.

There's one bit of code in there worth explaining, which is the
handling of the birth date for coercion. In both the constructor and
accessor, we first take a copy of the birth date before passing it to
the coercion routine. This is to avoid changing the value as it was
passed to those methods, which could cause problems for the caller.

Also note that if we add a superclass to Person we'll have to change
the constructor to account for that.

(As an aside, getting all the little details of what Moose does for
you just right in this code was not easy, which just emphasizes the
point, that Moose saves you a lot of work!)

Now let's see User:

  package User;

  use strict;
  use warnings;

  use Carp qw( confess );
  use Email::Valid;
  use Scalar::Util qw( blessed );

  use base 'Person';


  sub new {
      my $class = shift;
      my %p = ref $_[0] ? %{ $_[0] } : @_;

      exists $p{email_address}
          or confess 'email_address is a required attribute';
      $class->_validate_email_address( $p{email_address} );

      my $self = $class->SUPER::new(%p);

      $self->{email_address} = $p{email_address};

      return $self;
  }

  sub _validate_email_address {
      shift;
      my $email_address = shift;

      local $Carp::CarpLevel = $Carp::CarpLevel + 1;

      defined $email_address
          or confess 'email_address must be a string';

      Email::Valid->address($email_address)
          or confess "$email_address is not a valid email address";
  }

  sub email_address {
      my $self = shift;

      if (@_) {
          $self->_validate_email_address( $_[0] );
          $self->{email_address} = $_[0];
      }

      return $self->{email_address};
  }

That one was shorter, but it only has one attribute.

Between the two classes, we have a whole lot of code that doesn't do
much. We could probably simplify this by defining some sort of
"attribute and validation" hash, like this:

  package Person;

  my %Attr = (
      name => {
          required => 1,
          validate => sub { defined $_ },
      },
      birth_date => {
          required => 1,
          validate => sub { blessed $_ && $_->isa('DateTime') },
      },
      shirt_size => {
          required => 1,
          validate => sub { defined $_ && $_ =~ /^(?:s|m|l|xl|xxl)$/i },
      }
  );

Then we could define a base class that would accept such a definition,
and do the right thing. Keep that sort of thing up and we're well on
our way to writing a half-assed version of Moose!

Of course, there are CPAN modules that do some of what Moose does,
like C<Class::Accessor>, C<Class::Meta>, and so on. But none of them
put together all of Moose's features along with a layer of declarative
sugar, nor are these other modules designed for extensibility in the
same way as Moose. With Moose, it's easy to write a MooseX module to
replace or extend a piece of built-in functionality.

=head1 AUTHOR

Dave Rolsky E<lt>autarch@urth.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2008 by Infinity Interactive, Inc.

L<http://www.iinteractive.com>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut