Intro to Moose

A Postmodern Object System for Perl 5

Shawn M Moore — sartak

Best Practical Solutions

What is Moose?

• OO
• Declarative
• Extensible

What is Moose?

OO

• Classes
• Methods
• Attributes
• Roles

What is Moose?

Declarative

• extends 'Class::Name';
• sub method_name { ... }
• has 'attribute_name' => ( ... );
• with 'Role::Name';

What is Moose?

Extensible

• ~81 MooseX dists
• "Meta Object Protocol"
• Extend Moose with Moose(?!)

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

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

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

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

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

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

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

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

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

Typo?

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

Typo?

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

Typo?

Typo?

What's it like with Moose again?

package Person;
use Moose;

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

Attribute Options

• Type (isa)
• Required
• Default
• Lazy

Default and Lazy

package Application;
use Moose;

has logger => (
    is      => 'ro',
    default => sub {
        # create logger
    },
    lazy    => 1,
);
    

Default and Lazy

package Application;
use Moose;

has logger => (
    is      => 'ro',
    default => sub {
        # create logger
    },
    lazy    => 1,
);
    

Without Moose?

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

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

    $self->{logger} = $args{logger}
        if exists $args{logger};

    return bless $self, $class;
}

sub logger {
    my $self = shift;

    confess "Cannot assign a value to a read-only accessor" if @_;

    if (!exists $self->{logger}) {
        # create logger
    }

    return $self->{logger};
}
    

Attribute Options

• Weak (weak_ref)
• Dereference (auto_deref)
• Delegation (handles)

Delegation

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

has timestamp => (
    is       => 'rw',
    isa      => 'DateTime',
    handles  => {


    },
);
    

Delegation

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

has timestamp => (
    is       => 'rw',
    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
    

Side by side

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

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

package Birth::Certificate;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;

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

    if (exists $args{timestamp}) {
        blessed($args{timestamp}) && $args{timestamp}->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $args{timestamp}";

        $self->{timestamp} = $args{timestamp};
    }

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    if (@_) {
        my $dt = shift;
        blessed($dt) && $dt->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";
        $self->{timestamp} = $dt;
    }

    return $self->{timestamp};
}

sub time {
    my $self = shift;

    confess "Cannot delegate time to hms because the value of time is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->hms(@_);
}

sub date {
    my $self = shift;

    confess "Cannot delegate date to ymd because the value of date is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->ymd(@_);
}
                

Side by side

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

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

package Birth::Certificate;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;

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

    if (exists $args{timestamp}) {
        blessed($args{timestamp}) && $args{timestamp}->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $args{timestamp}";

        $self->{timestamp} = $args{timestamp};
    }

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    if (@_) {
        my $dt = shift;
        blessed($dt) && $dt->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";
        $self->{timestamp} = $dt;
    }

    return $self->{timestamp};
}

sub time {
    my $self = shift;

    confess "Cannot delegate time to hms because the value of time is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->hms(@_);
}

sub date {
    my $self = shift;

    confess "Cannot delegate date to ymd because the value of date is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->ymd(@_);
}
                

Side by side

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

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

package Birth::Certificate;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;

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

    if (exists $args{timestamp}) {
        blessed($args{timestamp}) && $args{timestamp}->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $args{timestamp}";

        $self->{timestamp} = $args{timestamp};
    }

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    if (@_) {
        my $dt = shift;
        blessed($dt) && $dt->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";
        $self->{timestamp} = $dt;
    }

    return $self->{timestamp};
}

sub time {
    my $self = shift;

    confess "Cannot delegate time to hms because the value of time is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->hms(@_);
}

sub date {
    my $self = shift;

    confess "Cannot delegate date to ymd because the value of date is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->ymd(@_);
}
                

Side by side

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

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

package Birth::Certificate;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;

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

    if (exists $args{timestamp}) {
        blessed($args{timestamp}) && $args{timestamp}->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $args{timestamp}";

        $self->{timestamp} = $args{timestamp};
    }

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    if (@_) {
        my $dt = shift;
        blessed($dt) && $dt->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";
        $self->{timestamp} = $dt;
    }

    return $self->{timestamp};
}

