--- /dev/null
+=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',
+ );
+
+ 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';
+
+ my $date = $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 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 = shift;
+
+ $self->_coerce_birth_date( $date );
+ $self->_validate_birth_date( $date );
+ $self->{birth_date} = $date;
+ }
+
+ return $self->{birth_date};
+ }
+
+ 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 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 you're well on
+your 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.
+
+=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
projects / gitmo/Moose.git / commitdiff