Introduction to Moose

git://git.moose.perl.org/moose-presentations.git

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 => 'rw' );

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 => 'fat' );

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',
);

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(@_)
  1. Calls Person->BUILDARGS(@_) to turn @_ 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;
    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');
print $person->first_name; # Dave

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');

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

# perl install-moose (if needed)

# 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 'HasPermissions';

Classes Consume Roles

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

print $person->full_name
    . ' has '
    . $person->can_access(42)
        ? 'great power'
        : 'little power';

Roles in Practice

In Other Words ...

package Person;
use Moose;

with 'Printable';

In Other Words ...

package Person;
use Moose;

with 'Printable';

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('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

Method Aliasing

package FragileDancer;
use Moose;

with 'IsFragile' =>
         { -alias =>
               { break => 'break_bone' } },
     'CanBreakdance' =>
         { -alias =>
               { break => 'break_it_down' } };

Method Exclusion

package FragileDancer;
use Moose;

with 'IsFragile' =>
         { -alias =>
               { break => 'break_bone' },
           -excludes => 'break' },
     'CanBreakdance' =>
         { -alias =>
               { break => 'break_it_down' },
           -excludes => 'break' };

And then ...

package FragileDancer;
use Moose;

sub break {
    my $self = shift;

    $self->break_it_down;
    if ( rand(1) < 0.5 ) {
        $self->break_bone;
    }
}

Still Full of Fail

Hot Role-on-Role Action

package Comparable;
use Moose::Role;

requires 'compare';

Hot Role-on-Role Action

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!

Name Conflicts Between Roles

package HasSubProcess;
use Moose::Role;

sub execute { ... }

package Killer;
use Moose::Role;

with 'HasSubProcess';

sub execute { ... }

Delayed Conflict

package StateOfTexas;
with 'Killer';

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' );

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',
    default => Bank->new(
                   name => 'Spire FCU' ),
);

Defaulting to an Empty Reference

package Person;
use Moose;

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

What if I Want to Share?

package Person;
use Moose;

my $highlander_bank =
    Bank->new( name => 'Spire FCU' );

has bank => (
    is      => 'rw',
    default => sub { $highlander_bank },
);

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',
);

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 );

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

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 is a Method Modifier

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(@_);
};

Augment and Inner

Augment and Inner

package Document;

sub xml { '<doc>' . inner() . '</doc>' }

package Report;
extends 'Document';
augment xml =>
    sub { title() . inner() . summary() };

package TPSReport;
extends 'Report';
augment xml =>
    sub { tps_xml() . inner() };

Augment and Inner

Augment and Inner Usage

Method Modifiers Summary

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
           Num
             Int
           Str
             ClassName
             RoleName

Built-in Type Hierarchy

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

Bool

True

1
924.1
'true'
{}

False

0
0.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

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;

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

Recommendation

Questions?

Exercises

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

Iterate til this passes all its tests

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 },
);

Delegation

Delegation Examples

package Person;

has lungs => (
    is      => 'ro',
    isa     => 'Lungs',
    handles => [ 'inhale', '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

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

Native Delegation - Counter

package Stack;
use Moose;
has depth => (
    traits   => [ 'Counter' ],
    is       => 'ro',
    isa      => 'Int',
    default  => 0,
    init_arg => undef,
    handles  =>
      { _inc_depth => 'inc',
        _dec_depth => 'dec',
      },
);

Traits and Metaclasses

Traits and Metaclasses

Traits and Metaclasses

Simple Trait Example

package Person;
use Moose;
use MooseX::LabeledAttributes;

has ssn => (
    traits => [ 'Labeled' ],
    is     => 'ro',
    isa    => 'Str',
    label  => 'Social Security Number',
);
print Person->meta
            ->get_attribute('ssn')->label;

Simple Metaclass Example

package Person;
use Moose;
use MooseX::LabeledAttributes;

has ssn => (
    metaclass =>
        'MooseX::Meta::Attribute::Labeled',
    is        => 'ro',
    isa       => 'Str',
    label     => 'Social Security Number',
);
print Person->meta
            ->get_attribute('ssn')->label;

Traits vs Metaclass

Advanced Attributes Summary

Questions?

Exercises

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

Iterate til this passes all its tests

Part 7: Introspection

Part 8: A Tour of MooseX

Part 9: Writing Moose Extensions

The End

More Information