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, L<< labels the link with a human-readable
identifier|http://tools.ietf.org/html/draft-kelly-json-hal#section-5.7 >>
=head3 C
Type C,
L<< indicates the language of the target resource|http://tools.ietf.org/html/draft-kelly-json-hal#section-5.8 >>
=head2 Methods
=head3 C
Returns the link as a L<< RFC 5988 C|http://tools.ietf.org/html/rfc5988#section-5 >> string, e.g.
C<< ;rel="next" >>.
=head2 Exports
None.
=head1 DIAGNOSTICS
See L constructor.
=head1 CONFIGURATION AND ENVIRONMENT
Requires no configuration files or environment variables.
=head1 AUTHOR
Lars Dɪᴇᴄᴋᴏᴡ C<< >>
=head1 LICENSE
Copyright © 2013 Lars Dɪᴇᴄᴋᴏᴡ C<< >>
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl 5.18.0.