Introduction to Moose

Dave Rolsky

http://www.urth.org/~autarch/intro-to-moose.tar.gz

Introduce Yourselves

Moose Summed Up

Moose Background

Part 0: Moose Concepts

Classes

Class Example

package Person;
use Moose;

Attributes

Attributes

Attribute Example

package Person;
use Moose;

has first_name => ( is => 'ro' );

Methods

package Person;
use Moose;

sub greet { ... }

Roles

Roles

Role Example

package HasPermissions;
use Moose::Role;

has is_admin => ( is => 'rw' );

Role Example

And then ...

package Person;
use Moose;

with 'HasPermissions';

Method Modifiers

Before and After

before 'foo'
    => sub { warn 'About to call foo()' };

after  'foo'
    => sub { warn 'Leaving foo()' };

Around

around 'foo' => sub {
    my $real_foo = shift;
    my $self     = shift;

    warn 'Just before foo()';
    my @return =
        $self->$real_foo( @_, bar => 42 );

    return (
        @return,
        'modify return values'
    );
};

Type Constraints

Type Constraint Example

package Person;
use Moose;

has weight => (
    is  => 'ro',
    isa => 'Int',
);

# kaboom
Person->new( weight => 'heavy' );

Delegation

Delegation

package Person;
use Moose;

has blog_uri => (
    is      => 'rw',
    isa     => 'URI',
    handles => { 'blog_host' => 'host' },
);

$person->blog_host;
# really calls $person->blog_uri->host

Constructors

Destructors

Moose Meta-API

Moose Meta-API

Why Moose?

With Moose

package Person;
use Moose;

has last_name => (
    is  => 'rw',
    isa => 'Str',
);

Without Moose

package Person;
use strict;
use warnings;
use Carp 'confess';

sub new {
    my $class = shift;
    my %args  = @_;
    my $self  = {};

    if (exists $args{last_name}) {
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $args{last_name}"
            if ref($args{last_name});
        $self->{last_nane} = $args{last_name};
    }

    return bless $self, $class;
}

sub last_name {
    my $self = shift;

    if (@_) {
        my $value = shift;
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $value"
            if ref($value);
        $self->{last_name} = $value;
    }

    return $self->{last_name};
}

Side by side

package Person;
use Moose;

has last_name => (
    is  => 'rw',
    isa => 'Str',
);
package Person;
use strict;
use warnings;
use Carp 'confess';

sub new {
    my $class = shift;
    my %args  = @_;
    my $self  = {};

    if (exists $args{last_name}) {
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $args{last_name}"
            if ref($args{last_name});
        $self->{last_nane} = $args{last_name};
    }

    return bless $self, $class;
}

sub last_name {
    my $self = shift;

    if (@_) {
        my $value = shift;
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $value"
            if ref($value);
        $self->{last_name} = $value;
    }

    return $self->{last_name};
}

Side by side

package Person;
use Moose;

has last_name => (
    is  => 'rw',
    isa => 'Str',
);
package Person;
use strict;
use warnings;
use Carp 'confess';

sub new {
    my $class = shift;
    my %args  = @_;
    my $self  = {};

    if (exists $args{last_name}) {
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $args{last_name}"
            if ref($args{last_name});
        $self->{last_nane} = $args{last_name};
    }

    return bless $self, $class;
}

sub last_name {
    my $self = shift;

    if (@_) {
        my $value = shift;
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $value"
            if ref($value);
        $self->{last_name} = $value;
    }

    return $self->{last_name};
}

Side by side

package Person;
use Moose;

has last_name => (
    is  => 'rw',
    isa => 'Str',
);
package Person;
use strict;
use warnings;
use Carp 'confess';

sub new {
    my $class = shift;
    my %args  = @_;
    my $self  = {};

    if (exists $args{last_name}) {
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $args{last_name}"
            if ref($args{last_name});
        $self->{last_nane} = $args{last_name};
    }

    return bless $self, $class;
}