sub time {
    my $self = shift;

    confess "Cannot delegate time to hms because the value of time is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->hms(@_);
}

sub date {
    my $self = shift;

    confess "Cannot delegate date to ymd because the value of date is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->ymd(@_);
}
                

Side by side

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

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

package Birth::Certificate;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;

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

    if (exists $args{timestamp}) {
        blessed($args{timestamp}) && $args{timestamp}->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $args{timestamp}";

        $self->{timestamp} = $args{timestamp};
    }

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    if (@_) {
        my $dt = shift;
        blessed($dt) && $dt->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";
        $self->{timestamp} = $dt;
    }

    return $self->{timestamp};
}

sub time {
    my $self = shift;

    confess "Cannot delegate time to hms because the value of time is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->hms(@_);
}

sub date {
    my $self = shift;

    confess "Cannot delegate date to ymd because the value of date is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->ymd(@_);
}
                

Side by side

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

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

package Birth::Certificate;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;

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

    if (exists $args{timestamp}) {
        blessed($args{timestamp}) && $args{timestamp}->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $args{timestamp}";

        $self->{timestamp} = $args{timestamp};
    }

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    if (@_) {
        my $dt = shift;
        blessed($dt) && $dt->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";
        $self->{timestamp} = $dt;
    }

    return $self->{timestamp};
}

sub time {
    my $self = shift;

    confess "Cannot delegate time to hms because the value of time is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->hms(@_);
}

sub date {
    my $self = shift;

    confess "Cannot delegate date to ymd because the value of date is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->ymd(@_);
}
                

Side by side

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

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

package Birth::Certificate;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;

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

    if (exists $args{timestamp}) {
        blessed($args{timestamp}) && $args{timestamp}->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $args{timestamp}";

        $self->{timestamp} = $args{timestamp};
    }

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    if (@_) {
        my $dt = shift;
        blessed($dt) && $dt->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";
        $self->{timestamp} = $dt;
    }

    return $self->{timestamp};
}

sub time {
    my $self = shift;

    confess "Cannot delegate time to hms because the value of time is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->hms(@_);
}

sub date {
    my $self = shift;

    confess "Cannot delegate date to ymd because the value of date is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->ymd(@_);
}
                

Side by side

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

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

package Birth::Certificate;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;

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

    if (exists $args{timestamp}) {
        blessed($args{timestamp}) && $args{timestamp}->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $args{timestamp}";

        $self->{timestamp} = $args{timestamp};
    }

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    if (@_) {
        my $dt = shift;
        blessed($dt) && $dt->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";
        $self->{timestamp} = $dt;
    }

    return $self->{timestamp};
}

sub time {
    my $self = shift;

    confess "Cannot delegate time to hms because the value of time is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->hms(@_);
}

sub date {
    my $self = shift;

    confess "Cannot delegate date to ymd because the value of date is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->ymd(@_);
}
                

Side by side

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

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

package Birth::Certificate;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;

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

    if (exists $args{timestamp}) {
        blessed($args{timestamp}) && $args{timestamp}->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $args{timestamp}";

        $self->{timestamp} = $args{timestamp};
    }

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    if (@_) {
        my $dt = shift;
        blessed($dt) && $dt->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";
        $self->{timestamp} = $dt;
    }

    return $self->{timestamp};
}

sub time {
    my $self = shift;

    confess "Cannot delegate time to hms because the value of time is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->hms(@_);
}

sub date {
    my $self = shift;

    confess "Cannot delegate date to ymd because the value of date is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->ymd(@_);
}
                

Side by side

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

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

package Birth::Certificate;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;

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

    if (exists $args{timestamp}) {
        blessed($args{timestamp}) && $args{timestamp}->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $args{timestamp}";

        $self->{timestamp} = $args{timestamp};
    }

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    if (@_) {
        my $dt = shift;
        blessed($dt) && $dt->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";
        $self->{timestamp} = $dt;
    }

    return $self->{timestamp};
}

