Re^5: When to Use Object Oriented approach in Perl? (RFC)

[tobyink]

A rectangle class might have horizontal_stretch and vertical_stretch methods which stretch a rectangle in one direction. Square is a subclass of rectangle, but if you stretch a square in one direction, it's no longer a square.

Generalising the issue: mutator methods in the parent class might invalidate constraints imposed by the child class.

The square—rectangle problem (a.k.a. the circle—ellipse problem) is often seen as a demonstration of why subclassing is evil. I prefer to see it as a demonstration of why mutable objects are evil.

Here's a perfectly consistent implementation of a Square and Rectangle class using immutable objects and subclassing...

use Moops;

class Rectangle using Moose :ro {
    has height => (isa => Num, required => true);
    has width  => (isa => Num, required => true);
    has colour => (isa => Str, default => "black");
    
    method area () {
        $self->height * $self->width;
    }
    
    method perimeter () {
        2 * ($self->height + $self->width);
    }
    
    # Here's a private method; it creates a clone of
    # the current object, but allows some attributes to
    # be changed.
    #
    method my $_but (%args) {
        __PACKAGE__->new(%$self, %args);
    }
    
    method paint (Str $colour) {
        $self->$_but( colour => $colour );
    }
    
    method horizontal_stretch (Num $factor) {
        my $new_width = $self->width * $factor;
        $self->$_but( width => $new_width );
    }
    
    method vertical_stretch (Num $factor) {
        my $new_height = $self->height * $factor;
        $self->$_but( height => $new_height );
    }
    
    method grow (Num $factor) {
        $self->horizontal_stretch($factor)->vertical_stretch($factor);
    }    
}

class Square extends Rectangle using Moose :ro {
    around BUILDARGS (@args) {
        my $params = $self->$next(@args);
        $params->{height} //= $params->{width};
        $params->{width}  //= $params->{height};
        return $params;
    }
    method BUILD {
        confess "Not a square" unless $self->width == $self->height;
    }
}

my $square = Square->new(width => 12);
print $square->dump;

my $painted = $square->paint("red");
print $painted->dump;

my $grown = $painted->vertical_stretch(2.5);
print $grown->dump;

/a