sub last_name {
    my $self = shift;

    if (@_) {
        my $value = shift;
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $value"
            if ref($value);
        $self->{last_name} = $value;
    }

    return $self->{last_name};
}

Side by side

package Person;
use Moose;

has last_name => (
    is  => 'rw',
    isa => 'Str',
);
package Person;
use strict;
use warnings;
use Carp 'confess';

sub new {
    my $class = shift;
    my %args  = @_;
    my $self  = {};

    if (exists $args{last_name}) {
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $args{last_name}"
            if ref($args{last_name});
        $self->{last_nane} = $args{last_name};
    }

    return bless $self, $class;
}

sub last_name {
    my $self = shift;

    if (@_) {
        my $value = shift;
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $value"
            if ref($value);
        $self->{last_name} = $value;
    }

    return $self->{last_name};
}

Side by side

package Person;
use Moose;

has last_name => (
    is  => 'rw',
    isa => 'Str',
);
package Person;
use strict;
use warnings;
use Carp 'confess';

sub new {
    my $class = shift;
    my %args  = @_;
    my $self  = {};

    if (exists $args{last_name}) {
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $args{last_name}"
            if ref($args{last_name});
        $self->{last_nane} = $args{last_name};
    }

    return bless $self, $class;
}

sub last_name {
    my $self = shift;

    if (@_) {
        my $value = shift;
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $value"
            if ref($value);
        $self->{last_name} = $value;
    }

    return $self->{last_name};
}

Side by side

package Person;
use Moose;

has last_name => (
    is  => 'rw',
    isa => 'Str',
);
package Person;
use strict;
use warnings;
use Carp 'confess';

sub new {
    my $class = shift;
    my %args  = @_;
    my $self  = {};

    if (exists $args{last_name}) {
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $args{last_name}"
            if ref($args{last_name});
        $self->{last_nane} = $args{last_name};
    }

    return bless $self, $class;
}

sub last_name {
    my $self = shift;

    if (@_) {
        my $value = shift;
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $value"
            if ref($value);
        $self->{last_name} = $value;
    }

    return $self->{last_name};
}

Side by side

5 lines 21 lines
92 characters 741 characters
package Person;
use Moose;

has last_name => (
    is  => 'rw',
    isa => 'Str',
);
package Person;
use strict;
use warnings;
use Carp 'confess';

sub new {
    my $class = shift;
    my %args  = @_;
    my $self  = {};

    if (exists $args{last_name}) {
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $args{last_name}"
            if ref($args{last_name});
        $self->{last_nane} = $args{last_name};
    }

    return bless $self, $class;
}

sub last_name {
    my $self = shift;

    if (@_) {
        my $value = shift;
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $value"
            if ref($value);
        $self->{last_name} = $value;
    }

    return $self->{last_name};
}

Typo?

sub new {
    my $class = shift;
    my %args  = @_;
    my $self  = {};

    if (exists $args{last_name}) {
        confess "Attribute (last_name) does not pass the type constraint because: "
                . "Validation failed for 'Str' with value $args{last_name}"
            if ref($args{last_name});
        $self->{last_nane} = $args{last_name};
    }

    return bless $self, $class;
}

Typo?

if (exists $args{last_name}) {
    confess "Attribute (last_name) does not pass the type constraint because: "
            . "Validation failed for 'Str' with value $args{last_name}"
        if ref($args{last_name});
    $self->{last_nane} = $args{last_name};
}

Typo?

$self->{last_nane} = $args{last_name};

Typo?

$self->{last_nane}

Why Moose?

package Person;
use Moose;

has last_name => (
    is  => 'rw',
    isa => 'Str',
);

More Why Moose?

Part 1: Moose Classes

Moose Classes

Moose.pm and Your Class

package Person;
use Moose;

What Moose::Object Provides

BUILDARGS

BUILDARGS Example

package Person;
use Moose;