sub time {
    my $self = shift;

    confess "Cannot delegate time to hms because the value of time is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->hms(@_);
}

sub date {
    my $self = shift;

    confess "Cannot delegate date to ymd because the value of date is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->ymd(@_);
}
                

Side by side

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

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

package Birth::Certificate;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;

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

    if (exists $args{timestamp}) {
        blessed($args{timestamp}) && $args{timestamp}->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $args{timestamp}";

        $self->{timestamp} = $args{timestamp};
    }

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    if (@_) {
        my $dt = shift;
        blessed($dt) && $dt->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";
        $self->{timestamp} = $dt;
    }

    return $self->{timestamp};
}

sub time {
    my $self = shift;

    confess "Cannot delegate time to hms because the value of time is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->hms(@_);
}

sub date {
    my $self = shift;

    confess "Cannot delegate date to ymd because the value of date is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->ymd(@_);
}
                

Unsweetened Delegation — Refactorable?

package Birth::Certificate;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;











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

    if (exists $args{timestamp}) {
        blessed($args{timestamp}) && $args{timestamp}->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $args{timestamp}";

        $self->{timestamp} = $args{timestamp};
    }

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    if (@_) {
        my $dt = shift;
        blessed($dt) && $dt->isa('DateTime')
            or confess "Attribute (timestamp) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";
        $self->{timestamp} = $dt;
    }

    return $self->{timestamp};
}

sub time {
    my $self = shift;

    confess "Cannot delegate time to hms because the value of time is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->hms(@_);
}

sub date {
    my $self = shift;

    confess "Cannot delegate date to ymd because the value of date is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->ymd(@_);
}
    

Unsweetened Delegation — Refactoring

package Birth::Certificate;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;

sub _valid_datetime {
    my $name = shift;
    my $dt   = shift;

    blessed($dt) && $dt->isa('DateTime')
        or confess "Attribute ($name) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";

    return $dt;
}

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

    if (exists $args{timestamp}) {



        $self->{timestamp} = _valid_datetime(timestamp => $args{timestamp});
    }

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    if (@_) {



        $self->{timestamp} = _valid_datetime(timestamp => shift);
    }

    return $self->{timestamp};
}

sub time {
    my $self = shift;

    confess "Cannot delegate time to hms because the value of time is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->hms(@_);
}

sub date {
    my $self = shift;

    confess "Cannot delegate date to ymd because the value of date is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->ymd(@_);
}
    

Unsweetened Delegation — Refactoring

package Birth::Certificate;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;

sub _valid_datetime {
    my $name = shift;
    my $dt   = shift;

    blessed($dt) && $dt->isa('DateTime')
        or confess "Attribute ($name) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";

    return $dt;
}

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

    $self->{timestamp} = _valid_datetime(timestamp => $args{timestamp});
        if exists $args{timestamp};

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    $self->{timestamp} = _valid_datetime(timestamp => shift);
        if @_;

    return $self->{timestamp};
}

sub time {
    my $self = shift;

    confess "Cannot delegate time to hms because the value of time is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->hms(@_);
}

sub date {
    my $self = shift;

    confess "Cannot delegate date to ymd because the value of date is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->ymd(@_);
}
    

Unsweetened Delegation — Refactoring

package Birth::Certificate;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;

sub _valid_datetime {
    my $name = shift;
    my $dt   = shift;

    blessed($dt) && $dt->isa('DateTime')
        or confess "Attribute ($name) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";

    return $dt;
}

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

    $self->{timestamp} = _valid_datetime(timestamp => $args{timestamp});
        if exists $args{timestamp};

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    $self->{timestamp} = _valid_datetime(timestamp => shift);
        if @_;

    return $self->{timestamp};
}

sub time {
    my $self = shift;

    confess "Cannot delegate time to hms because the value of time is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->hms(@_);
}

