如何序列化 Moose 对象，包括嵌套的 Moose 对象

Question

尝试构建一种优雅的方式来序列化 Moose 对象和嵌套的 Moose 对象。示例：

package Asset;
use Moose::Role;

has 'value' => (
  isa => 'Int'
);

has 'owner' => (
  isa => 'Person',
);

sub as_serializable {
...
}


package Car;
use Moose;

with 'Asset';  # role

has 'mileage' => (
  isa => 'Int',
);

has 'driver' => (    
  isa => 'Person',
);


package House;
use Moose;

with 'Asset';  # role

has 'bathrooms' => (
  isa => 'Int'
);



package Person;
use Moose;

has 'name' => (
  isa => 'Str',
);

has 'favorite_assets' => (    
  isa => 'ArrayRef[Asset]',  # and so on... and just to complicate things a bit...
  lazy => 1
);

我想要的是某种序列化方式，可能是这样的：

use JSON;
my $car = Car();
return JSON::encode_json( $car->as_serializable() );

也许as_serializable() 方法包含一组参数，这些参数指定要扩展哪些属性（和嵌套属性），并且可能有一些防止循环扩展的保护措施，正如我在favorite_assets 属性中所暗示的那样。

在我开始自己动手之前，这样的东西是否已经存在？我必须相信某个地方的某个人已经面临这个确切的挑战。我查看了所有 Moose 文档并进行了一些搜索，但没有发现任何明显的东西，但我还是个新手。

用例是能够通过 http web api 快速序列化复杂的 Moose'ish 对象并使其可用，即可以从客户端 web 浏览器中运行的 JavaScript 访问。

谢谢！

Answer 1

我决定自己动手。我在这里发布我的代码是为了让其他可能需要快速简便的解决方案的人受益。

为获得最佳效果，请将其添加到 Moose 类树的角色中。

=item as_serializable - Converts self to serializable hashref

INPUT: $schema is a nested hashref of attributes to expand or suppress. 

This example expands the 'owner' and 'driver' attributes within Car, further expands the 'favorite_assets' attribute within Person, and suppresses mileage:

  my $car = Car();
  my $car_serializable = $car->as_serializable({
    owner => {},
    driver => {
      favorite_assets => {}
    },
    mileage => 0
  });

OUTPUT: $hashref

RULES:
1. All scalars are expanded by default, unless they're private (name starts with _)
2. DateTime's are stringified and treated as scalars.
3. HashRefs, ArrayRefs, and Moose objects are not expanded by default.
4. To expand a given attribute, set corresponding $schema node to {}, adding sub-attributes to expand as desired.
5. To suppress expansion/building a given attribute, set corresponding $schema node to 0.
6. HashRefs & ArrayRefs are all-or-none in $schema. No option to pick by specific hash-keys or array-elements.
7. Unless specifically suppressed, all attributes are built even if lazy.
8. Any attribute without a value is skipped.

=cut

sub as_serializable {
  my ( $self, $schema ) = @_;
  return $self->_serialize_value( $self, $schema || {} );
}

sub _serialize_value {
  my ( $self, $value, $schema ) = @_;

  # scalar
  if ( !ref($value) ) {
    return $value;
  }

  # DateTime as scalar
  if ( ref($value) eq 'DateTime' ) {
    return ''.$value;   #stringify
  }

  # hashref
  if ( ref($value) eq 'HASH' ) {
    my $h = {};
    foreach my $k (keys %{ $value }) {
      $h->{ $k } = $self->_serialize_value( $value->{$k}, $schema );
    }
    return $h;
  }

  # arrayref
  if ( ref($value) eq 'ARRAY' ) {
    return [ map { $self->_serialize_value($_, $schema) } @{ $value } ];
  }

  # Moose object
  if ( blessed($value) && $value->can('meta') ) {
    my $h = {};
    foreach my $attr ( $value->meta->get_all_attributes ) {
      my $name = $attr->name;
      if ( exists($schema->{ $name }) && !$schema->{ $name } ) {  # suppress expansion (including get_value) if $schema->{ $name } is false
        next;
      }

      my $attr_val = $attr->get_value( $value );  
      if ( !$attr->has_value( $value ) ) {   # suppress attributes with no value
        next;
      }

      if ( $schema->{ $name } || ( !($name =~ /^_/) && ( !ref($attr_val) || (ref($attr_val) eq 'DateTime') ) ) ) {   # expand non-private scalars + all attributes specified by $schema
        $h->{ $name } = $self->_serialize_value( $attr_val, $schema->{ $name } );
      }
    }

    return $h;
  }

  # if/as needed, add support for other reference types here...

  die "unsupported ref='" . ref($value) . "' required by schema";
}

请注意，我以自己的方式对 DateTime 进行序列化/字符串化，这特定于我始终如一地构建我的 DateTime 对象的方式。您可能需要为您的项目更改此设置。

感谢 @simbabque 的建设性 cmets 促成了这个解决方案，感谢 @nothingmuch 的单独协助和最终代码审查。