sub BUILDARGS {
    my $class = shift;

    if ( @_ == 1 && ! ref $_[0] ) {
        return { ssn => $_[0] };
    }
    return $class->SUPER::BUILDARGS(@_);
}

Person->new('123-45-6789')

BUILD

BUILD Example

package Person;
use Moose;

sub BUILD {
    my $self = shift;

    if ( $self->country_of_residence
         eq 'USA' ) {
        die 'All US residents'
            . ' must have an SSN'
            unless $self->has_ssn;
    }
}

Object Construction a la Moose

Person->new(@args)
  1. Calls Person->BUILDARGS(@args) to turn @args into a hashref
  2. Blesses a reference
  3. Populates attributes based on the hashref from #1
  4. Calls $new_object->BUILDALL($constructor_args)
    ... which calls all BUILD methods
  5. Returns the object

The Object is Opaque

DEMOLISH

extends

package Employee;
use Moose;
extends 'Person';

extends

Wrong

package EvilEmployee;
use Moose;
extends 'Person';
extends 'Thief';

Right

package EvilEmployee;
use Moose;
extends 'Person', 'Thief';

Extending un-Moose-y Parents

package My::LWP;
use Moose;
extends 'LWP';

override and super

override and super

package Employee;
use Moose;

extends 'Person';

override work => sub {
    my $self = shift;

    die "Pay me first"
        unless $self->got_paid;
    return super();
};

Caveat super

Minimal Attributes

Read-write attributes

package Person;
use Moose;

has first_name => ( is => 'rw' );

my $person =
    Person->new( first_name => 'Dave' );

$person->first_name('Stevan');
print $person->first_name; # Stevan

Read-only attributes

package Person;
use Moose;

has first_name => ( is => 'ro' );

my $person =
    Person->new( first_name => 'Dave' );

$person->first_name('Stevan'); # dies

There is More to Come

Cleaning Up Moose Droppings

package Person;
use Moose;

# true
Person->can('extends');

Cleaning Up Moose Droppings

package Person;
use Moose;

...

no Moose;

# false
Person->can('extends');

Cleaning Up Moose Droppings

package Person;
use Moose;
use namespace::autoclean;

...

# false
Person->can('extends');

No Moose

Immutability

package Person;
use Moose;

__PACKAGE__->meta->make_immutable;

What make_immutable does

When to Immutabilize?

Classes Summary

Questions?

Exercises

# cd exercises

# perl bin/prove -lv t/00-prereq.t

## Read the instructions in t/01-classes.t

# perl bin/prove -lv t/01-classes.t

# edit lib/Person.pm and lib/Employee.pm

Iterate til this passes all its tests

Part 2: Roles

Just What Is a Role?

Roles - State and Behavior

package HasPermissions;
use Moose::Role;
# state
has access_level => ( is => 'rw' );

# behavior
sub can_access {
    my $self     = shift;
    my $required = shift;

    return $self->access_level
             >= $required;
}

Roles Can Define Interfaces

package Printable;
use Moose::Role;

requires 'as_string';

Roles Can Do All Three

package Printable;
use Moose::Role;

requires 'as_string';

has has_been_printed => ( is => 'rw'  );

sub print {
    my $self = shift;
    print $self->as_string;
    $self->has_been_printed(1);
}

Classes Consume Roles

package Person;
use Moose;

with 'Printable';

# required by role
sub as_string { $_[0]->first_name() }

Classes Consume Roles

my $person = Person->new(
    first_name   => 'Kenichi',
    last_name    => 'Asai',
    access_level => 42,
);

$person->print(); # prints 'Kenichi'

Roles in Practice

In Other Words ...

package Person;
use Moose;

with 'Printable';

sub as_string { $_[0]->first_name() }

In Other Words ...

package Person;
use Moose;

with 'Printable';

sub as_string { $_[0]->first_name() }

has has_been_printed => ( is => 'rw'  );

