Skip to content

Cookbook

Jump to bottom
Ovid edited this page May 16, 2020 · 42 revisions

The Cookbook

This is a short list of examples of writing Cor modules to help developers transition. We will be using Moose syntax for comparison because writing these examples in core Perl and maintaining the same functionality would be too tedious.

We generally won't show using the classes because that's unchanged (except that Cor expects a list, not a hashref).

Note that the isa($type) syntax is still up for debate.

Examples:

Point Object and Subclassing

Source and discussion.

Moose

package Point;
use Moose;

has 'x' => (isa => 'Int', is => 'rw', required => 1);
has 'y' => (isa => 'Int', is => 'rw', required => 1);

sub clear {
    my $self = shift;
    $self->x(0);
    $self->y(0);
}

package Point3D;
use Moose;

extends 'Point';

has 'z' => (isa => 'Int', is => 'rw', required => 1);

after 'clear' => sub {
    my $self = shift;
    $self->z(0);
};

Cor

class Point {
    has ( $x, $y ) :reader :writer :new :isa(Int);

    method clear () {
        ( $x, $y ) = ( 0, 0 );
    }
}

class Point3D isa Point {
    has $z :reader :writer :new :isa(Int);

    method clear () {
        $self->next::method;
        $z = 0;
    }
}

Binary Tree

Source and discussion.

Moose

package BinaryTree;
use Moose;

has 'node' => ( is => 'rw', isa => 'Any' );

has 'parent' => (
    is        => 'rw',
    isa       => 'BinaryTree',
    predicate => 'has_parent',
    weak_ref  => 1,
);

has 'left' => (
    is        => 'rw',
    isa       => 'BinaryTree',
    predicate => 'has_left',
    lazy      => 1,
    default   => sub { BinaryTree->new( parent => $_[0] ) },
    trigger   => \&_set_parent_for_child
);

has 'right' => (
    is        => 'rw',
    isa       => 'BinaryTree',
    predicate => 'has_right',
    lazy      => 1,
    default   => sub { BinaryTree->new( parent => $_[0] ) },
    trigger   => \&_set_parent_for_child
);

sub _set_parent_for_child {
    my ( $self, $child ) = @_;

    confess "You cannot insert a tree which already has a parent"
        if $child->has_parent;

    $child->parent($self);
}

Cor

This needs some work and I'm stopping on it for now. There's an open question about readers/writers.

class BinaryTree {
    has $node :reader :writer;

    has $parent           :reader :writer :predicate :weak :isa('BinaryTree');
    has ( $left, $right ) :reader :writer :predicate :weak :isa('BinaryTree')
                          :builder :new(optional);

    method _build_left ($value) {
        $self->_set_child($left, $value);
    }
    method _build_right ($value) {
        $self->_set_child($right, $value);
    }

    method _set_child($child, $value) {
        if ( $value isa 'BinaryTree' ) {
            confess "You cannot insert a tree which already has a parent"
                if $value->has_parent;
            $value->parent($self);
        }
        else {
            $value = BinaryTree->new( parent => $self );
        }
        $child = $value;
    }
}

Bank Account

Source and discussion

Moose

package BankAccount;
use Moose;

has 'balance' => ( isa => 'Int', is => 'rw', default => 0 );

sub deposit {
    my ( $self, $amount ) = @_;
    $self->balance( $self->balance + $amount );
}

sub withdraw {
    my ( $self, $amount ) = @_;
    my $current_balance = $self->balance();
    ( $current_balance >= $amount )
        || confess "Account overdrawn";
    $self->balance( $current_balance - $amount );
}

package CheckingAccount;
use Moose;

extends 'BankAccount';

has 'overdraft_account' => ( isa => 'BankAccount', is => 'rw' );

before 'withdraw' => sub {
    my ( $self, $amount ) = @_;
    my $overdraft_amount = $amount - $self->balance();
    if ( $self->overdraft_account && $overdraft_amount > 0 ) {
        $self->overdraft_account->withdraw($overdraft_amount);
        $self->deposit($overdraft_amount);
    }
};

Cor

Note: the balance is read-only. The Moose example above is a bad example.

class BankAccount {
    has $balance :reader :isa(ZeroOrPositiveInt) :new(optional) = 0;

    method deposit($amount) {
        $balance += $amount;
    }

    method withdraw($amount) {
        ($balance > $amount) || confess("Acount overdrawn");
        $balance -= $amount;
    }
}

class CheckingAccount isa BankAccount {
    has $overdraft_account :new(optional) :isa('BankAccount');

    method withdraw($amount) {
        my $overdraft_amount = $amount - $balance;
        if ( $overdraft_account && $overdraft_amount > 0 ) {
            $overdraft_account->withdraw($overdraft_amount);
            $self->deposit($overdraft_amount);
        }
        $self->next::method($amount);
    }
}

Note that the BankAccount class could be done like this:

class BankAccount {
    has $balance :reader :isa(ZeroOrPositiveInt) :new(optional) = 0;
    method deposit($amount)  { $balance += $amount }
    method withdraw($amount) { $balance -= $amount }
}

