Moose - modify default attribute position in object hash

Question

I'm dealing with some non-Moose legacy code and I want to extend it with a Moose class. This is a simplification of the legacy code:

package My::Legacy;

sub create {
  my ($class, $args) = @_;

  my $fields = { _fields => {}};
  foreach my $key ( keys %$args ) {
     $fields->{_fields}->{$key} = $args->{$key}
  }
  bless $fields, $class;
}

1;

The My::Legacy class handles all the CRUD operations, caching and other stuff. All the operations are performed on the values contained in the internal _field hash, so, for example, if you want to update a value it has to be in the _field hash. The My::Legacy class provides setter/getter for this.

The My::Legacy is subclassed by several classes that need the "sugar" provided by it: My::Legacy::ObjectA, My::Legacy::ObjectB, etc.

I need to add a further one and I want to extend it using Moose. The problem is that every time I will set an attribute, I will have to keep its value in sync in the internal _fields hash, so for example if I have...

 package My::Legacy::MyMooseObj;

 use Moose;
 use MooseX::NonMoose;
 use namespace::autoclean;

 has _fields => (
   isa         => HashRef,
   is          => 'rw',
   default     => sub { {} },
 );

 has attr_a => (
   isa   => 'Int',
   is    => 'ro',
 );

 has attr_b => (
   isa   => 'Str',
   is    => 'ro',
 );


 __PACKAGE__->meta->make_immutable;

...and I do:

 my $MyMooseObj = My::Legacy::MyMooseObj->new();
 $MyMooseObj->attr_a(15);

...I want attr_a to be set in _fields as well, so if I dump out the object it will look like:

 bless( {
             '_fields' => {
                           'attr_a' => 15,
                         },
             'attr_a' => 15,
           }, 'My::Legacy::MyMooseObj' );

The way I come up to achieve this is add a trigger to each attribute in order to write its value in the _fields hash every time is set:

     has attr_b => (
      isa   => 'Str',
      is    => 'ro',
      trigger => sub { # Write in the _fields attribute attr_b value! },
    );

This is a bit annoying because every time I add a new attribute I have to make sure it has the trigger set :/

Can you think of a better way of doing it ? Is there any way of telling Moose to read/write the attribute not in the "root" of the object hash by default (so in my case to read/write attributes from _fields) ?

Answer 1

This more or less does what you want...

use strict;
use warnings;

{
    package My::Legacy::MyMooseObj;

    use Moose;
    use MooseX::FunkyAttributes;
    use namespace::autoclean;

    has _fields => (
        isa         => 'HashRef',
        is          => 'rw',
        default     => sub { {} },
        lazy        => 1,  # you want this, for the rest to work
    );

    has attr_a => (
        isa         => 'Int',
        is          => 'ro',
        traits      => [ FunkyAttribute ],
        custom_get  => sub { $_->_fields->{attr_a} },
        custom_set  => sub { $_->_fields->{attr_a} = $_[-1] },
        custom_has  => sub { exists($_->_fields->{attr_a}) },
    );

    has attr_b => (
        isa         => 'Str',
        is          => 'rw',
        traits      => [ FunkyAttribute ],
        custom_get  => sub { $_->_fields->{attr_b} },
        custom_set  => sub { $_->_fields->{attr_b} = $_[-1] },
        custom_has  => sub { exists($_->_fields->{attr_b}) },
    );
}

my $obj = My::Legacy::MyMooseObj->new( attr_a => 42 );
$obj->attr_b(666);

print $obj->dump;

With the current version of MooseX::FunkyAttributes, the constructor will not work correctly if you do the whole __PACKAGE__->meta->make_immutable though. :-(

Delving slightly deeper into metaprogramming...

use strict;
use warnings;

{
    package My::Legacy::MyMooseObj;

    use Moose;
    use MooseX::FunkyAttributes;
    use namespace::autoclean;

    has _fields => (
        isa         => 'HashRef',
        is          => 'rw',
        default     => sub { {} },
        lazy        => 1,  # you want this, for the rest to work
    );

    sub funky_has {
        my ($attr, %opts) = @_;
        has $attr => (
            is          => 'ro',
            traits      => [ FunkyAttribute ],
            custom_get  => sub { $_->_fields->{$attr} },
            custom_set  => sub { $_->_fields->{$attr} = $_[-1] },
            custom_has  => sub { exists($_->_fields->{$attr}) },
            %opts,
        );
    }

    funky_has attr_a => (isa => 'Int');
    funky_has attr_b => (isa => 'Str', is => 'rw');
}

my $obj = My::Legacy::MyMooseObj->new( attr_a => 42 );
$obj->attr_b(666);

print $obj->dump;