sub print {
    my $self = shift;
    print $self->as_string;
    $self->has_been_printed(1);
}

Except

if ( Person->does('Printable') ) { ... }

# or ...

Person->meta->does_role('Printable')

These Names Are the Same

Conflicts Between Roles

Conflict Example

package IsFragile;
use Moose::Role;

sub break { ... }

package CanBreakdance;
use Moose::Role;

sub break { ... }

Conflict Example

package FragileDancer;
use Moose;

with 'IsFragile', 'CanBreakdance';

Conflict Resolution

Conflicts Are a Smell

Roles With Roles

package Comparable;
use Moose::Role;

requires 'compare';

Roles With Roles

package TestsEquality;
use Moose::Role;

with 'Comparable';

sub is_equal {
    my $self = shift;
    return $self->compare(@_) == 0;
}

And then ...

package Integer;
use Moose;

with 'TestsEquality';

# Satisfies the Comparable role
sub compare { ... }

Integer->does('TestsEquality'); # true
Integer->does('Comparable'); # also true!

Roles as Interfaces

The Attribute Gotcha

package HasSize;
use Moose::Role;

requires 'size';

package Shirt;
use Moose;

with 'HasSize';

has size => ( is => 'ro' );

The Attribute Gotcha Workaround

package HasSize;
use Moose::Role;

requires 'size';

package Shirt;
use Moose;

has size => ( is => 'ro' );

with 'HasSize';

Compile-time Is a Lie

Enforcing Roles

package Comparison;
use Moose;

has [ 'left', 'right' ] => (
    is   => 'ro',
    does => 'Comparable',
);

Roles Can Be Applied to Objects

use Moose::Util qw( apply_all_roles );

my $fragile_person = Person->new( ... );
apply_all_roles( $fragile_person,
                 'IsFragile' );

Roles Are Dirty Too

package Comparable;
use Moose::Role;

requires 'compare';

no Moose::Role;

The Zen of Roles

Abstract Examples

Real Examples

Real Examples

Roles Summary

Questions?

Exercises

# cd exercises
# perl bin/prove -lv t/02-roles.t

Iterate til this passes all its tests

Part 3: Basic Attributes

Attributes Are Huge

Quick Review

package Shirt;
use Moose;

has 'color'     => ( is => 'ro' );
has 'is_ripped' => ( is => 'rw' );

Read-only vs Read-write

Required-ness

Required-ness

package Person;
use Moose;

has first_name => (
    is       => 'ro',
    required => 1,
);

Person->new( first_name => undef ); # ok
Person->new(); # kaboom

Default and Builder

Default

package Person;
use Moose;

has bank => (
    is      => 'rw',
    default => 'Spire FCU',
);

Default

package Person;
use Moose;

has bank => (
    is      => 'rw',
    default =>
        sub { Bank->new(
                  name => 'Spire FCU' ) },
);

Subroutine Reference Default

Why No Other Reference Types?

package Person;
use Moose;

has bank => (
    is      => 'rw',
    # THIS WILL NOT WORK
    default => Bank->new(
                   name => 'Spire FCU' ),
);

Defaulting to an Empty Reference

package Person;
use Moose;

has packages => (
    is      => 'rw',
    default => sub { [] },
);

Builder

Builder

package Person;
use Moose;

has bank => (
    is      => 'rw',
    builder => '_build_bank',
);

sub _build_bank {
    my $self = shift;
    return Bank->new(
        name => 'Spire FCU' );
}

Default vs Builder

Builder Bonuses

Role Requires Builder

package HasBank;
use Moose::Role;

requires '_build_bank';

has bank => (
    is      => 'ro',
    builder => '_build_bank',
);

Lazy, Good for Nothin' Attributes

The Power of Dynamic Defaults

package Person;
use Moose;

has shoe_size => (
    is       => 'ro',
    required => 1,
);

The Power of Dynamic Defaults

