This commit is contained in:
mschuepbach
386
CPAN/Moose/Manual/Unsweetened.pod
Normal file
386
CPAN/Moose/Manual/Unsweetened.pod
Normal file
@@ -0,0 +1,386 @@
|
||||
# PODNAME: Moose::Manual::Unsweetened
|
||||
# ABSTRACT: Moose idioms in plain old Perl 5 without the sugar
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Moose::Manual::Unsweetened - Moose idioms in plain old Perl 5 without the sugar
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 2.2207
|
||||
|
||||
=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' },
|
||||
);
|
||||
|
||||
enum 'ShirtSize' => [qw( 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 an enum
|
||||
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( $p{birth_date} );
|
||||
$class->_validate_birth_date( $p{birth_date} );
|
||||
|
||||
$p{shirt_size} = 'l'
|
||||
unless exists $p{shirt_size};
|
||||
|
||||
$class->_validate_shirt_size( $p{shirt_size} );
|
||||
|
||||
return bless \%p, $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';
|
||||
|
||||
my %sizes = map { $_ => 1 } qw( s m l xl xxl );
|
||||
|
||||
$sizes{$shirt_size}
|
||||
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. Unfortunately, not validating
|
||||
arguments leads to surprises down the line ("why is birth_date an
|
||||
email address?").
|
||||
|
||||
Also, did you spot the (intentional) bug?
|
||||
|
||||
It's in the C<_validate_birth_date()> method. We should check that
|
||||
the value in C<$birth_date> is actually defined and an 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.
|
||||
|
||||
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 example was really not easy, which emphasizes
|
||||
the point of the example. 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 parent '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.
|
||||
|
||||
Moose is a complete OO package in and of itself, and is part of a rich
|
||||
ecosystem of extensions. It also has an enthusiastic community of
|
||||
users and is being actively maintained and developed.
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
Stevan Little <stevan@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Dave Rolsky <autarch@urth.org>
|
||||
|
||||
=item *
|
||||
|
||||
Jesse Luehrs <doy@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Shawn M Moore <sartak@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
|
||||
|
||||
=item *
|
||||
|
||||
Karen Etheridge <ether@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Florian Ragwitz <rafl@debian.org>
|
||||
|
||||
=item *
|
||||
|
||||
Hans Dieter Pearcey <hdp@cpan.org>
|
||||
|
||||
=item *
|
||||
|
||||
Chris Prather <chris@prather.org>
|
||||
|
||||
=item *
|
||||
|
||||
Matt S Trout <mstrout@cpan.org>
|
||||
|
||||
=back
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2006 by Infinity Interactive, Inc.
|
||||
|
||||
This is free software; you can redistribute it and/or modify it under
|
||||
the same terms as the Perl 5 programming language system itself.
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user