package Data::HAL::Link; use strictures; use boolean qw(false true); use Data::HAL::URI qw(); use HTTP::Headers::Util qw(join_header_words); use JSON qw(); use Log::Any qw($log); use MIME::Type qw(); use Moo; # has use Safe::Isa qw($_can $_isa); use Types::Standard qw(InstanceOf Str Bool); our $VERSION = '1.000'; my $uri_from_str = sub { my ($val) = @_; return $val->$_isa('Data::HAL::URI') ? $val : Data::HAL::URI->new($val); }; my $boolean_from_perlbool = sub { my ($val) = @_; return $val ? true : false; }; has('relation', is => 'rw', isa => InstanceOf['Data::HAL::URI'], coerce => $uri_from_str, required => 1); has('href', is => 'rw', isa => InstanceOf['Data::HAL::URI'], coerce => $uri_from_str, required => 1); has('templated', is => 'rw', isa => InstanceOf['boolean'], coerce => $boolean_from_perlbool); has('type', is => 'rw', isa => InstanceOf['MIME::Type']); has('deprecation', is => 'rw', isa => InstanceOf['Data::HAL::URI'], coerce => $uri_from_str); has('name', is => 'rw', isa => Str); has('profile', is => 'rw', isa => InstanceOf['Data::HAL::URI'], coerce => $uri_from_str); has('title', is => 'rw', isa => Str); has('hreflang', is => 'rw', isa => Str); has('_forcearray', is => 'rw', isa => Bool, default => 0); #array of link items, even if only one sub BUILD { my ($self) = @_; if ($self->deprecation) { $log->warn(sprintf 'The link (relation: "%s", href: "%s") is deprecated, see <%s>', $self->relation->as_string, $self->href->as_string, $self->deprecation->as_string); } return; } sub _to_nested { my ($self, $root) = @_; my $hal; for my $attr (map { $_->accessor } $self->meta->get_all_attributes) { my $val = $self->$attr; if (defined $val) { $hal->{$attr} = $val->$_can('as_string') ? $val->as_string($root) : $val; } } my $r = delete $hal->{relation}; delete $hal->{_forcearray}; return($hal, $r); } sub as_http_link_value { my ($self) = @_; return if 'curies' eq $self->relation->as_string; return join_header_words( '<'.$self->href->as_string.'>' => undef, rel => $self->relation->as_string, $self->hreflang ? (hreflang => $self->hreflang) : (), $self->title ? (title => $self->title) : (), $self->type ? (type => $self->type) : (), $self->name ? (name => $self->name) : (), $self->profile ? (profile => $self->profile->as_string) : (), ); } 1; __END__ =encoding UTF-8 =head1 NAME Data::HAL::Link - Hypertext Application Language link =head1 VERSION This document describes Data::HAL::Link version 1.000 =head1 SYNOPSIS map { +{ href => $_->href->uri->as_string, rel => $_->relation->uri->as_string } } @{ $resource->links } =head1 DESCRIPTION This section is completely quoted from the specification: A Link Object represents a hyperlink from the containing resource to a URI. =head1 INTERFACE =head2 Composition None. =head2 Constructors =head3 C When the L attribute is set, the constructor logs a L warning: C<< The link (relation: "%s", href: "%s") is deprecated, see <%s> >> You can consume it with a L of your choice, e.g. use Log::Any::Adapter 'Stderr'; Otherwise the constructor behaves like the default L constructor. Returns a C object. =head2 Attributes Perl strings are coerced to the L type in the attributes L, L, L, L. =head3 C Type L, B, L =head3 C Type L, B, L =head3 C Type L, L<< whether C is a URI template|http://tools.ietf.org/html/draft-kelly-json-hal#section-5.2 >> Perl boolean values are coerced to the L type. =head3 C Type L, L<< media type of the C resource|http://tools.ietf.org/html/draft-kelly-json-hal#section-5.3 >> =head3 C Type L, if existing L<< indicates the link is deprecated|http://tools.ietf.org/html/draft-kelly-json-hal#section-5.4 >> Setting the attribute triggers a log message in the constructor L. =head3 C Type C, L<< secondary key for selecting link objects which share the same relation type|http://tools.ietf.org/html/draft-kelly-json-hal#section-5.5 >> =head3 C Type L, L<< RFC 6906 profile of the target resource|http://tools.ietf.org/html/draft-kelly-json-hal#section-5.6 >> =head3 C Type C<Str>, L<< labels the link with a human-readable identifier|http://tools.ietf.org/html/draft-kelly-json-hal#section-5.7 >> =head3 C<hreflang> Type C<Str>, L<< indicates the language of the target resource|http://tools.ietf.org/html/draft-kelly-json-hal#section-5.8 >> =head2 Methods =head3 C<as_http_link_value> Returns the link as a L<< RFC 5988 C<link-value>|http://tools.ietf.org/html/rfc5988#section-5 >> string, e.g. C<< </orders?page=2>;rel="next" >>. =head2 Exports None. =head1 DIAGNOSTICS See L</new> constructor. =head1 CONFIGURATION AND ENVIRONMENT Requires no configuration files or environment variables. =head1 AUTHOR Lars Dɪᴇᴄᴋᴏᴡ C<< <daxim@cpan.org> >> =head1 LICENSE Copyright © 2013 Lars Dɪᴇᴄᴋᴏᴡ C<< <daxim@cpan.org> >> This library is free software; you can redistribute it and/or modify it under the same terms as Perl 5.18.0.