has shoes => (
    is      => 'ro',
    lazy    => 1,
    builder => '_build_shoes',
);

sub _build_shoes {
    my $self = shift;

    return Shoes->new(
        size => $self->shoe_size );
}

Lazy is Good

Clearer and Predicate

Clearer and Predicate

package Person;
use Moose;

has account => (
    is        => 'ro',
    lazy      => 1,
    builder   => '_build_account',
    clearer   => '_clear_account',
    predicate => 'has_account',
);

Clearer and Lazy Defaults

Renaming constructor arguments

Some init_arg examples

package Person;
use Moose;

has shoe_size => (
    is       => 'ro',
    init_arg => 'foot_size',
);

Person->new( shoe_size => 13 );

my $person =
    Person->new( foot_size => 13 );
print $person->shoe_size;

Some init_arg examples

package Person;
use Moose;

has shoes => (
    is       => 'ro',
    init_arg => undef,
);

Person->new( shoes => Shoes->new );

Some More init_arg examples

package Person;
use Moose;

has _size => (
    is       => 'ro',
    init_arg => 'size',
);

my $person = Person->new( size => 42 );

$person->size(); # error

Why Set init_arg => undef?

Attribute Inheritance

Attribute Inheritance Example

package Employee;
use Moose;

extends 'Person';

has '+first_name' => (
    default => 'Joe',
);

Attribute Inheritance Warning

Changing Accessor Names

package Person;
use Moose;

has first_name => (
    accessor => 'first_name',
);

Changing Accessor Names

package Person;
use Moose;

has first_name => (
    reader => 'first_name',
    writer => undef,
);

Changing Accessor Names

package Person;
use Moose;

has first_name => (
    reader => 'get_first_name',
    writer => 'set_first_name',
);

Changing Accessor Names

package Person;
use Moose;

has first_name => (
    is     => 'rw',
    writer => '_first_name',
);

ETOOMUCHTYPING

ETOOMUCHTYPING

package Person;
use Moose;
use MooseX::SemiAffordanceAccessor;

has first_name => (
    is => 'rw',
);

Basic Attributes Summary

Basic Attributes Summary

Questions?

Exercises

# cd exercises
# perl bin/prove -lv \
      t/03-basic-attributes.t

Iterate til this passes all its tests

Part 4: Method Modifiers

What is a Method Modifier

What Are Method Modifiers For?

Before and After

Uses for before

package Person;
use Moose;

before work => sub {
    my $self = shift;
    die 'I have no job!'
        unless $self->has_title;
};

Uses for before

package Person;
use Moose;

before work => sub {
    my $self = shift;
    return unless $DEBUG;

    warn "Called work on ",
         $self->full_name,
         "with the arguments: [@_]\n";
};

Uses for after

package Person;
use Moose;

after work => sub {
    my $self = shift;
    $self->work_count(
        $self->work_count + 1 );
};

Other Uses

More Modifier Examples

has password => (
     is      => 'rw',
     clearer => 'clear_password',
);
has hashed_password => (
     is      => 'ro',
     builder => '_build_hashed_password',
     clearer => '_clear_hashed_password',
);
after clear_password => sub {
    my $self = shift;
    $self->_clear_hashed_password;
};

before and after Limitations

The around Modifier

The power of around

around insert => sub {
    my $orig = shift;
    my $self = shift;

    $self->_validate_insert(@_);

    my $new_user =
        $self->$orig(
            $self->_munge_insert(@_) );

    $new_user->_assign_uri;
    return $new_user;
};

Modifier Order

Modifier Order Illustrated

before 2
 before 1
  around 2
   around 1
    wrapped method
   around 1
  around 2
 after 1
after 2

Modifiers in Roles

Modifiers in Roles

package IsUnreliable;
use Moose::Role;

requires 'run';

around run => sub {
    my $orig = shift;
    my $self = shift;

    return if rand(1) < 0.5;

    return $self->$orig(@_);
};

