I’m working on a system were we have a bunch of objects that hold data about a system. We might have a class for a Product that has a product code, a description and a price for example. We have orders, they have order number and the such like.

        package SalesOrder;

        use Moose;

        has order_number => (is => 'ro', isa => 'Str', required => 1);
        has date_ordered => (is => 'ro', isa => 'DateTime', required => 1);
        has reference => (is => 'ro', isa => 'Str');
        has customer => (is => 'ro', isa => 'Customer', required => 1);


All those nice Moose constraints mean our objects have to get built with the correct information or there’s a blow up. Perfect. The problem I have, is that I want to use that same class to deal with defaults for that object. The defaults might be things like order numbers. In a lot of systems order numbers are generated by the system, like SO00001, then SO00002. I figured it would be neat if I could have a $sys->get_default_order() that returns me an instance of that class that has the default data. The problem is that it commonly won’t have all the information filled in. For instance, I’d probably get an order_number and date_ordered pre-populated but not the customer that we require. Attempting to construct a new sales order like this will blow up because of my constraints. As it was designed to.

    my $defaults = SalesOrder->new({
        order_number => 'SO0001',
        date_ordered => DateTime->today

What I wanted to do instead was,

    my $new_class = MooseX::NotRequired::make_optional_subclass('SalesOrder');
    my $defaults = SalesOrder->new({
        order_number => 'SO0001',
        date_ordered => DateTime->today
    }); # it now works.
    # or even these examples,
    my $default = $new_class->new(); # no blow up
    my $default2 = $new_class->new({ reference => undef }); # fine too

With a start from doy on #moose and some help from my colleague JJ I was able to come up with this function that makes that work. It’s not perfect but it does a good enough job for now. It removed any required constraints from the attributes and changes simple isa definitions like 'Str' to 'Maybe[Str]' to allow undef.

sub make_optional_subclass 
    my $class = shift;

    my $meta = Moose::Meta::Class->create_anon_class(superclasses => [$class], weaken => 0);
    for my $att ($meta->get_all_attributes)
        my $name = $att->name;
        my $options = {};
        if($att->is_required) {
            $options->{required} = 0;
        my $type = $att->{isa}; # FIXME: this is ugly
        unless (ref $type) {
            unless($type =~ /Maybe/)
                my $new_type = "Maybe[$type]";
                $options->{isa} = $new_type;

        if(scalar keys %$options)
            $meta->add_attribute("+$name", $options);
    return $meta->name;

I am using this in practice for a system we are building at OpusVL. This code creates a new class, based on the old one, where the attributes are now optional. It takes care to ensure the original class isn’t changed.


Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )


Connecting to %s