view release on metacpan or  search on metacpan

lib/JSON/Hyper.pm  view on Meta::CPAN

package JSON::Hyper;

use 5.008;
use strict;

use JSON::Hyper::Link;

use Carp;
use JSON;
use JSON::Path;
use LWP::UserAgent;
use Scalar::Util qw[blessed];
use Storable qw[dclone];
use URI;
use URI::Escape qw[uri_unescape];

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.011';
our $DEBUG     = 0;

sub json_ref
{
	return {
		description => 'A hyper schema for the JSON referencing convention',
		links       => [
			{
				href => '{id}',
				link => 'self',
			},
			{
				href => '{$ref}',
				link => 'full',
			},
			{
				href => '{$schema}',
				link => 'describedby',
			},
		],
		fragmentResolution   => 'dot-delimited',
		additionalProperties => { '$ref' => '#' },
	};
}

sub new
{
	my ($class, $schema) = @_;
	$schema ||= json_ref();
	$schema = from_json($schema) unless ref $schema;
	return bless { schema => $schema, ua => undef } => $class;
}

sub schema
{
	my ($self) = @_;
	return $self->{'schema'};
}

sub ua
{
	my $self = shift;
	$self = {} unless blessed($self);
	
	if (@_)
	{
		my $rv = $self->{'ua'};
		$self->{'ua'} = shift;
		croak "Set UA to something that is not an LWP::UserAgent!"
			unless blessed $self->{'ua'} && $self->{'ua'}->isa('LWP::UserAgent');
		return $rv;
	}
	unless (blessed $self->{'ua'} and $self->{'ua'}->isa('LWP::UserAgent'))
	{
		$self->{'ua'} = 'LWP::UserAgent'->new(
			agent=>sprintf('%s/%s ', __PACKAGE__, $VERSION)
		);
		$self->{'ua'}->default_header(
			'Accept'=>'application/json, application/schema+json',
		);
	}
	return $self->{'ua'};
}

sub find_links
{
	my ($self, $node, $base) = @_;
	
	$node = from_json($node) unless ref $node;
	return unless ref $node eq 'HASH';
	my @rv;
	
	foreach my $link (@{ $self->schema->{links} })
	{
		my $missing = 0;
		my $href = $link->{href};
		$href =~ s/\{(.+?)\}/if (exists $node->{$1}) { $node->{$1}; } else { $missing++; ''; }/gex;
		
		if (!$missing)
		{
			$href = $self->_resolve_relative_ref($href, $base) if defined $base;
			
			push @rv, 'JSON::Hyper::Link'->new({
				href         => $href,
				rel          => ($link->{'rel'} || $link->{'link'}),
				targetSchema => $link->{'targetSchema'},
				method       => $link->{'method'},
				enctype      => $link->{'enctype'},
				schema       => $link->{'schema'},
				properties   => $link->{'properties'},
			});