Method Modifiers Summary

Method Modifiers Summary

Questions?

Exercises

# cd exercises
# perl bin/prove -lv \
      t/04-method-modifiers.t

Iterate til this passes all its tests

Part 5: Types

A Type System for Perl

Components of a Moose Type

Built-in Type Hierarchy

Any
Item
    Bool
    Maybe[`a]
    Undef
    Defined
        Value
            Str
                Num
                    Int
                ClassName
                RoleName

Built-in Type Hierarchy

(Item)
    (Defined)
        (Value)
        Ref
            ScalarRef
            ArrayRef[`a]
            HashRef[`a]
            CodeRef
            RegexpRef
            GlobRef
                FileHandle
            Object

Bool

True

1

False

0
'0'
''
undef

Value (and subtypes)

ClassName and RoleName

Parameterizable Types

Maybe[`a]

Type Union

Making Your Own Types

use Moose::Util::TypeConstraints;

subtype 'PositiveInt',
    as      'Int',
    where   { $_ > 0 },
    message
        { "The value you provided ($_)"
          . " was not a positive int." };

has size => (
    is  => 'ro',
    isa => 'PositiveInt',
);

Automatic Types

Automatic Types

package Employee;
use Moose;

has manager => (
    is  => 'rw',
    isa => 'Employee',
);

has start_date => (
    is  => 'ro',
    isa => 'DateTime',
);

Subtype Shortcuts - class_type

use Moose::Util::TypeConstraints;

class_type 'DateTime';



subtype     'DateTime',
    as      'Object',
    where   { $_->isa('DateTime') },
    message { ... };

Subtype Shortcuts - role_type

use Moose::Util::TypeConstraints;

role_type 'Printable';



subtype 'Printable',
    as  'Object',
    where
        { Moose::Util::does_role(
              $_, 'Printable' ) },
    message { ... };

Subtype Shortcuts - duck_type

use Moose::Util::TypeConstraints;

duck_type Car => qw( run break_down );



subtype 'Car',
    as      'Object',
    where   { all { $_->can($_) }
              qw( run break_down ) },
    message { ... };

Subtype Shortcuts - enum

use Moose::Util::TypeConstraints;

enum Color => qw( red blue green );



my %ok = map { $_ => 1 }
             qw( red blue green );

subtype     'Color'
    as      'Str',
    where   { $ok{$_} },
    message { ... };

Anonymous Subtypes

package Person;

my $posint =
    subtype
        as 'Int',
        where { $_ > 0 };

has size => (
    is  => 'ro',
    isa => $posint,
);

Coercions

use Moose::Util::TypeConstraints;

subtype 'UCStr',
    as    'Str',
    where { ! /[a-z]/ };

Coercions

coerce 'UCStr',
    from 'Str',
    via  { uc };

has shouty_name => (
    is     => 'ro',
    isa    => 'UCStr',
    coerce => 1,
);

Coercion Examples

subtype 'My::DateTime',
    as class_type 'DateTime';

coerce 'My::DateTime',
    from 'HashRef',
    via  { DateTime->new( %{$_} ) };

coerce 'My::DateTime',
    from 'Int',
    via  { DateTime->from_epoch(
               epoch => $_ ) };

Coercion Examples

# BAD CODE - DO NOT COPY
coerce 'ArrayRef[Int]',
    from 'Int',
    via  { [ $_ ] };

Using Types with Attributes

package Person;

has height => (
    is  => 'rw',
    isa => 'Num',
);

has favorite_numbers => (
    is     => 'rw',
    isa    => 'ArrayRef[Int]',
    coerce => 1,
);

More Droppings

package Person;

use Moose;
use Moose::Util::TypeConstraints;

subtype ...;

no Moose;
no Moose::Util::TypeConstraints;

Questions So Far?

Exercises

# cd exercises
# perl bin/prove -lv t/05-types.t

