File Coverage

blib/lib/MooX/Role/JSON_LD.pm

Criterion	Covered	Total	%
statement	54	58	93.1
branch	17	20	85.0
condition	4	9	44.4
subroutine	12	13	92.3
pod	3	4	75.0
total	90	104	86.5

=head1 NAME

MooX::Role::JSON_LD - Easily provide JSON-LD mark-up for your objects.

=head1 SYNOPSIS

    # Your Moo (or Moose) Class
    package My::Moo::Class;

    use Moo;
    with 'MooX::Role::JSON_LD';

    # define your attributes
    has first_name => (
      is => 'ro',
      # Various other properties
    );
    has last_name  => (
      is => 'ro',
      # Various other properties
    );
    has birth_date => (
      is => 'ro',
      # Various other properties
    );

    # Add two required methods
    sub json_ld_type { 'Person' };

    sub json_ld_fields { [ qw[ first_name last_name birth_date ] ] };

    # Then, in a program somewhere...
    use My::Moo::Class;

    my $obj = My::Moo::Class->new({
      first_name => 'David',
      last_name  => 'Bowie',
      birth_date => '1947-01-08',
    });

    # print a text representation of the JSON-LD
    print $obj->json_ld;

    # print the raw data structure for the JSON-LD
    use Data::Dumper;
    print Dumper $obj->json_ld_data;

=head1 DESCRIPTION

This role allows you to easily add methods to your class that produce
JSON-LD representing an instance of your class.

To do this, you need to do three things:

=over 4

=item 1. Add the role to your class

    with 'MooX::Role::JSON_LD';

=item 2. Add a method telling the role which JSON-LD type to use in the output

    sub json_ld_type { 'Person' }

=item 3. Add a method defining the fields you want to appear in the JSON-LD

    sub json_ld_fields { [ qw[ first_name last_name birth_date ] ] };

=back

=head2 Using the role

C<MooX::Role::JSON_LD> can be loaded into your class using the C<with>
keyword, just like any other role. The role has been written so that it
works in both L<Moo> and L<Moose> classes.

=head2 Defining your type

JSON-LD can be used to model many different types of object. The current list
can be found at L<https://schema.org/>. Once you have chosen one of the types
you want to use in your JSON-LD, simply add a method called C<json_ld_type>
which returns the name of your type as a string. This string will be used
in the C<@type> field of the JSON-LD.

=head2 Defining your fields

You also need to define the fields that are to be included in your JSON-LD.
To do this, you need to add a method called C<json_ld_fields> which returns
an array reference containing details of the fields you want.

The simplest approach is for each element of the array to be the name of
a method on your object. In our example above, we call the three methods,
C<first_name>, C<last_name> and C<birth_date>. The names of the methods are
used as keys in the JSON-LD and the values returned will be the matching values.
So in our example, we would get the following as part of our output:

    "birth_date" : "1947-01-08",
    "first_name" : "David",
    "last_name" : "Bowie",

Unfortunately, these aren't valid keys in the "Person" type, so we need to
use a slightly more complicated version of the C<json_ld_fields> method, one
that enables us to rename fields.

    sub json_ld_fields {
        [
          qw[ first_name last_name],
          { birthDate => 'birth_date' },
        ]
    }

In this version, the last element of the array is a hash reference. The key
in the hash will be used as the key in the JSON-LD and the value is the name
of a method to call. If we make this change, our JSON will look like this:

    "birthDate" : "1947-01-08",
    "first_name" : "David",
    "last_name" : "Bowie",

The C<birthDate> key is now a valid key in the JSON-LD representation of a
person.

But our C<first_name> and C<last_name> keys are still wrong. We could take
the same approach as we did with C<birthDate> and translate them to
C<givenName> and C<familyName>, but what if we want to combine them into the
single C<name> key. We can do that by using another version of
C<json_ld_fields> where the value of the definition hash is a subroutine
reference. That subroutine is called, passing it the object, so it can build
anything you want. We can use that to get the full name of our person.

    sub json_ld_fields {
        [
          { birthDate => 'birth_date'},
          { name => sub{ $_[0]-> first_name . ' ' . $_[0]->last_name} },
        ]
      }

That configuration will give us the following output:

    "birthDate" : "1974-01-08",
    "name" : "David Bowie",

