如何序列化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属性中所暗示的那样，可以防止循环扩展。

在我开始我自己的滚动之前，这样的东西已经存在了吗？我不得不相信，某个地方的某个人正面临着这样的挑战。我已经看遍了所有的驼鹿文档，并做了一些搜索，但没有发现任何明显的东西，但话说回来，我仍然是一个新手。

用例是能够快速序列化并通过http web api使复杂的驼鹿对象可用，即可从客户端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的建设性意见导致了这个解决方案，并感谢@nothingmuch的单独帮助和最终的代码审查。