Moose-2.1405HEADMoose-2.1405master

1 files changed, 386 insertions, 0 deletions

diff --git a/lib/Moose/Manual/Unsweetened.pod b/lib/Moose/Manual/Unsweetened.pod
new file mode 100644
index 0000000..bd36927
--- /dev/null
+++ b/lib/Moose/Manual/Unsweetened.pod
@@ -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.1405
+
+=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.little@iinteractive.com>
+
+=item *
+
+Dave Rolsky <autarch@urth.org>
+
+=item *
+
+Jesse Luehrs <doy@tozt.net>
+
+=item *
+
+Shawn M Moore <code@sartak.org>
+
+=item *
+
+יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
+
+=item *
+
+Karen Etheridge <ether@cpan.org>
+
+=item *
+
+Florian Ragwitz <rafl@debian.org>
+
+=item *
+
+Hans Dieter Pearcey <hdp@weftsoar.net>
+
+=item *
+
+Chris Prather <chris@prather.org>
+
+=item *
+
+Matt S Trout <mst@shadowcat.co.uk>
+
+=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