How can I make my Perl method more Moose-like?

Question

I am practising Kata Nine: Back to the CheckOut in Perl whilst also trying to use Moose for the first time.

So far, I've created the following class:

package Checkout;

# $Id$
#

use strict;
use warnings;

our $VERSION = '0.01';

use Moose;
use Readonly;

Readonly::Scalar our $PRICE_OF_A => 50;

sub price {
    my ( $self, $items ) = @_;

    if ( defined $items ) {
        $self->{price} = 0;

        if ( $items eq 'A' ) {
            $self->{price} = $PRICE_OF_A;
        }
    }

    return $self->{price};
}

__PACKAGE__->meta->make_immutable;

no Moose;

1;

The whole price method doesn't feel very Moose-ish and I feel like this could be refactored further.

Does anyone have any input on how this could be improved?

Answer 1

First thing I noticed is that you're not using an explicit attribute for your class.

$self->{price} = 0;

This violates most of the encapsulation that using Moose provides. A Moose solution would at the least make price into an actual attribute.

use 5.10.0; # for given/when

has '_price' => ( is => 'rw' );

sub price {
    my ( $self, $item ) = @_;
    given ($item) {
        when ('A') { $self->_price($PRICE_OF_A) }
        default    { $self->_price(0) }
    }
}

However the main problem with the code you've presented is that you're not really modeling the problem described by the Kata. First the Kata specifically states that you'll need to pass in the pricing rules on each invocation of the Checkout Object. So we know we'll need to save this state in something other than a series of ReadOnly class variables.

has pricing_rules => (
    isa     => 'HashRef',
    is      => 'ro',
    traits  => ['Hash'],
    default => sub { {} },
    handles => {
        price     => 'get',
        has_price => 'exists'
    },
);

You'll see the price method here is now a delegate using Moose's "Native Attributes" delegation. This will perform a lookup between an Item and a Rule. This however won't handle the case of a lookup on a element that doesn't exist. Peeking ahead one of the unit tests the Kata provides is exactly that kind of a lookup:

is( price(""),     0 ); # translated to Test::More

So we'll need to modify the price method slightly to handle that case. Basically we check to see if we have a price rule, otherwise we return 0.

around 'price' => sub {
    my ( $next, $self, $item ) = @_;
    return 0 unless $self->has_price($item);
    $self->$next($item);
};

Next we'll need to track the items as they're scanned so we can build a total.

has items => (
    isa     => 'ArrayRef',
    traits  => ['Array'],
    default => sub { [] },
    handles => {
        scan  => 'push',
        items => 'elements'
    },
);

Again the "Native Attributes" delegation provides the scan method that the test in the Kata are looking for.

# Translated to Test::More
my $co = Checkout->new( pricing_rules => $RULES );
is( $co->total, 0 );
$co->scan("A");
is( $co->total, 50 );

Finally a total method is trivial using List::Util's sum function.

sub total {
    my ($self) = @_;
    my @prices = map { $self->price($_) } $self->items;
    return sum( 0, @prices );
}

This code doesn't fully implement the solution to the Kata, but it does present a much better model of the problem state and show's a much more "Moosey" solution.

The full code and translated tests are presented below.

{

    package Checkout;
    use Moose;
    our $VERSION = '0.01';
    use namespace::autoclean;

    use List::Util qw(sum);

    has pricing_rules => (
        isa     => 'HashRef',
        is      => 'ro',
        traits  => ['Hash'],
        default => sub { {} },
        handles => {
            price     => 'get',
            has_price => 'exists'
        },
    );

    around 'price' => sub {
        my ( $next, $self, $item ) = @_;
        return 0 unless $self->has_price($item);
        $self->$next($item);
    };

    has items => (
        isa     => 'ArrayRef',
        traits  => ['Array'],
        default => sub { [] },
        handles => {
            scan  => 'push',
            items => 'elements'
        },
    );

    sub total {
        my ($self) = @_;
        my @prices = map { $self->price($_) } $self->items;
        return sum( 0, @prices );
    }

    __PACKAGE__->meta->make_immutable;
}

{

    package main;
    use 5.10.0;
    use Test::More;

    our $RULES = { A => 50 };    # need a full ruleset

    sub price {
        my ($goods) = @_;
        my $co = Checkout->new( pricing_rules => $RULES ); # use BUILDARGS the example API 
        for ( split //, $goods ) { $co->scan($_) }
        return $co->total;
    }

  TODO: {
        local $TODO = 'Kata 9 not implemented';

        is( price(""),     0 );
        is( price("A"),    50 );
        is( price("AB"),   80 );
        is( price("CDBA"), 115 );

        is( price("AA"),     100 );
        is( price("AAA"),    130 );
        is( price("AAAA"),   180 );
        is( price("AAAAA"),  230 );
        is( price("AAAAAA"), 260 );

        is( price("AAAB"),   160 );
        is( price("AAABB"),  175 );
        is( price("AAABBD"), 190 );
        is( price("DABABA"), 190 );

        my $co = Checkout->new( pricing_rules => $RULES );
        is( $co->total, 0 );
        $co->scan("A");
        is( $co->total, 50 );
        $co->scan("B");
        is( $co->total, 80 );
        $co->scan("A");
        is( $co->total, 130 );
        $co->scan("A");
        is( $co->total, 160 );
        $co->scan("B");
        is( $co->total, 175 );
    }

    done_testing();
}