-
Notifications
You must be signed in to change notification settings - Fork 19
Cookbook
Please see the main page of the repo for the actual RFC. As it states there:
Anything in the Wiki should be considered "rough drafts."
This is a short list of examples of writing Corinna 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 Corinna expects a list, not a hashref).
Note that the isa($type) syntax is still up for debate.
- Point Object and Subclassing
- Binary Tree
- Bank Account
- CONSTRUCT, ADJUST, and DESTRUCT (BUILDARGS and BUILD)
- Inheriting from non-Corinna classes
- Attributes: No public reader
- Attributes: Read only
- Attributes: Renaming
- Attributes: Custom Writers
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);
};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;
}
}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);
}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;
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;
}
}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);
}
};Note: the balance is read-only. The Moose example above is a bad example.
class BankAccount {
has $balance :reader :isa(ZeroOrPositiveInt) :new = 0;
method deposit($amount) {
$balance += $amount;
}
method withdraw($amount) {
($balance > $amount) || confess("Acount overdrawn");
$balance -= $amount;
}
}
class CheckingAccount isa BankAccount {
has $overdraft_account :new :isa('BankAccount') :builder;
method _build_overdraft_account ($self) {...}
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 = 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.
You would like to be able to modify how an object is constructed and later,
perhaps check some constraints. Use the CONSTRUCT and ADJUST phases for
that. Here's an example which allows you to change constructor behavior and
count how many instances you have:
class Box {
shared $num_boxes :reader = 0; # shared means class data
has ( $height, $width, $depth ) :new :reader :isa(PositiveNum);
has $volume :reader :builder;
# if you leave off 'private', this can be overridden in a subclass
private method _build_volume () {
return $height * $width * $depth;
}
# called before initialization. No instance variable has a value at this
# time.
CONSTRUCT (%args) {
if ( exists $args{side} ) {
my $length = delete $args{sides};
$args{height} = $length;
$args{width} = $length;
$args{depth} = $length;
}
return %args;
}
# called after initialization.
# yes, this example is silly
ADJUST (%args) { # same arguments as CONSTRUCT accepts, not returns
if (exists $ENV{MAX_VOLUME} && $volume > $ENV{MAX_VOLUME}) {
croak("$volume is too big! Too big! This ain't gonna work!");
}
$num_boxes++;
}
DESTRUCT($destruct_object) {
$num_boxes--;
}
}With the above, you can create a box and a cube (a box with all sides equal):
say Box->num_boxes; # 0
my $box = Box->new( height => 7, width => 3, depth => 42.2 );
my $cube = Box->new(side => 3);
say Box->num_boxes; # 2
say $box->num_boxes; # 2
say $cube->num_boxes; # 2
undef $cube;
say Box->num_boxes; # 1
say $box->num_boxes; # 1package 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;
}
}class Person {
has $ssn :reader :isa(Str) :new :predicate = undef;
has ($first_name, $last_name) :reader :isa(Str) :new;
has $country_of_residence :reader :isa(Str) :new = 'usa';
CONSTRUCT (@args) {
my %args = 1 == @args
? (ssn => $args[0])
: @args;
return %args;
}
# at this point the arguments are guaranteed to be a hash
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;
}
}
}package HTML::TokeParser::Moose;
use Moose;
use MooseX::NonMoose;
extends 'HTML::TokeParser::Simple';
# more code here
For the first pass, we might not allow Corinna 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:
class HTML::TokeParser::Corinna {
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.
package Person;
use Moose;
has title => (
is => 'ro',
isa => 'Str',
predicate => 'has_title',
);
has _name => ( # No public reader
is => 'ro',
init_arg => 'name',
isa => 'Str',
required => 1,
);
sub full_name ($self) {
my $name = $self->_name
my $title = $self->has_title ? $self->title . ' ' : '';
return $title . $name;
}class Person {
has $title :isa(Str) :new :predicate = undef;
has $name :isa(Str) :new;
method full_name() {
my $prefix = $self->has_title ? "$title " : '';
return "$prefix $name";
}
}Use the :name attribute:
has $num_tries :name(count) :reader :writer :new :isa(Int);By default, Corinna uses the slot variable identifer (the part without the
punctuation) as the base name for readers, writers, and constructor arguments.
However, you may need to change those names. For example, if a child class
also has a $num_tries slot, the reader and writer would override the
parent's reader and writer,x even if this was not intended. Further, it would
no longer be clear what to do with the num_tries => ... constructor
argument. So the :name attribute fixes this.
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).
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;
}
}class Box {
has ( $height, $width, $depth ) :new :reader :isa(PositiveNum);
has $volume :reader :builder;
method _build_volume { $height * $width * $depth }
}By default, the :writer attribute creates a set_$name attribute. However,
if you need custom behavior, you provide this method yourself. Moose, for
example, offers many solutions to handling custom behavior for things like
triggers and coercions. At least fo r v1, Corinna will handle this the way most OO
languages handle it: write a method.
has $foo :reader :isa(Int);
method set_foo($new_foo) {
# any extra behavior you want
$foo = $new_foo;
return $self;
}However, many Perl devs prefer to overload the meaning of an attribute to be both a setter and a getter. This is bad and should not be done. However, I confess that I've been lazy and done that repeatedly simply because it's such a common anti-pattern in Perl.
To make this mistake in Cor, you simply don't have :reader or
:writer specified and you handle by counting the args:
has $foo :isa(Int);
method foo(@args) {
return $foo unless @args;
croak("Too many arguments to foo()") if @args > 1;
# any extra behavior you want
$foo = shift @args;
return $self;
}Note that the above is terrible.
- Method names should indicate purpose (are we setting or getting something?)
- You have to manually do argument counting
- It's easy to forget to manually do argument counting
- It's easy to deliberately forget argument counting (“nah, this will never break”)
- The return type of the method now can change based on the number of arguments
The point of software is to help humans, not computers. Every time you force the human to do something that the computer can do, you waste more time of the human and you introduce more bugs. This stems from ridiculous legacy cruft going back decades.
Note that a cleaner, more powerful, and more efficient solution would be possible if Corinna were allowed to support multiply dispatched methods, but for simplicity, we dispatch on the number of arguments, not the kinds of arguments:
has $foo :reader :isa(Int);
multi method foo($new_value) {
# any extra behavior you want
$foo = $new_value
return $self;
}
If that was done internally, we could even simplify that to:
has $foo :reader :writer(foo) :isa(Int);
Instead of being an error, or having Corinna writing extra (slower) code to count the number of arguments, we would simply reuse existing multiple dispatch code to handle this.
Damian actually created a proof-of-concept multi-dispatch system based on the number of arguments in 20 minutes. It's not hard to do and, unlike multi-dispatch systems based on types, you generally don't wind up with ambiguous cases where the compiler can't figure out what to do. It also makes C3 method lookup safer.
However, for the time being, we'll "punt" on this issue.
Corinna—Bringing Modern OO to Perl