Perl Advent Calendars

It’s the time of year the Perl community does Advent calendars. I only found out about them last year, but as with everything Perl, it’s been going on for a while.

These are some of the essential posts to check out, if you only read a couple you should definitely have read these (they’re all good though).

Update: The 23rd’s item, Params::Util is another really handy tip.

Taking another look at Moose

With large libraries in the Perl world it’s easy to be overwhelmed by all their features and not realise all the things they have to offer. The Moose library is a prime example. There are two things that I noticed relatively recently, that I had initially overlooked. Moose delegation and the moose-outdated tool.

Moose delegation can be read about here in the manual, Moose::Manual::Delegation. It allows you to have a property that you pass methods straight through to. Their example illustrates it simply,

 package Website;

  use Moose;

  has 'uri' => (
      is      => 'ro',
      isa     => 'URI',
      handles => [qw( host path )],
  );

The new website object will have a host and a path method that get passed straight to the uri properties host and path methods. This makes that fairly common pattern really simple to implement, saving time on what is often useful but tedious code to write.

moose-outdated is a tool that ships with Moose to help you spot dependency problems. It’s particularly useful after a major upgrade of Moose when you can run it to report any other modules that now require an upgrade as a result. It’s their way of helping you avoid CPAN hell.

$ moose-outdated 
$ 

If you’re lucky you get no output like this. Otherwise simply upgrade the modules it complains about.

MooseX::NotRequired

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);

        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.