Iterate til this passes all its tests

Typed Methods (Low-tech)

package Person;
use MooseX::Params::Validate qw( validated_list );

sub work {
    my $self = shift;
    my ( $tasks, $can_rest ) =
        validated_list(
            \@_,
            tasks    =>
                { isa    => 'ArrayRef[Task]',
                  coerce => 1 },
            can_rest =>
                { isa     => 'Bool',
                  default => 0 },
        );
    ...
}

Typed Methods (High-tech)

package Person;

use MooseX::Method::Signatures;

method work ( ArrayRef[Task] :$tasks,
                        Bool :$can_rest = 0 ) {
    my $self = shift;

    ...
}

Digression: The Type Registry

Danger!

Namespace Fix

Namespace Fix

use Moose::Util::TypeConstraints;
subtype 'MyApp::Type::DateTime',
    as 'DateTime';

coerce 'MyApp::Type::DateTime',
    from 'HashRef',
    via  { DateTime->new( %{$_} ) }

has creation_date => (
    is     => 'ro',
    isa    => 'MyApp::Type::DateTime',
    coerce => 1,
);

Namespace Fix

subtype 'MyApp::Type::ArrayOfInt',
    as 'ArrayRef[Int]';

coerce 'MyApp::Type::ArrayOfInt',
    from 'Int',
    via  { [ $_ ] };

Namespace Fix Pros and Cons

MooseX::Types

package MyApp::Types;

use MooseX::Types
    -declare => [ qw( ArrayOfInt ) ];
use MooseX::Types::Moose
    qw( ArrayRef Int );

subtype ArrayOfInt,
    as ArrayRef[Int];

coerce ArrayOfInt
    from Int,
    via  { [ $_ ] };

MooseX::Types

package MyApp::Account;

use MyApp::Types qw( ArrayOfInt );

has transaction_history => (
    is  => 'rw',
    isa => ArrayOfInt,
);

MooseX::Types

MooseX::Types Pros and Cons

Type::Tiny

Specio

Recommendation

Questions?

Part 6: Advanced Attributes

Weak References

Circular Reference Illustrated

my $foo = {};
my $bar = { foo => $foo };
$foo->{bar} = $bar;

Weakening Circular References

use Scalar::Util qw( weaken );

my $foo = {};
my $bar = { foo => $foo };
$foo->{bar} = $bar;
weaken $foo->{bar}

Circular References in Attributes

package Person;
use Moose;

has name   => ( is => 'ro' );
has friend => ( is => 'rw' );

my $alice = Person->new( name => 'Alice' );
my $bob   = Person->new( name => 'Bob' );
$bob->friend($alice);
$alice->friend($bob);

The Fix

package Person;
use Moose;

has name   => ( is => 'ro' );
has friend => ( is       => 'rw',
                weak_ref => 1 );

my $alice = Person->new( name => 'Alice' );
my $bob   = Person->new( name => 'Bob' );
$bob->friend($alice);
$alice->friend($bob);

Under the Hood

Triggers

Gross

after salary_level => {
    my $self = shift;
    return unless @_;
    $self->clear_salary;
};

Use a Trigger Instead

Cleaner

has salary_level => (
    is      => 'rw',
    trigger =>
        sub { $_[0]->clear_salary },
);

Trigger Arguments

Delegation

Delegation Examples

package Person;

has lungs => (
    is      => 'ro',
    isa     => 'Lungs',
    handles => [ 'inhale', 'exhale' ],
);

Delegation Explained

package Person;

has lungs => (
    is      => 'ro',
    isa     => 'Lungs',
    handles => [ 'inhale', 'exhale' ],
);

sub inhale {
    my $self = shift;
    $self->lungs()->inhale();
}

sub exhale { ... }

Why Delegation?

Moose's handles Parameter

Array Reference

Hash Reference

