Intro to Moose

A Postmodern Object System for Perl 5

Shawn M Moore — sartak

Best Practical Solutions

What is Moose?

What is Moose?

OO

What is Moose?

Declarative

What is Moose?

Extensible

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

5 lines 21 lines
92 characters 741 characters
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?

$self->{surnane} = $args{surname};

Typo?

$self->{surnane}

What's it like with Moose again?

package Person;
use Moose;

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

Attribute Options

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

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

11 lines 31 lines
198 characters 1261 characters
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

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

What is a Role?

Defining a Role

use Moose::Role;

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

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

Uses of Roles

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::Declare MooseX::App::Cmd
MooseX::AttributeHelpers MooseX::ClassAttribute
Moose::Autobox MooseX::Emulate::Class::Accessor::Fast
MooseX::Types MooseX::Traits
MooseX::StrictConstructor MooseX::Object::Pluggable
MooseX::Role::Parameterized MooseX::Singleton

MooseX

MooseX::Declare MooseX::App::Cmd
MooseX::AttributeHelpers MooseX::ClassAttribute
Moose::Autobox MooseX::Emulate::Class::Accessor::Fast
MooseX::Types MooseX::Traits
MooseX::StrictConstructor MooseX::Object::Pluggable
MooseX::Role::Parameterized MooseX::Singleton

MooseX

MooseX::Declare MooseX::App::Cmd
MooseX::AttributeHelpers MooseX::ClassAttribute
Moose::Autobox MooseX::Emulate::Class::Accessor::Fast
MooseX::Types MooseX::Traits
MooseX::StrictConstructor MooseX::Object::Pluggable
MooseX::Role::Parameterized MooseX::Singleton

MooseX

MooseX::Declare MooseX::App::Cmd
MooseX::AttributeHelpers MooseX::ClassAttribute
Moose::Autobox MooseX::Emulate::Class::Accessor::Fast
MooseX::Types MooseX::Traits
MooseX::StrictConstructor MooseX::Object::Pluggable
MooseX::Role::Parameterized MooseX::Singleton

MooseX

MooseX::Declare MooseX::App::Cmd
MooseX::AttributeHelpers MooseX::ClassAttribute
Moose::Autobox MooseX::Emulate::Class::Accessor::Fast
MooseX::Types MooseX::Traits
MooseX::StrictConstructor MooseX::Object::Pluggable
MooseX::Role::Parameterized MooseX::Singleton

MooseX

MooseX::Declare MooseX::App::Cmd
MooseX::AttributeHelpers MooseX::ClassAttribute
Moose::Autobox MooseX::Emulate::Class::Accessor::Fast
MooseX::Types MooseX::Traits
MooseX::StrictConstructor MooseX::Object::Pluggable
MooseX::Role::Parameterized MooseX::Singleton

MooseX

MooseX::Declare MooseX::App::Cmd
MooseX::AttributeHelpers MooseX::ClassAttribute
Moose::Autobox MooseX::Emulate::Class::Accessor::Fast
MooseX::Types MooseX::Traits
MooseX::StrictConstructor MooseX::Object::Pluggable
MooseX::Role::Parameterized MooseX::Singleton

MooseX

MooseX::Declare MooseX::App::Cmd
MooseX::AttributeHelpers MooseX::ClassAttribute
Moose::Autobox MooseX::Emulate::Class::Accessor::Fast
MooseX::Types MooseX::Traits
MooseX::StrictConstructor MooseX::Object::Pluggable
MooseX::Role::Parameterized MooseX::Singleton

MooseX

MooseX::Declare MooseX::App::Cmd
MooseX::AttributeHelpers MooseX::ClassAttribute
Moose::Autobox MooseX::Emulate::Class::Accessor::Fast
MooseX::Types MooseX::Traits
MooseX::StrictConstructor MooseX::Object::Pluggable
MooseX::Role::Parameterized MooseX::Singleton

MooseX

MooseX::Declare MooseX::App::Cmd
MooseX::AttributeHelpers MooseX::ClassAttribute
Moose::Autobox MooseX::Emulate::Class::Accessor::Fast
MooseX::Types MooseX::Traits
MooseX::StrictConstructor MooseX::Object::Pluggable
MooseX::Role::Parameterized MooseX::Singleton

MooseX

MooseX::Declare MooseX::App::Cmd
MooseX::AttributeHelpers MooseX::ClassAttribute
Moose::Autobox MooseX::Emulate::Class::Accessor::Fast
MooseX::Types MooseX::Traits
MooseX::StrictConstructor MooseX::Object::Pluggable
MooseX::Role::Parameterized MooseX::Singleton

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