The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
 / 
MooseX-RelClassTypes-0.03
River stage zero No dependents
/ MooseX::RelClassTypes

NAME

MooseX::RelClassTypes - specify a class name in an attribute isa relative to the current class

SYNOPSIS

    package Dog;
    use Moose;
    with 'MooseX::RelClassTypes';

    has tail => (
        is => 'rw',
        isa => 'Tail::{CLASS}'  # sets constraint as 'Tail::Dog'
    );

    package Cat;
    use Moose;
    with 'MooseX::RelClassTypes'

    has tail => (
        is => 'rw',
        isa => 'Tail::{CLASS}' # sets constraint as 'Tail::Cat'
    );

DESCRIPTION

To group accessors it can be convenient to create a nested structure of Moose objects. For example, instead of having

    package Car;
    use Moose;

    has max_speed => (is => 'rw', isa => 'Int');
    has max_acceleration => (is => 'rw', isa => 'Int');
    has turning_circle => (is => 'rw', isa => 'Int');

    has height => (is => 'ro', isa => 'Int');
    has weight => (is => 'ro', isa => 'Int');
    has length => (is => 'ro', isa => 'Int');

    has color => (is => 'ro', isa => 'Str');
    has style => (is => 'ro', isa => 'Str');
    has seat_fabric => (is => ro', isa => 'Str');

    # ... other methods

you could group the attributes in some convenient way:

    package Car
    use Moose;

    has performance => (
        is => 'rw', 
        isa => 'Car::Performance'
    );

    has static_properties => (
        is => 'rw',
        isa => 'Car::Properties'
    );

    has appearance => (
        is => 'rw',
        isa => 'Car::Appearance'
    );

    # ... other methods

And Car::Performance would look like

    package Car::Performance
    use Moose;

    has max_speed => (
        is => 'rw',
        isa => 'Int'
    );

    has max_acceleration => (
        is => 'rw',
        isa => 'Int'
    );

    has turning_circle => (
        is => 'rw',
        isa => 'Int'
    );

with Car::Properties and Car::Appearance organised similarly. Then if you have an application which is only interested in performance (say) then your app can manipulate Car::Performance without having to load the whole car.

What if we have a truck?

    package Truck;

    use Moose;

    has performace => (
        is => 'rw',
        isa => 'Truck::Performance'
    );

    has static_properties => (
        is => 'rw',
        isa => 'Truck::Properties'
    );

    has appearance => (
        is => 'rw',
        isa => 'Truck::Appearance'
    );

This looks a lot like the Car package, but with Car replaced by Truck throughout. Now of course inheritance is the way to go in this situation:

    package Vehicle;
    use Moose;

    has performance => (
        is => 'rw',
        isa => 'Vehicle::Performance'
    );

    has static_properties => (
        is => 'rw',
        isa => 'Vehicle::Properties'
    );

    has appearance => (
        is => 'rw',
        isa => 'Vehicle::Appearance'
    );


    package Truck;
    use Moose;
    extends 'Vehicle';

    # ... other methods


    package Car;
    use Moose;
    extends 'Vehicle';

    # ... other methods

(And perhaps Truck::Performance and Car::Performance could inherit from Vehicle::Performance?)

However, this means the type constraints for both Car and Truck attributes will be in terms of Vehicle:: (e.g. Vehicle::Performance). That's OK as long as you don't try to put a Truck::Performance object in a Car::Performance accessor. It will be accepted because they are both Vehicle::Performance - but now you have a broken car. And what's the point of a type constraint if it doesn't stop you from doing this?

It would be great to be able to do this:

    package Vehicle
    use Moose;

    has performance => (
        is => 'rw',
        isa => '(class of current object)::Performance'
    );
    
    # ...

Then when you create objects which inherit from Vehicle, they automatically pick up the correct type constraint for performance.

Note that doing this doesn't work:

    package Vehicle
    use Moose;

    has performance => (
        is => 'rw',
        isa => __PACKAGE__'::Performance'
    );

    # ...

because this will give you a Vehicle::Performance type constraint every time, regardless of the actual class.

In fact there appears to be no way to do this in vanilla Moose. You're either stuck with compromising on your constraints, or writing out new accessors each time you create a new vehicle (which is not very DRY).

Enter MooseX::RelClassTypes - called as such because it allows attribute type constraints to be set relative to the current class (rather than the current package).

So now you can do:

    package Vehicle;
    use Moose;
    with 'MooseX::RelClassTypes'; # include as a Moose Role

    has performance => (
        is => 'rw', 
        isa => '{CLASS}::Performance'
    );
    
    has static_properties => (
        is => 'rw',
        isa => '{CLASS}::Properties'
    );

    has appearance => (
        is => 'rw',
        isa => '{CLASS}::Appearance'
    );

So that:

    # this works:

    my $car = Car->new(
        performance => Car::Performance->new;
    )

    # but this errors Moosishly:

    my $car = Car->new(
        performance => Truck::Performance->new;
    );

which of course is what you really want.

USAGE

MooseX::RelClassTypes is a Parameterized Role

Actually you probably don't need to modify the parameters - but nevertheless the following are provided:

parser

parser should be a CodeRef to a sub which will "parse" the isa (ie regex it and turn it into a real class name). The sub needs to have the following format:

    sub {
        my ($isa_string, $parent_class) = @_;

        my $relative_class = ... ;      # ( perform some kind of 
                                        # operation to substitute
                                        # $parent_class in 
                                        # $isa_string somehow)

        if ( $successful ){             # ie if substitution 
                                        # actually occurred

            return $relative class;     # this should end up as 
                                        # a real class name

        }  else {
                                        # it's important to 
                                        # return undef if no
            return undef;               # substitution happened 
                                        # (meaning isa is not a
                                        # relative class name) to
        }                               # prevent unnecessary 
                                        # processing
    }

where $isa_string will be the unparsed string (e.g. {CLASS}::Performance and $parent_class will be the class invoking the attribute (e.g. Car).

If for some reason you don't like the default behaviour - which is to replace {CLASS} with the invoking class name - then you could use a custom parser routine to have the token to replace in a different format, e.g. (package). Or you could have your sub deduce the name from some whacky mathematical formula. To specify a custom parser routine, include it in your with... call:

    package MyPackage;
    use Moose;
    with MooseX::RelClassTypes => { parser => sub { ... } };

(See MooseX::Role::Parameterized for more info on parameterized roles).

However, caution might be a good idea here. e.g. it is probably not a good idea to use a token which contains just text characters (and thus might coincide with part of a real module name) - this could lead to strange errors. Also remember that Moose has its own use for square brackets [] which is not a good idea to mess with.

auto_default

Since this module is intended for compound objects (ie objects that contain other objects in some kind of fixed heirarchy), it can be irritating to have to write

    has performance => (
        is => 'ro', 
        isa => '{CLASS}::Performance',
        default => sub{
            my $self = @_;
            my $package = ref( $self ).'::Performance';
            return $package->new;
        }
    });

every time you just want the relevant class to be created via ->new. Therefore by default if MooseX::RelClassTypes sees this:

    has performance => (
        is => 'ro',
        isa => '{CLASS}::Performance'
    );

it will automatically create an instance of the relevant class by calling ->new. (ie the above 2 code snippets are equivalent).

It will only do this if auto_default == 1 and if there is no default or builder specified in the attribute declaration.

Note also that no attempt has been made to try to circumvent Moose's treatment of lazy attributes. So you can't do this:

    has performance => (
        is => 'ro',
        isa => '{CLASS}::Performance',
        lazy => 1
    );

and expect it to work. Moose will error, complaining that a lazy attribute needs either a default or a builder. In summary, auto_default does not work with lazy attributes. You'll have to write out your default or builder sub in full if you want it to be lazy.

(I don't think this feature will ever be added. Firstly having lazy without an obvious default or builder looks confusing. Also lazy often means an attribute depends on another - which is not the case for a simple object instantiation using ->new.)

If you do not want MooseX::RelClassTypes to automatically create defaults in the manner described above, you should set auto_default to be 0:

    package MyPackage;
    use Moose;
    with 'MooseX::RelClassTypes' => { auto_default => 0 };

SEE ALSO

MooseX::Role::Parameterized

AUTHOR

Tom Gracey <tomgracey@gmail.com>

COPYRIGHT AND LICENSE

Copyright (C) 2018 by Tom Gracey

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.