110 lines
2.0 KiB
Perl
110 lines
2.0 KiB
Perl
use 5.32.0;
|
|
|
|
package Dancer2::Plugin::JsonApi::Registry::Schema;
|
|
|
|
use Moo;
|
|
|
|
use experimental qw/ signatures /;
|
|
use List::AllUtils qw/ pairmap /;
|
|
|
|
=head1 ATTRIBUTES
|
|
|
|
=head2 type
|
|
|
|
The JSON:API object type. Required.
|
|
|
|
=cut
|
|
|
|
has type => (
|
|
required => 1,
|
|
is => 'ro',
|
|
);
|
|
|
|
=head2 id
|
|
|
|
Key to use as a reference to the object. Defaults to C<id>. Can be a string,
|
|
or a function that will be passed the original data object.
|
|
|
|
=cut
|
|
|
|
has id => (
|
|
is => 'ro',
|
|
default => 'id'
|
|
);
|
|
|
|
has links => (is => 'ro');
|
|
has top_level_links => (is => 'ro');
|
|
has top_level_meta => (is => 'ro');
|
|
|
|
=head1 METHODS
|
|
|
|
=head2 top_level_serialize($data,$extra_data = {})
|
|
|
|
Serializes C<$data> as a top-level
|
|
JSON:API object.
|
|
|
|
=cut
|
|
|
|
sub top_level_serialize ( $self, $data, $extra_data = {} ) {
|
|
|
|
my $serial = {};
|
|
|
|
$serial->{jsonapi} = { version => '1.0' };
|
|
|
|
$serial->{data} = $self->serialize($data,$extra_data);
|
|
|
|
$serial->{links} = gen_links($self->top_level_links,$data,$extra_data)
|
|
if $self->top_level_links;
|
|
$serial->{meta} = gen_links($self->top_level_meta,$data,$extra_data)
|
|
if $self->top_level_meta;
|
|
|
|
|
|
return $serial;
|
|
|
|
}
|
|
|
|
=head2 serialize($data,$extra_data)
|
|
|
|
Serializes C<$data> as a JSON:API object.
|
|
|
|
=cut
|
|
|
|
sub serialize ( $self, $data, $extra_data = {} ) {
|
|
|
|
return [ map { $self->serialize($_,$extra_data) } @$data ] if ref $data eq 'ARRAY';
|
|
|
|
my $s = {
|
|
type => $self->type,
|
|
id => $self->gen_id($data) };
|
|
|
|
if($self->links) {
|
|
$s->{links} = gen_links($self->links,$data,$extra_data);
|
|
}
|
|
|
|
return $s;
|
|
|
|
}
|
|
|
|
sub gen_id($self,$data) {
|
|
my $id = $self->id;
|
|
|
|
return ref $id ? $id->($data) : $data->{$id};
|
|
}
|
|
|
|
sub gen_links($links,$data,$extra_data={}) {
|
|
|
|
return $links->($data,$extra_data) if ref $links eq 'CODE';
|
|
|
|
return {
|
|
pairmap { $a => gen_item($b, $data,$extra_data) } %$links
|
|
};
|
|
}
|
|
|
|
sub gen_item($item,$data,$extra_data) {
|
|
return $item unless ref $item;
|
|
|
|
return $item->($data,$extra_data);
|
|
}
|
|
|
|
1;
|