Intro to Moose

A Postmodern Object System for Perl 5

Shawn M Moore — @sartak

Infinity Interactive, Inc.

What is Moose?

What is Moose?

Object-oriented programming

What is Moose?

Declarative

What is Moose?

Extensible

What is Moose?

Rampant

What's it like?

package Person;
use Moose;

has surname



    

What's it like?

package Person;
use Moose;

has surname => (


);
    

What's it like?

package Person;
use Moose;

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

What's it like without Moose?

package Person;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';

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

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

    return bless $self, $class;
}

sub surname {
    my $self = shift;

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

    return $self->{surname};
}
    

Side by side

package Person;
use Moose;

has surname => (
    is  => 'rw',
    isa => 'Str',
);
                
package Person;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';

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

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

    return bless $self, $class;
}

sub surname {
    my $self = shift;

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

    return $self->{surname};
}
                

Side by side

package Person;
use Moose;

has surname => (
    is  => 'rw',
    isa => 'Str',
);
                
package Person;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';

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

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

    return bless $self, $class;
}

sub surname {
    my $self = shift;

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

    return $self->{surname};
}
                

Side by side

package Person;
use Moose;

has surname => (
    is  => 'rw',
    isa => 'Str',
);
                
package Person;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';

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

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

    return bless $self, $class;
}

sub surname {
    my $self = shift;

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

    return $self->{surname};
}
                

Side by side

package Person;
use Moose;

has surname => (
    is  => 'rw',
    isa => 'Str',
);
                
package Person;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';

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

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

    return bless $self, $class;
}

sub surname {
    my $self = shift;

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

    return $self->{surname};
}
                

Side by side

package Person;
use Moose;

has surname => (
    is  => 'rw',
    isa => 'Str',
);
                
package Person;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';

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

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

    return bless $self, $class;
}

sub surname {
    my $self = shift;

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

    return $self->{surname};
}
                

Side by side

package Person;
use Moose;

has surname => (
    is  => 'rw',
    isa => 'Str',
);
                
package Person;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';

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

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

    return bless $self, $class;
}

sub surname {
    my $self = shift;

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

    return $self->{surname};
}
                

Side by side

5 lines 22 lines (4.4x)
92 characters 769 characters (8.4x)
package Person;
use Moose;

has surname => (
    is  => 'rw',
    isa => 'Str',
);
                
package Person;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';

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

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

    return bless $self, $class;
}

sub surname {
    my $self = shift;

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

    return $self->{surname};
}
                

Pure Perl OOP

 
"Moose is at the heart of the new revolution"
– Ricardo Signes (current maintainer of Perl)
 
"Civilization advances by extending the number of important operations which we can perform without thinking about them."
– Alfred North Whitehead

Typo?

package Person;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';

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

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

    return bless $self, $class;
}

sub surname {
    my $self = shift;

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

    return $self->{surname};
}
sub new {
    my $class = shift;
    my %args  = @_;
    my $self  = {};

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

    return bless $self, $class;
}
    

What's it like with Moose again?

package Person;
use Moose;

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

Attributes

Attribute Options

Default and Lazy

package My::Object;
use Moose;

has logger => (
    is      => 'ro',
    default => sub {
        # read log config
        # open log files
        # create logger object
    },
    lazy    => 1,
);
    

Attribute Options

Delegation

package Birth::Certificate;
use Moose;
use DateTime;

has _timestamp => (
    is       => 'ro',
    isa      => 'DateTime',
    handles  => {


    },
);
    

Delegation

package Birth::Certificate;
use Moose;
use DateTime;

has _timestamp => (
    is       => 'ro',
    isa      => 'DateTime',
    handles  => {
        time => 'hms',
        date => 'ymd',
    },
);
    

Delegation

$birth_certificate->_timestamp->ymd
    

Delegation

$birth_certificate->_timestamp->ymd
$birth_certificate->year

$birth_certificate->_timestamp->hms
    

Delegation

$birth_certificate->_timestamp->ymd
$birth_certificate->year

$birth_certificate->_timestamp->hms
$birth_certificate->time
    

Delegation

package Birth::Certificate;
use Moose;
use DateTimeX::Lite;

has _timestamp => (
    is       => 'ro',
    isa      => 'DateTimeX::Lite',
    handles  => {
        time => 'hms',
        date => 'ymd',
    },
);
    

Native Delegation

Native Delegation

package My::Queue;
use Moose;

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

Native Delegation

my $queue = My::Queue->new;

# enqueue
push @{ $queue->elements }, 'foo';

# dequeue
my $next = shift @{ $queue->elements };

# jump queue!
unshift @{ $queue->elements }, 'cheater';

# ?!?!
$queue->elements([ reverse @{ $queue->elements } ]);

Native Delegation

