File Coverage

blib/lib/MooX/JSON_LD.pm
Criterion Covered Total %
statement 55 55 100.0
branch 8 14 57.1
condition 7 10 70.0
subroutine 14 14 100.0
pod n/a
total 84 93 90.3


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             MooX::JSON_LD - Extend Moo to provide JSON-LD mark-up for your objects.
4              
5             =head1 SYNOPSIS
6              
7             # Your Moo (or Moose) Class
8             package My::Moo::Class;
9              
10             use Moo;
11              
12             use MooX::JSON_LD 'Person';
13              
14             has first_name => (
15             is => 'ro',
16             # various other properties...
17             json_ld => 1,
18             );
19              
20             has last_name => (
21             is => 'ro',
22             # various other properties...
23             json_ld => 1,
24             );
25              
26             has birth_date => (
27             is => 'ro',
28             # various other properties...
29             json_ld => 'birthDate',
30             json_ld_serializer => sub { shift->birth_date },
31             );
32              
33             # Then, in a program somewhere...
34             use My::Moo::Class;
35              
36             my $obj = My::Moo::Class->new({
37             first_name => 'David',
38             last_name => 'Bowie',
39             birth_date => '1947-01-08',
40             });
41              
42             # print a text representation of the JSON-LD
43             print $obj->json_ld;
44              
45             # print the raw data structure for the JSON-LD
46             use Data::Dumper;
47             print Dumper $obj->json_ld_data;
48              
49             =head1 DESCRIPTION
50              
51             This is a companion module for L<MooX::Role::JSON_LD>. It extends the
52             C<has> method to support options to add attributes to the
53             C<json_ld_fields> and create the C<json_ld_type> .
54              
55             To declare the type, add it as the option when importing the module,
56             e.g.
57              
58             use MooX::JSON_LD 'Thing';
59              
60             Moo attributes are extended with the following options:
61              
62             =over
63              
64             =item C<json_ld>
65              
66             has headline => (
67             is => 'ro',
68             json_ld => 1,
69             );
70              
71             This adds the "headline" attribute to the C<json_ld_fields>.
72              
73             has alt_headline => (
74             is => 'ro',
75             json_ld => 'alternateHeadline',
76             );
77              
78             This adds the "alt_headline" attribute to the C<json_ld_fields>, with
79             the label "alternateHeadline".
80              
81             =item C<json_ld_serializer>
82              
83             has birth_date => (
84             is => 'ro',
85             isa => InstanceOf['DateTime'],
86             json_ld => 'birthDate',
87             json_ld_serializer => sub { shift->birth_date->ymd },
88             );
89              
90             This allows you to specify a method for converting the data into an
91             object that L<JSON> can serialize.
92              
93             =back
94              
95             =head1 AUTHOR
96              
97             Robert Rothenberg <rrwo@cpan.org>
98              
99             =head1 SEE ALSO
100              
101             L<MooX::Role::JSON_LD>
102              
103             =head1 COPYRIGHT AND LICENSE
104              
105             Copyright (C) 2018, Robert Rothenberg. All Rights Reserved.
106              
107             This script is free software; you can redistribute it and/or modify it
108             under the same terms as Perl itself.
109              
110              
111             =cut
112              
113             package MooX::JSON_LD;
114              
115 5     5   426202 use strict;
  5         25  
  5         121  
116 5     5   21 use warnings;
  5         8  
  5         94  
117              
118 5     5   20 use Moo ();
  5         8  
  5         70  
119 5     5   1962 use Moo::Role ();
  5         36040  
  5         109  
120              
121 5     5   2375 use MRO::Compat;
  5         7122  
  5         158  
122 5     5   31 use List::Util qw/ all /;
  5         8  
  5         482  
123 5     5   2151 use Sub::Quote qw/ quote_sub /;
  5         20112  
  5         377  
124              
125             our $VERSION = '0.0.17';
126              
127             my %Attributes;
128              
129             sub import {
130 8     8   31969 my ( $class, $type ) = @_;
131              
132 8         23 my $target = caller;
133              
134 5     5   30 no strict 'refs';
  5         9  
  5         116  
135 5     5   21 no warnings 'redefine';
  5         8  
  5         1623  
136              
137 8 50       94 my $installer =
138             $target->isa("Moo::Object")
139             ? \&Moo::_install_tracked
140             : \&Moo::Role::_install_tracked;
141              
142 8 50       58 if ( my $has = $target->can('has') ) {
143             my $new_has = sub {
144 16     16   57843 $has->( _process_has(@_) );
145 8         31 };
146 8         28 $installer->( $target, "has", $new_has );
147             }
148              
149 8 50       269 if ( defined $type ) {
150 8         50 quote_sub "${target}::json_ld_type", "'${type}'";
151             }
152              
153 8         925 my $name = "json_ld_fields";
154              
155             quote_sub "${target}::${name}", '$code->(@_)',
156             {
157             '$code' => \sub {
158 25     25   232 my ($self) = @_;
159 25   100     71 my $fields = $self->maybe::next::method || [];
160             return [
161 25         37 @{$fields},
162 25 50       268 @{$Attributes{$target} || []}
  25         107  
163             ];
164             },
165             }, {
166 8         70 no_defer => 1,
167             package => $target,
168             };
169              
170              
171 8 50   8   3626 unless ( all { $target->can($_) }
  8         67  
172             qw/ json_ld_encoder json_ld_data json_ld / )
173             {
174              
175 8         56 Moo::Role->apply_single_role_to_package( $target,
176             'MooX::Role::JSON_LD' );
177              
178             }
179              
180             }
181              
182             sub _process_has {
183 16     16   69 my ( $name, %opts ) = @_;
184              
185 16 50 33     57 if ( $opts{json_ld} || $opts{json_ld_serializer} ) {
186              
187 16         31 my $class = caller(1);
188 16   100     66 $Attributes{$class} ||= [];
189              
190 16         33 my $label = delete $opts{json_ld};
191 16         22 my $method = delete $opts{json_ld_serializer};
192              
193 16 100 66     21 push @{ $Attributes{$class} }, {
  16         100  
194             $label eq "1" ? $name : $label => $method || $name
195             };
196             }
197              
198 16         74 return ( $name, %opts );
199             }
200              
201             1;