sub date {
    my $self = shift;

    confess "Cannot delegate date to ymd because the value of date is not defined" if !exists($self->{timestamp});

    return $self->{timestamp}->ymd(@_);
}
    

Unsweetened Delegation — Refactoring

package Birth::Certificate;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;

sub _valid_datetime {
    my $name = shift;
    my $dt   = shift;

    blessed($dt) && $dt->isa('DateTime')
        or confess "Attribute ($name) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";

    return $dt;
}

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

    $self->{timestamp} = _valid_datetime(timestamp => $args{timestamp});
        if exists $args{timestamp};

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    $self->{timestamp} = _valid_datetime(timestamp => shift);
        if @_;

    return $self->{timestamp};
}

sub _delegate {
    my ($local, $attribute, $remote) = @_;

    my $code = sub {
        my $self = shift;

        confess "Cannot delegate $local to $attribute because the value of $local is not defined" if !exists($self->{$attribute});

        $self->{$attribute}->$remote(@_);
    };

    no strict 'refs';
    *{ __PACKAGE__ . "::$local" } = $code;
}

_delegate(time => timestamp => 'hms');
_delegate(date => timestamp => 'ymd');
    

Unsweetened Delegation — Refactoring

package Birth::Certificate;
use Class::Common;
use strict;
use warnings;
use Carp 'confess';
use Scalar::Util 'blessed';
use DateTime;

sub _valid_datetime {
    my $name = shift;
    my $dt   = shift;

    blessed($dt) && $dt->isa('DateTime')
        or confess "Attribute ($name) does not pass the type constraint because: Validation failed for 'DateTime' with value $dt";

    return $dt;
}

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

    $self->{timestamp} = _valid_datetime(timestamp => $args{timestamp});
        if exists $args{timestamp};

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    $self->{timestamp} = _valid_datetime(timestamp => shift);
        if @_;

    return $self->{timestamp};
}

sub _delegate {
    my ($local, $attribute, $remote) = @_;

    my $code = sub {
        my $self = shift;

        confess "Cannot delegate $local to $attribute because the value of $local is not defined" if !exists($self->{$attribute});

        $self->{$attribute}->$remote(@_);
    };

    no strict 'refs';
    *{ __PACKAGE__ . "::$local" } = $code;
}

_delegate(time => timestamp => 'hms');
_delegate(date => timestamp => 'ymd');
    

Unsweetened Delegation — Refactoring

package Birth::Certificate;
use Class::Common;
use strict;
use warnings;
use DateTime;

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

    $self->{timestamp} = _valid_datetime(timestamp => $args{timestamp});
        if exists $args{timestamp};

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    $self->{timestamp} = _valid_datetime(timestamp => shift);
        if @_;

    return $self->{timestamp};
}

_delegate(time => timestamp => 'hms');
_delegate(date => timestamp => 'ymd');
    

Unsweetened Delegation — Refactoring

package Birth::Certificate;
use Class::Common;
use strict;
use warnings;
use DateTime;

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

    $self->{timestamp} = _valid_datetime(timestamp => $args{timestamp});
        if exists $args{timestamp};

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    $self->{timestamp} = _valid_datetime(timestamp => shift);
        if @_;

    return $self->{timestamp};
}

_delegate(time => timestamp => 'hms');
_delegate(date => timestamp => 'ymd');
    

Unsweetened Delegation — Refactoring

package Birth::Certificate;
use Class::Common;
use strict;
use warnings;

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

    $self->{timestamp} = _valid_datetime(timestamp => $args{timestamp});
        if exists $args{timestamp};

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    $self->{timestamp} = _valid_datetime(timestamp => shift);
        if @_;

    return $self->{timestamp};
}

_delegate(time => timestamp => 'hms');
_delegate(date => timestamp => 'ymd');
    

Unsweetened Delegation — Refactoring

package Birth::Certificate;
use Class::Common;
use strict;
use warnings;

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

    $self->{timestamp} = _valid_datetime(timestamp => $args{timestamp});
        if exists $args{timestamp};

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    $self->{timestamp} = _valid_datetime(timestamp => shift);
        if @_;

    return $self->{timestamp};
}