In this case, we allow the type constraint to catch our error for us. However, the error message would not be friendly. This could possibly be addressed, but not for the first version.

CONSTRUCT and ADJUST (BUILDARGS and BUILD)

This is still a work in progress.

Moose

package Person;

has 'ssn' => (
    is        => 'ro',
    isa       => 'Str',
    predicate => 'has_ssn',
);

has 'country_of_residence' => (
    is      => 'ro',
    isa     => 'Str',
    default => 'usa'
);

has 'first_name' => (
    is  => 'ro',
    isa => 'Str',
);

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

around BUILDARGS => sub {
    my $orig = shift;
    my $class = shift;

    if ( @_ == 1 && ! ref $_[0] ) {
        return $class->$orig(ssn => $_[0]);
    }
    else {
        return $class->$orig(@_);
    }
};

sub BUILD {
    my $self = shift;

    if ( $self->country_of_residence eq 'usa' ) {
        die 'Cannot create a Person who lives in the USA without an ssn.'
            unless $self->has_ssn;
    }
}

Cor

class Person {
    has $ssn                      :reader :isa(Str) :new(optional) :predicate;
    has ($first_name, $last_name) :reader :isa(Str) :new(optional);
    has $country_of_residence     :reader :isa(Str) :new(optional) = 'usa';

    # XXX Yup. This seems fragile. Need to rethink this.
    shared method CONSTRUCT (@args) {
        if ( 1 == @args ) {
            @args = (ssn => $args[0]);
        }
        return $class->NEW(@args);
    }

    # at this point the arguments are guaranteed to be a hash
    method ADJUST (%args) {
        if ( $country_of_residence eq 'usa' ) {
            die 'Cannot create a Person who lives in the USA without an ssn.'
                unless $self->has_ssn;
        }
    }
}

Inheriting from non-Cor classes

Moose

package HTML::TokeParser::Moose;
use Moose;
use MooseX::NonMoose;
extends 'HTML::TokeParser::Simple';

# more code here

For the first pass, we might not allow Cor to inherit from non-Cor classes. If I want a Cor class to inherit from HTML::TokeParser::Simple to provide a better interface, I can't, but it's easy to emulate with composition and delegation:

Cor

class HTML::TokeParser::Cor {
    use HTML::TokeParser::Simple;
    has $file   :new :isa(FileName);
    has $parser :handles(get_token, get_tag, peek) = HTML::TokeParser::Simple->new($file);

    # more code here
}

That obviously won't scale up well for classes with tons of methods that you don't want to list. We considered handles(*), with new being automatically excluded, but it's hard to know how to handle that correctly.

Attributes: No Public Reader

Moose

package Person;
use Moose;

has title => (
    is        => 'ro',
    isa       => 'Str',
    predicate => 'has_title',
);

has name => ( # No public reader
    is       => 'bare',
    isa      => 'Str',
    required => 1,
);

sub full_name ($self) {
    my $name = $self->meta
                    ->get_attribute('name')
                    ->get_value($self);
    my $title = $self->has_title ? $self->title . ' ' : '';
    return $title . $name;
}

Cor

class Person {
    has $title :isa(Str) :new(optional) :predicate;
    has $name  :isa(Str) :new;

    method full_name() {
        my $prefix = $self->has_title ? "$title " : '';
        return "$prefix $name";
    }
}

Attributes: Read-only

Here we have an attribute we assume we want to lazily calculate once and only once. This is very useful for immutable objects if the calculation is expensive (it's not in this case, but this is just an example).

Moose

package Box {
    use Moose;
    has [qw/height width depth/] => (
        is       => 'ro',
        isa      => 'Num',
        required => 1,
    );

    has volume => (
        is       => 'ro',
        isa      => 'Num',
        init_arg => undef,
        lazy     => 1,
        builder  => '_build_volume',
    );

    sub _build_volume($self) {
        return $self->height * $self->width * $self->depth;
    }
}

Cor

class Box {
    has ( $height, $width, $depth ) :new :reader :isa(PositiveNum);

    has $volume :reader :builder;

    method _build_volume { $height * $width * $depth }
}

Attributes: Custom Writers

Without going into detail, Moose offers many solutions to handling custom behavior when setting an attribute. Triggers and coercions both come to mind. Rather than show all the ways that Moose can do it, we'll show you the recommended way for Cor to do it.

You simply don't have :reader or :writer specified and you handle by counting the args:

has $foo :isa(Int);

sub foo(@args) {
    return $foo unless @args;
    # any extra behavior you want
    $foo = shift @args;
}

Really, though, you shouldn't be overloading foo like that. It's cleaner to have separate set_ methods, but it's become standard for Perl devs to use a single name for the reader and the writer. If you want separate names, than you can do this:

has $foo :reader :writer(set_foo) :isa(Int);

sub set_foo($new_foo) {
    # any extra behavior you want
    $foo = $new_foo
}

Corinna—Bringing Modern OO to Perl

Clone this wiki locally