To summarise, the C<json_ld_fields> subroutine should return an array
reference. Each element of the array is either a string or a hash reference.
If it is a string, that string is used as both the key in the JSON-LD and
the method to call on an object to get the value. If the array contains
a hash reference, then the hash key is used in the JSON-LD and the hash value
is either a string, which is the name of the method to call on an object to
get the value, or a code reference which is called (passing in the object)
and which is expected to return the value to use in the JSON-LD.

=head2 Other contexts

By default, this role uses the URL L<https://schema.org>, but you can change
this. This role adds an attribute (called C<context>) which can be used to
change the context.

=cut

package MooX::Role::JSON_LD;

use 5.6.0;

use Moo::Role;

use Carp;
use JSON::MaybeXS;
use MRO::Compat;
use Types::Standard qw[ArrayRef HashRef InstanceOf Str is_CodeRef is_HashRef
  is_ArrayRef is_Ref is_Object];

our $VERSION = '2.1.0';

requires qw[json_ld_type json_ld_fields];

has json_ld_encoder => (
  isa => InstanceOf[ qw/ Cpanel::JSON::XS JSON JSON::PP JSON::XS /],
  is  => 'lazy',
  builder => '_build_json_ld_encoder',
);

sub _build_json_ld_encoder {
    my ($self) = @_;
    return $self->maybe::next::method ||
      JSON->new->canonical->utf8->space_after->indent->pretty->convert_blessed;
};

has context => (
  isa => Str | HashRef | ArrayRef,
  is  => 'lazy',
  builder => '_build_context',
);

sub _build_context {
  return 'https://schema.org/';
}

sub _resolve_nested {
    my ($val) = @_;

    if (is_ArrayRef($val)) {
      return [
	      map { is_Object($_) && $_->can('json_ld_data')
          ? $_->json_ld_data
          : $_; } @$val
        ];
    }

    is_Object($val) && $val->can('json_ld_data')
        ? $val->json_ld_data
        : $val;
}

sub process_hash {
  my $self = shift;
  my ($data, $field) = @_;

  my @keys = keys %$field;
  my @vals = values %$field;

  # Originally, this code used 'each', but there seemed
  # to be some circumstances where the internal iterator
  # got confused - particularly when an object contained
  # a sub-object of the same type.
  for my $x (0 .. $#keys) {
    my $key = $keys[$x];
    my $val = $vals[$x];

    if (defined (my $res = is_CodeRef($val)
                   ? $val->($self)
                   : $self->$val)) {
        $data->{$key} = _resolve_nested($res);
    }
  }
}

sub json_ld_data {
  my $self = shift;

  # We need to know if there's another call to json_ld_data somewhere
  # in the call stack. If there is, we're not the top-level object and
  # we should omit the @context;

  my $already_in_stack = 0;
  my $this_sub = (caller(0))[3];
  my $i = 1;

  while (my @call = caller $i++) {
    if ($call[3] eq $this_sub) {
      $already_in_stack = 1;
      last;
    }
  }

  my $data = {
    '@type'    => $self->json_ld_type,
  };

  $data->{'@context'} = $self->context unless $already_in_stack;

  foreach my $field (@{$self->json_ld_fields}) {

    if (is_Ref($field)) {

      if (is_HashRef($field)) {
        $self->process_hash($data, $field);
      } else {
        carp "Weird JSON-LD reference: " . ref $field;
        next;
      }

    }
    else {

      if (defined (my $res = $self->$field)) {
        $data->{$field} = _resolve_nested($res);
      }

    }

  }

  return $data;
}

sub json_ld {
  my $self = shift;

  return $self->json_ld_encoder->encode($self->json_ld_data);
}

sub json_ld_wrapped {
  my $self = shift;

  return qq[<script type="application/ld+json">\n]
    . $self->json_ld . "\n"
    . qq[</script>\n];
}

1;

=head1 METHODS

This role adds three methods to your class. You can call these methods to
output the object's JSON-LD in various formats.

=over 4

=item json_ld_data

Returns a Perl data structure containing the data that will be encoded into
JSON.

=item json_ld

Returns the data from C<json_ld_data> encoded into JSON.

=item json_ld_wrapped

Returns the JSON string from C<json_ld> wrapped in the
C<< <script> .. </script> >> element you will usually need in order to
embed the JSON in an HTML document.

=back

=head1 AUTHOR

Dave Cross <[e-mail]>

=head1 SEE ALSO

perl(1), Moo, Moose, L<https://json-ld.org/>, L<https://schema.org/>

L<MooX::JSON_LD> is included in this distribution and provides an alternative
interface to the same functionality.

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2018, Magnum Solutions Ltd.  All Rights Reserved.

This script is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut