Skip site navigation (1)Skip section navigation (2)

FreeBSD Manual Pages

  
 
  

home | help
Moose::Manual::UnsweetUser(Contributed Perl DocumMoose::Manual::Unsweetened(3)

NAME
       Moose::Manual::Unsweetened - Moose idioms in plain old Perl 5 without
       the sugar

VERSION
       version 2.2013

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
       really doing for	you. This document shows you the translation from
       Moose sugar back	to plain old Perl 5.

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 "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 "_validate_birth_date()" method. We should check that the
       value in	$birth_date is actually	defined	and an object before we	go and
       call "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
       "Class::Accessor", "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.

AUTHORS
       o   Stevan Little <stevan.little@iinteractive.com>

       o   Dave	Rolsky <autarch@urth.org>

       o   Jesse Luehrs	<doy@tozt.net>

       o   Shawn M Moore <code@sartak.org>

       o   xxxx	x<section>xx'xx	(Yuval Kogman) <nothingmuch@woobling.org>

       o   Karen Etheridge <ether@cpan.org>

       o   Florian Ragwitz <rafl@debian.org>

       o   Hans	Dieter Pearcey <hdp@weftsoar.net>

       o   Chris Prather <chris@prather.org>

       o   Matt	S Trout	<mst@shadowcat.co.uk>

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.

perl v5.32.1			  2020-07-21	 Moose::Manual::Unsweetened(3)

NAME | VERSION | DESCRIPTION | CLASSES AND ATTRIBUTES | AUTHORS | COPYRIGHT AND LICENSE

Want to link to this manual page? Use this URL:
<https://www.freebsd.org/cgi/man.cgi?query=Moose::Manual::Unsweetened&sektion=3&manpath=FreeBSD+13.0-RELEASE+and+Ports>

home | help