_delegate(time => timestamp => 'hms');
_delegate(date => timestamp => 'ymd');
    

Unsweetened Delegation — Refactoring

package Birth::Certificate;
use Class::Common;

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

    $self->{timestamp} = _valid_datetime(timestamp => $args{timestamp});
        if exists $args{timestamp};

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    $self->{timestamp} = _valid_datetime(timestamp => shift);
        if @_;

    return $self->{timestamp};
}

_delegate(time => timestamp => 'hms');
_delegate(date => timestamp => 'ymd');
    

Unsweetened Delegation — Refactoring

package Birth::Certificate;
use Class::Common;

attribute 'timestamp';

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

    $self->{timestamp} = _valid_datetime(timestamp => $args{timestamp});
        if exists $args{timestamp};

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    $self->{timestamp} = _valid_datetime(timestamp => shift);
        if @_;

    return $self->{timestamp};
}

_delegate(time => timestamp => 'hms');
_delegate(date => timestamp => 'ymd');
    

Unsweetened Delegation — Refactoring

package Birth::Certificate;
use Class::Common;

attribute 'timestamp' => \&valid_datetime;

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

    $self->{timestamp} = _valid_datetime(timestamp => $args{timestamp});
        if exists $args{timestamp};

    return bless $self, $class;
}

sub timestamp {
    my $self = shift;

    $self->{timestamp} = _valid_datetime(timestamp => shift);
        if @_;

    return $self->{timestamp};
}

_delegate(time => timestamp => 'hms');
_delegate(date => timestamp => 'ymd');
    

Unsweetened Delegation — Refactoring

package Birth::Certificate;
use Class::Common;

attribute 'timestamp' => \&valid_datetime;

_delegate(time => timestamp => 'hms');
_delegate(date => timestamp => 'ymd');
    

Unsweetened Delegation — Refactoring

package Birth::Certificate;
use Class::Common;

attribute 'timestamp' => (
    validator => \&valid_datetime,
    delegate  => {
        time => 'hms',
        date => 'ymd',
    },
);

_delegate(time => timestamp => 'hms');
_delegate(date => timestamp => 'ymd');
    

Unsweetened Delegation — Refactoring

package Birth::Certificate;
use Class::Common;

attribute 'timestamp' => (
    validator => \&valid_datetime,
    delegate  => {
        time => 'hms',
        date => 'ymd',
    },
);
    

Unsweetened Delegation — Refactoring

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

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

Attribute Options

• Builder
• Clearer
• Predicate

Builder, Clearer, Predicate

has feed_cache => (
    is         => 'ro',
    isa        => 'ArrayRef[Str]',
    lazy       => 1,



);
    

Builder, Clearer, Predicate

has feed_cache => (
    is         => 'ro',
    isa        => 'ArrayRef[Str]',
    lazy       => 1,



);
    

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

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

Lazy build

has feed_cache => (
    is         => 'ro',
    isa        => 'ArrayRef[Str]',
    lazy_build => 1,
    clearer    => 'invalidate_cache',


);
    

Questions?

Answers?

Method modifiers

• before
• after
• around
• override and super
• augment and inner

Before and after

package My::Game::Tile;
use Moose;

before clear_monster => sub {


};
    

Before and after

package My::Game::Tile;
use Moose;

before clear_monster => sub {
    my $self = shift;
    $self->level->remove_monster($self->monster);
};

after set_monster => sub {


};
    

Before and after

package My::Game::Tile;
use Moose;

before clear_monster => sub {
    my $self = shift;
    $self->level->remove_monster($self->monster);
};

after set_monster => sub {
    my $self = shift;
    $self->level->add_monster($self->monster);
};
    

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

Augment and Inner

package Employee;
use Moose;

sub do_work {
    my $self = shift;
    $self->punch_in;
    ???
    $self->punch_out;
}
    

Augment and Inner

package Employee;
use Moose;

sub do_work {
    my $self = shift;
    $self->punch_in;
    ???
    $self->punch_out;
}
    