has elements => (
    traits   => ['Array'],
    is       => 'bare',
    isa      => 'ArrayRef',
    default  => sub { [] },
    handles  => {
        enqueue => 'push',
        dequeue => 'shift',
        peek    => 'first',
    },
);
    

Native Delegation

my $queue = My::Queue->new;

# enqueue
$queue->enqueue('foo');

# dequeue
my $next = $queue->dequeue;

# now unsupported
unshift @{ $queue->elements }, 'cheater';

# now unsupported
$queue->elements([ reverse @{ $queue->elements } ]);
    

Native Delegation

Attribute Options

Builder, Clearer, Predicate

has feed_cache => (
    is         => 'ro',
    isa        => 'ArrayRef[Str]',
    lazy       => 1,
    builder    => '_build_feed_cache',
    clearer    => 'clear_feed_cache',
    predicate  => 'has_feed_cache',
);
    

Rare Attribute Options

Method modifiers

Method modifiers

Before

before output => sub {
    print localtime . ": ";
};

After

after visit_page => sub {
    my ($self, $page) = @_;
    $self->clear_cache_for_page($page);
};

Around

around query => sub {









};
    

Around

around query => sub {
    my $orig = shift;








};
    

Around

around query => sub {
    my $orig = shift;


    my @results = $orig->(@_);




    return @results;
};
    

Around

around query => sub {
    my $orig = shift;

    my $begin = time;
    my @results = $orig->(@_);
    my $end = time;

    warn "Took " . ($begin - $end) . " seconds";

    return @results;
};
    

Override and Super

sub method {
    my $self = shift;
    $self->SUPER::method(@_);
}

override method => sub {
    my $self = shift;
    super;
};
        

Roles

Roles

What is a Role?

Defining a Role

package Role::Matcher;
use Moose::Role;

has rules => (
    is => 'ro',
);

sub match {
    my $self = shift;
    for my $rule ($self->rules) {
        ...
    }
}
    

Consuming a Role

package Class::WithMatching;
use Moose;
extends 'Class';
with 'Role::Matcher';

...

$self->rules;
$self->match(...);

Uses of Roles

Uses of Roles: Tagging

package Role::BinarySafe;
use Moose::Role;

package Backend::Hash;
use Moose;
with 'Role::BinarySafe';

package Backend::JSON;
use Moose;
with 'Role::BinarySafe';
    

Uses of Roles: Tagging

if ($backend->does('Role::BinarySafe')) {
    $backend->store($blob);
}
else {
    $backend->store(base64_encode($blob));
}

Uses of Roles: Interface

package Role::Transactional;
use Moose::Role;

requires 'begin',
         'commit',
         'rollback';
    

Uses of Roles: Interface

package Backend::BDB;
use Moose;
with 'Role::Transactional';

sub begin    { shift->bdb->begin    }
sub commit   { shift->bdb->commit   }
sub rollback { shift->bdb->rollback }
    

Uses of Roles: Interface

if ($backend->does('Role::Transactional')) {
    $backend->begin;
    $worker->do_stuff_using($backend);
    $backend->commit;
}
else {
    $worker->do_stuff_using($backend);
}

Uses of Roles: Interface

my $creature = get_creature;

if ($creature->can('bark')) {
    $creature->bark(at => $postman);
}
    

Uses of Roles: Interface

my $creature = get_creature;

if ($creature->can('bark')) {
    $creature->bark(at => $postman);
}
    

Uses of Roles: Interface

package Role::Doglike;
use Moose::Role;

requires 'bark';
    

Uses of Roles: Interface

package Role::Treelike;
use Moose::Role;

requires 'bark';
    

Uses of Roles: Interface

$creature = get_creature;

if ($creature->does('Role::Doglike')) {
    $creature->bark(at => $postman);
}
    

Uses of Roles: Sharing Behavior

package My::Web::Controller;
with 'My::Role::Xslate';

$self->render(
    template  => $view,
    variables => \%query_params,
);
    

Uses of Roles: Sharing Behavior

package My::Email::Sender;
with 'My::Role::Xslate';

$self->render(
    template  => $email,
    variables => \%args,
);
    

MooseX

MooseX

MooseX::StrictConstructor

package My::Logger;
use Moose;

has out_file => (
    is      => 'ro',
    isa     => 'Str',
    default => '-',
);

MooseX::StrictConstructor

My::Logger->new(out_fiel => "~/$$.log");

MooseX::StrictConstructor

package My::Logger;
use Moose;
use MooseX::StrictConstructor;

has out_file => (
    is      => 'ro',
    isa     => 'Str',
    default => '-',
);

MooseX::StrictConstructor

My::Logger->new(out_fiel => "~/$$.log");

Found unknown attribute(s) init_arg
  passed to the constructor: out_fiel

Summary

Summary

More info

Thank you!

http://sartak.org/moose.zip

http://sartak.org/moose.tar