X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUnsweetened.pod;h=468d5ebc07ec987a73e1dd89f1e784de7ffe205e;hb=48ac876af2c1991bd6cdba0d54b775a121e01725;hp=4da4c4c3fb6a0395357d7e88a1981258312353a8;hpb=e3494ea7a48f0d0065ebfe0a363e9434c5afff2c;p=gitmo%2FMoose.git diff --git a/lib/Moose/Unsweetened.pod b/lib/Moose/Unsweetened.pod index 4da4c4c..468d5eb 100644 --- a/lib/Moose/Unsweetened.pod +++ b/lib/Moose/Unsweetened.pod @@ -1,334 +1,15 @@ -=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'; - } +package Moose::Unsweetened; - sub _validate_shirt_size { - shift; - my $shirt_size = shift; +# ABSTRACT: Moved to Moose::Manual::Unsweetened, so go read that - local $Carp::CarpLevel = $Carp::CarpLevel + 1; +__END__ - 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 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, 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. +=pod -L +=head1 DESCRIPTION -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. +This document has been moved to L. This +POD document still exists for the benefit of anyone out there who +might've linked to it in the past. =cut