Augment and Inner

package Employee;
use Moose;

sub do_work {
    my $self = shift;
    $self->punch_in;
    inner;
    $self->punch_out;
}
    

Augment and Inner

package Employee::Chef;
use Moose;
extends 'Employee';

augment do_work => {





};
    

Augment and Inner

package Employee::Chef;
use Moose;
extends 'Employee';

augment do_work => {
    my $self = shift;

    for my $burger ($self->burgers) {
        $self->flip($burger);
    }
};
    

Questions?

Answers?

Roles

• Java Interfaces on crack
• Ruby Mixins on crack
• Smalltalk Traits on crack

What is a Role?

• Collection of:
  • Attributes
  • Methods (and modifiers)
  • Required methods
• That's it!

Defining a Role

use Moose::Role;

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

sub match {
    my $self = shift;
    ...
}
    

Uses of Roles

• Tagging
• Provide interface
• Share behavior

Uses of Roles: Tagging

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


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

Uses of Roles: Interface

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

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

Uses of Roles: Interface

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

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

Uses of Roles: Interface

my $creature = get_creature;

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

Uses of Roles: Interface

my $creature = get_creature;

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

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 => $mailman);
}
    

Uses of Roles: Sharing Behavior

package My::Item;
with 'MooseX::Role::Matcher';

$item->match(name => 'Excalibur');
$item->match(is_blessed => 1);
    

Uses of Roles: Sharing Behavior

package My::Monster;
with 'MooseX::Role::Matcher';

$monster->match(name => 'Medusa');
$monster->match(lays_eggs => 1);
    

Questions?

Answers?

MooseX

MooseX

MooseX

MooseX

MooseX

MooseX

MooseX

MooseX

MooseX

MooseX

MooseX

MooseX::Declare

use MooseX::Declare;

class Inventory {







}
    

MooseX::Declare

use MooseX::Declare;

class Inventory {
    method item_list {

    }




}
    

MooseX::Declare

use MooseX::Declare;

class Inventory {
    method item_list {
        values %{ $self->items }
    }

    method add_item (Str $slot, Item $item) {

    }
}
    

MooseX::Declare

use MooseX::Declare;

class Inventory {
    method item_list {
        values %{ $self->items }
    }

    method add_item (Str $slot, Item $item) {
        $self->items->{$slot} = $item;
    }
}
    

Without MooseX::AttributeHelpers

has _players => (
    is  => 'ro',
    isa => 'HashRef[Player]',
);

sub add_player    { $_[0]->players->{$_[1]} = $_[2] }
sub player        { $_[0]->players->{$_[1]} }
sub delete_player { delete $_[0]->players->{$_[1]} }
sub has_player    { exists $_[0]->players->{$_[1]} }
sub player_names  { keys   %{ $_[0]->players } }
    

With MooseX::AttributeHelpers

has _players => (
    metaclass => 'Collection::Hash',
    is  => 'ro',
    isa => 'HashRef[Player]',
    provides => {





    },
);
    

With MooseX::AttributeHelpers

has _players => (
    metaclass => 'Collection::Hash',
    is  => 'ro',
    isa => 'HashRef[Player]',
    provides => {
        set    => 'add_player',
        get    => 'player',
        delete => 'delete_player',
        exists => 'has_player',
        keys   => 'player_names',
    },
);
    

With MooseX::AttributeHelpers

my $game = Game->new;

$game->add_player(stevan => Player->new(...))
$game->player('stevan')
$game->delete_player('stevan')
$game->has_player('stevan')
$game->player_names
    

With Moose::Autobox

use Moose::Autobox;
my $game = Game->new;

$game->players->set(stevan => Player->new(...))
$game->players->get('stevan')
$game->players->delete('stevan')
$game->players->exists('stevan')
$game->players->keys
    

Questions?

Answers?

More info

• Moose::Cookbook
• Moose::Manual (brand new!)
• Task::Moose
• The Art of the Metaobject Protocol
• #moose on irc.perl.org