From: Dave Rolsky Date: Wed, 3 Sep 2008 03:59:21 +0000 (+0000) Subject: Add Moose::Unsweetened, parallel examples of classes with & without X-Git-Tag: 0.57~17 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b8790e4414703462f74a9f8436b50b6102362d83;p=gitmo%2FMoose.git Add Moose::Unsweetened, parallel examples of classes with & without Moose. --- diff --git a/lib/Moose/Unsweetened.pod b/lib/Moose/Unsweetened.pod new file mode 100644 index 0000000..2250768 --- /dev/null +++ b/lib/Moose/Unsweetened.pod @@ -0,0 +1,334 @@ +=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 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. + + 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 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, C, 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 Eautarch@urth.orgE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2008 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut