Commits

Toby Inkster committed 5c61305

Significantly cleaned up JSON schema stuff - "just" needs documentation.

  • Participants

Comments (0)

Files changed (7)

+#############################################################
+
+@prefix :        <http://usefulinc.com/ns/doap#> .
+@prefix dcs:     <http://ontologi.es/doap-changeset#> .
+@prefix dc:      <http://purl.org/dc/terms/> .
+@prefix foaf:    <http://xmlns.com/foaf/0.1/> .
+@prefix my:      <http://purl.org/NET/cpan-uri/dist/Example-Example/> .
+@prefix rdfs:    <http://www.w3.org/2000/01/rdf-schema#> .
+@prefix toby:    <http://tobyinkster.co.uk/#> .
+@prefix xsd:     <http://www.w3.org/2001/XMLSchema#> .
+
+#############################################################
+
+<>
+
+	dc:title         "Changes" ;
+	dc:description   "Revision history for Perl extension Example::Example."@en ;
+	dc:subject       my:project ;
+	dc:creator       toby:i .
+
+#############################################################
+
+my:v_0-01
+
+	a               :Version ;
+	dc:issued       "2000-01-01"^^xsd:date ;
+	:revision       "0.01"^^xsd:string ;
+	:file-release   <http://backpan.cpan.org/authors/id/T/TO/TOBYINK/Example-Example-0.01.tar.gz> ;
+	rdfs:comment    "Original version"@en .
+
+#############################################################
+
+my:project
+
+	a               :Project ;
+	:name           "Example-Example" ;
+	:shortdesc      "Example Project"@en ;
+	:programming-language  "Perl" ;
+	:homepage       <http://search.cpan.org/dist/Example-Example/> ;
+	:download-page  <http://search.cpan.org/dist/Example-Example/> ;
+	:bug-database   <http://rt.cpan.org/Dist/Display.html?Queue=Example-Example> ;
+	:repository     [ a :SVNRepository ; :browse <http://goddamn.co.uk/viewvc/perlmods/Example-Example/> ] ;
+	:maintainer     toby:i ;
+	:developer      toby:i ;
+	:documenter     toby:i ;
+	:tester         toby:i ;
+	:created        "2000-01-01"^^xsd:date ;
+	:license        <http://dev.perl.org/licenses/> ;
+	:release        my:v_0-01 .
+
+#############################################################
+
+toby:i
+
+	a               foaf:Person ;
+	foaf:name       "Toby Inkster" ;
+	foaf:homepage   <http://tobyinkster.co.uk/> ;
+	foaf:page       <http://search.cpan.org/~tobyink/> ;
+	foaf:mbox       <mailto:tobyink@cpan.org> ;
+	<http://www.w3.org/2002/07/owl#sameAs> <http://purl.org/NET/cpan-uri/person/tobyink> .
+
+#############################################################
+Changes
+Changes.ttl
+Changes.xml
+Makefile.PL
+MANIFEST
+MANIFEST.SKIP
+README
+META.yml
+SIGNATURE
+
+t/00sig.t
+t/01basic.t

File MANIFEST.SKIP

+^Makefile$
+^blib/
+^pm_to_blib
+^blibdirs
+\.svn
+^example.*\.pl$
+^[^/]+\.(tar\.gz|tar\.bz2|tgz|tbz2|tbz|zip|tar)$
+^MYMETA..yml
+use strict;
+use warnings;
+
+use inc::Module::Install;
+
+my $dist = 'Example-Example';
+my $fn   = "lib/$dist.pm"; $fn =~ s#-#/#g;
+
+name                $dist;
+perl_version_from   $fn;
+version_from        $fn;
+abstract_from       $fn;
+readme_from         $fn;
+author              'Toby Inkster <tobyink@cpan.org>';
+license             'perl';
+
+test_requires       'Test::More' => '0.61';
+
+requires            'Carp'               => '1.00';
+requires            'DateTime'           => 0;
+requires            'RDF::Trine'         => '0.112';
+requires            'XML::LibXML'        => '1.60';
+requires            'URI'                => '1.30';
+
+# install_script 'fingerw';
+
+resources(
+	'homepage'   => "http://search.cpan.org/dist/$dist/",
+	'repository' => "http://goddamn.co.uk/viewvc/perlmods/$dist/",
+	'bugtracker' => "http://rt.cpan.org/Dist/Display.html?Queue=$dist",
+	);
+	
+write_doap_changes;
+write_doap_changes_xml;
+
+include 'Test::Signature';
+auto_install;
+WriteAll(
+	'meta' => 1,
+	'sign' => 1,
+	);

File lib/JSON/Hyper.pm

+package JSON::Hyper;
+
+use 5.008;
+use common::sense;
+
+use Carp;
+use JSON;
+use JSON::Path;
+use Scalar::Util qw[blessed];
+use Storable qw[dclone];
+
+our $VERSION = '0.001';
+
+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 => 'definedby"',
+			},
+		],
+		fragmentResolution   => "dot-delimited",
+		additionalProperties => { '$ref' => '#' },
+		};
+}
+
+sub new
+{
+	my ($class, $schema) = @_;
+	$schema ||= &json_ref;
+	return bless {schema=>$schema, ua=>undef}, $class;
+}
+
+sub schema
+{
+	my ($self) = @_;
+	return $self->{'schema'};
+}
+
+sub ua
+{
+	my $self = shift;
+	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'} && $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) = @_;
+	return unless ref $node eq 'HASH';
+	my @rv;
+	
+	foreach my $link (@{ $self->schema->{links} })
+	{
+		my ($start, $property, $end)
+			= ($link->{href} =~ /^(.*)\{(.+)\}(.*)$/);
+		
+		if (defined $node->{$property})
+		{
+			push @rv, {
+				href     => $start.$node->{$property}.$end,
+				rel      => ($link->{'rel'} || $link->{'link'}),
+				property => $property,
+				};
+		}
+	}
+	
+	return @rv;
+}
+
+sub process_includes
+{
+	my ($self, $original) = @_;
+	my $object = dclone($original);
+	$self->_process_includes($object);
+	return $object;
+}
+
+sub _process_includes
+{
+	my ($self, $object) = @_;
+	
+	my @links = $self->find_links($object);
+	my $full;
+	foreach my $link (@links)
+	{
+		if (lc $link->{rel} eq 'full')
+		{
+			$full = $link;
+			last;
+		}
+	}
+	
+	if (defined $full)
+	{
+		my ($substitute) = $self->get($full->{'href'});
+		delete $object->{ $full->{'property'} };
+		while (my($k,$v) = each %$substitute)
+		{
+			$object->{$k} = dclone($v);
+		}
+	}
+	elsif (ref $object eq 'ARRAY')
+	{
+		foreach my $i (@$object)
+		{
+			$self->_process_includes($i);
+		}
+	}
+	elsif (ref $object eq 'HASH')
+	{
+		foreach my $i (values %$object)
+		{
+			$self->_process_includes($i);
+		}
+	}
+}
+
+sub get
+{
+	my ($self, $uri) = @_;
+	my ($resource, $fragment) = split /\#/, $uri, 2;
+	
+	my $response = $self->ua->get($resource);
+	return unless $response->is_success;
+	
+	my $object = from_json( $response->decoded_content );
+	return $self->resolve_fragment($object, $fragment);
+}
+
+sub resolve_fragment
+{
+	my ($self, $object, $fragment) = @_;
+	my $style = $self->schema->{fragmentResolution} || 'slash-delimited';
+	
+	if ($style =~ /^(json.?)?path$/i)
+	{
+		my $jsonp   = JSON::Path->new($fragment);
+		my @matches = $jsonp->values($object);
+		return @matches;
+	}
+	
+	my ($first, $rest);
+	if (lc $style eq 'dot-delimited')
+	{
+		($first, $rest) = split /\./, $fragment, 2;
+	}
+	elsif (lc $style eq 'slash-delimited')
+	{
+		($first, $rest) = split /\//, $fragment, 2;
+	}
+	else
+	{
+		carp "Unknown fragment resolution method: $style";
+		return;
+	}
+
+	my $value;
+	if (ref $object eq 'HASH')
+	{
+		$value = $object->{$first};
+	}
+	elsif (ref $object eq 'ARRAY' and $first =~ /^[\-\+]?[0-9]+$/)
+	{
+		$value = $object->[$first];
+	}
+	
+	unless (defined $value)
+	{
+		return;
+	}
+	
+	if (length $rest)
+	{
+		return $self->resolve_fragment($value, $rest);
+	}
+	else
+	{
+		return ($value);
+	}
+}
+
+1;
+use lib 'inc';
+use Test::More tests => 1;
+use Test::Signature;
+signature_ok();
+use Test::More tests => 1;
+BEGIN { use_ok('Example::Example') };
+