package Person;
use Moose;
has account => (
    is      => 'ro',
    isa     => 'BankAccount',
    handles => {
        receive_money => 'deposit',
        give_money    => 'withdraw',
    },
);

Hash Reference Detailed

    handles => {
        receive_money => 'deposit',
        give_money    => 'withdraw',
    },

Regex

package Person;
use Moose;

has name => (
    is      => 'ro',
    isa     => 'Name',
    handles => qr/.*/,
);

Role Name

package Auditor;
use Moose::Role;
sub record_change  { ... }
sub change_history { ... }

package Account;
use Moose;

has history => (
    is      => 'ro',
    does    => 'Auditor',
    handles => 'Auditor',
);

Role Name Detailed

Native Delegation

Native Delegation - Array(Ref)

Native Delegation - Array(Ref)

package Person;
use Moose;
has _favorite_numbers => (
    traits   => [ 'Array' ],
    isa      => 'ArrayRef[Int]',
    default  => sub { [] },
    init_arg => undef,
    handles  =>
      { favorite_numbers    => 'elements',
        add_favorite_number => 'push',
      },
);

Native Delegation - Array(Ref)

my $person = Person->new();

$person->add_favorite_number(7);
$person->add_favorite_number(42);

print "$_\n"
    for $person->favorite_numbers;

# 7
# 42

Native Delegation

Curried Delegation

Curried Delegation

package Person;
use Moose;
has account => (
    is      => 'ro',
    isa     => 'BankAccount',
    handles => {
        receive_100 =>
            [ 'deposit', 100 ],
        give_100    =>
            [ 'withdraw', 100 ]
    },
);

Curried Delegation

$person->receive_100;
# really is
$person->account->deposit(100);

Advanced Attributes Summary

Questions?

Exercises

# cd exercises
# perl bin/prove -lv \
      t/06-advanced-attributes.t

Iterate til this passes all its tests

CYOA

If there is time, keep going ...

Otherwise, jump to slide 262 ...

Bonus: A Brief Tour of MooseX

Notable MX Modules on CPAN

Already Mentioned Several

Moops

use Moops;
use 5.14.0; # for say

class Person using Moose {
    has greeting =>
        ( is => 'ro', isa => 'Str' );

    method speak {
        say $self->greeting;
    }
}

Moops

MooseX::StrictConstructor

MooseX::StrictConstructor

package Person;

use Moose;
use MooseX::StrictConstructor;

has name => ( is => 'ro' );

Person->new
    ( nane => 'Ringo Shiina' ); # kaboom

MooseX::Traits

MooseX::Traits

package MyApp::Thingy;
use Moose;

with 'MooseX::Traits';

my $thing =
    MyApp::Thingy->new_with_traits
        ( traits => [ 'Foo', 'Bar' ],
          size   => 42 );

MooseX::Getopt

MooseX::Getopt

package App::CLI;
use Moose;

with 'MooseX::Getopt';

has file    =>
    ( is => 'ro', required => 1 );
has filters =>
    ( is => 'ro', isa => 'ArrayRef[Str]' );

sub run { ... }

MooseX::Getopt

#!/usr/bin/perl

use App::CLI;

App::CLI->new_with_options()->run();
$ myapp-cli \
   --file foo \
   --filters compress \
   --filters sanitize

MooseX::Clone

package Person;

use Moose;
with 'MooseX::Clone';

my $person = Person->new;
my $clone  = $person->clone;

MooseX::NonMoose

MooseX::Role::Parameterized

package HasCollection;
use MooseX::Role::Parameterized;
parameter type => ( isa     => 'Str',
                    default => 'Item' );
role {
    my $p = shift;

    my $type =
        'ArrayRef[' . $p->type() . ']';
    has collection =>
        ( is  => 'ro',
          isa => $type );
};

MooseX::Role::Parameterized

package Person;

use Moose;
with HasCollection => { type => 'Int' };

Questions?

Moose-using Modules

For further reading, a few modules which use Moose ...

More Information

The End