Introduction to Moose

YAPC 2009

Moose Summed Up

• Declarative OO sugar
• Introspectable
• Extensible

Moose Background

• Created by Stevan Little, first released in 2006
• Moose builds on Perl 5's native OO
• Borrows ideas from other languages, notably Perl 6
• Provides semantics for common operations

Classes

• Classes have ...
  • Attributes
  • Methods
  • Superclasses
  • Method modifiers
  • Constructor and destructor
  • One metaclass object
• Classes do roles

Class Example

package Person;
use Moose;

• Poof, a Moose-based class!

Attributes

• Aka property, slot, field, member variable
• A piece of data owned by an object

Attributes

• Attributes have ...
  • Access-control (read-only vs read-write)
  • An optional type
  • Accessor methods
  • Delegation methods
  • Optional default value
  • Many more features
• Stored in the object, but don't worry about that

Attribute Example

package Person;
use Moose;

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

Methods

• Nothing fancy here, just Perl subroutines

package Person;
use Moose;

sub greet { ... }

Roles

• Classes do (or consume) roles
• Similar to mixins and Java interfaces

Roles

• Like classes, can have attributes, methods, do roles
• Roles can require methods
• Roles are composed (flattened) into classes

Role Example

package HasPermissions;
use Moose::Role;

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

Role Example

And then ...

package Person;
use Moose;

with 'HasPermissions';

Method Modifiers

• AKA advice
• "Before foo(), do this first"
• "Do this after foo()
• "Put this code around foo()"

Before & 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

• NOT A FULL-BLOWN TYPE SYSTEM!
• But still darn useful
• Constrain attribute values
• Coerce from other types

Type Constraint Example

package Person;
use Moose;

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

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

Delegation

• Attributes can define delegations
• Lets you hide some implementation details
• Fewer objects to chase around

Delegation

package Person;
use Moose;

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

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

Constructors

• Moose creates new() for you
• Provide an optional BUILDARGS() and BUILD()

Destructors

• Provide an optional DEMOLISH()

Moose Meta-API

• Answers questions like ...
  • What methods does this class have?
  • What are its parents?
  • What attributes does it have (including inherited attributes)?
  • What roles does it do?
  • Much, much, more

Moose Meta-API

• Not just for introspection ...
  • Add methods, attributes, roles, etc
  • Extend and alter core features

Why Moose?

• A quick bit of propoganda ...

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

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?

Typo?

Why Moose?

package Person;
use Moose;

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

Moose Classes

• Moose classes are Perl packages which use Moose

Moose.pm and Your Class

package Person;
use Moose;

• Moose.pm provides declarative sugar
• Turns on strict and warnings
• Creates metaclasses for your class: Person->meta
• Moose classes automatically inherit from Moose::Object

What Moose::Object Provides

• Constructor - new()
• Calls your BUILDARGS() and/or BUILD()
• Calls your DEMOLISH during object destruction

extends

• extends is sugar for declaring parent classes

package Employee;
use Moose;
extends 'Person';

extends

• Each call to extends resets your parents

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

• No Moose::Object, so ...
  • No attribute-handling new()
  • No BUILDARGS() or BUILD()
  • No DEMOLISH()
• But see MooseX::NonMoose for a workaround

overrides and super

• overrides is another method modifier
• An alternative to Perl's SUPER::

overrides and super

package Employee;
use Moose;

extends 'Person';

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

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

Caveat super

• Mostly like $self->SUPER::work(@_)
• But cannot change @_!
• Binds the parent's method at compile time

Attributes (Part 1)

• has 'foo'
• Use is => 'ro' or is => 'rw'
• Attributes without "is" have no accessors

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

• Attributes have a lot of features

Cleaning Up Moose Droppings

package Person;
use Moose;

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

• Not very hygienic

Cleaning Up Moose Droppings

package Person;
use Moose;

...

no Moose;

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

No Moose

• no Moose at the end of a package is a best practice
• Just do it

Immutability

• Stevan's Incantation of Fleet-Footedness

package Person;
use Moose;

__PACKAGE__->meta->make_immutable;

What make_immutable does

• Magic
• Uses eval to "inline" a constructor
• Memoizes a lot of meta-information
• Makes loading your class slower
• Makes object creation much faster

When to Immutabilize?

• Almost always
• Startup time vs execution time

Classes Summary

• use Moose
• Class->meta
• Moose::Object base class
• extends, overrides, and super
• Simple attributes: has, is => 'ro', & is => 'rw'
• no Moose
• __PACKAGE__->meta->make_immutable

Exercises

$ cd exercises
$ perl bin/prove -lv t/00-prereq.t

Missing anything? Install it. (see tarballs/)

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

Iterate til this passes all its tests

Just What Is a Role?

• Mixin? Interface? Trait?
• Yes ... and more!

Roles Can Have 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

• Consuming a role =~ inlining the role

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

• Role consumption is introspectable

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

# or ...

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

These Names Are the Same

• What if a role and class define the same method?
• A class's local methods win over the role's
• The role's methods win over the class's inherited methods

Conflicts Between Roles

• Two roles with a method of the same name
• Generates a compile-time error when consumed by a class

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

• Only one with!

Conflict Resolution

• The consuming class must resolve the conflict by implementing th emethod
• Can use some combination of method exclusion and aliasing

Method Aliasing

package FragileDancer;
use Moose;

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

• Renames the roles' methods
• Still conflicts, need to exclude as well

Method Exclusion

package FragileDancer;
use Moose;

with 'IsFragile' =>
         { alias =>
               { break => 'break_bone' },
           exclude => 'break' },
     'CanBreakdance' =>
         { alias =>
               { break => 'break_dance' },
           exclude => 'break' };

And then ...

package FragileDancer;
use Moose;

sub break {
    my $self = shift;

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

Still Full of Fail

• Roles are also about semantics!
• We've fulfilled the letter and lost the spirit
• Roles have a meaning
• Think twice before blindly aliasing and excluding methods!

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

• StateOfTexas must implement its own execute
• But loading the Killer role by itself does not cause an error

Roles as Interfaces

• Roles can require methods of their consumers
• Compile-time checks
• Method must exist when the role is consumed

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

• Really, it's package load time
• That's run-time, but before the "real" run-time
• Moose does not rewire Perl, it's just sugar!
• (but MooseX::Declare does rewire Perl)

Enforcing Roles

package Comparison;
use Moose;

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

• A sneak peek at type constraints

Roles Can Be Applied to Objects

use Moose::Util qw( apply_all_roles );

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

• Does not change the Person class
• Works with non-Moose classes, great for monkey-patching!

Roles Are Dirty Too

• Once again, clean up those Moose droppings

package Comparable;
use Moose::Role;

requires 'compare';

no Moose::Role;

• But roles cannot be made immutable

The Zen of Roles

• Roles represent discrete units of ...
  • state
  • behavior
  • interface
• Roles are shareable between unrelated classes
• Roles are what a class does, not what it is
• Roles add functionality, inheritance specializes

Abstract Examples

• Human @ISA Animal
• Human does Toolmaker (as does Chimpanzee)
• Car @ISA Vehicle
• Car does HasEngine

Real Examples

• Objects representing SQL database components and queries
  • Schema, Table, Column, ColumnAlias
  • Select, Insert, Update, Delete

Real Examples

• Column and ColumnAlias both do ColumnLike
• ColumnLike things can be used in certain parts of queries
• All queries do HasWhereClause
• Select does Comparable and Selectable (for subselects)
• A where clause requires its components to do Comparable

Exercises

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

Iterate til this passes all its tests