-=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( $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;
+package Moose::Unsweetened;
- local $Carp::CarpLevel = $Carp::CarpLevel + 1;
+# ABSTRACT: Moved to Moose::Manual::Unsweetened, so go read that
- defined $shirt_size
- or confess 'shirt_size cannot be undef';
+__END__
- $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. 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
-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.
-
-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 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.
+=pod
-L<http://www.iinteractive.com>
+=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<Moose::Manual::Unsweetened>. This
+POD document still exists for the benefit of anyone out there who
+might've linked to it in the past.
=cut
projects / gitmo/Moose.git / blobdiff