Prototype for format registry

format-registry-prototype.pl

BEGIN {
	package RDF::Trine::Types::X;
	$INC{'RDF/Trine/Types/X.pm'} = __FILE__;
	use MooseX::Types -declare => ['TrineFormat'];
	use MooseX::Types::Moose qw[Str];
	class_type TrineFormat, { class => 'RDF::Trine::Format' };
	coerce TrineFormat,
		from Str,
		via  { 'RDF::Trine::FormatRegistry'->instance->find_format($_) };
}

use 5.010;
use lib '/home/tai/perl5/cpan_gwilliams/perlrdf/RDF-Trine/lib';
use MooseX::DeclareX
	keywords => [qw( class role exception )],
	plugins  => [qw( try catch method before after around override guard build std_constants )],
	types    => [
		-Moose                 => [ -all ],
		'RDF::Trine::Types'    => [ -all ],
		'RDF::Trine::Types::X' => [ -all ],
	]
;

class RDF::Trine::Format
{	
	has name => (
		is        => read_only,
		isa       => Str,
		predicate => '_has_name',
	);
	
	build name { $self->names->[0] }
	
	has names => (
		is        => read_only,
		isa       => ArrayRef[ Str ],
	);

	build names { $self->_has_name ? [ $self->name ] : [] }
	
	has format_uri => (
		is        => read_only,
		isa       => UriStr,
		required  => true,
	);
	
	has media_types => (
		is        => read_only,
		isa       => ArrayRef[ Str ],
		traits    => ['Array'],
		handles   => {
			add_media_type  => 'push',
			all_media_types => 'elements',
		},
	);

	method handles_media_type (Str $mt) {
		!!( grep { lc($mt) eq lc($_) } $self->all_media_types )
	}

	has extensions => (
		is        => read_only,
		isa       => ArrayRef[ Str ],
		traits    => ['Array'],
		handles   => {
			add_extension  => 'push',
			all_extensions => 'elements',
		},
	);

	has magic_numbers => (
		is        => read_only,
		isa       => Any,
	);
	
	has [qw/ triples quads result_sets booleans /] => (
		is        => read_only,
		isa       => Bool,
		default   => false,
	);
	
	method matches_opts (HashRef $opt) {
		my %opts = %$opt;
		while (my ($k, $v) = each %opts)
		{
			return false if $v && !$self->$k;
		}
		return true;
	}

	has [qw/ parsers serializers /] => (  # ?? validators ??
		is        => read_only,
		isa       => ArrayRef[ ClassName ],
		default   => sub { [] },
	);
	
	method register_parser (ClassName $p) {
		return if grep { $_ eq $p } @{ $self->parsers };
		push @{ $self->parsers }, $p;
	}

	method register_serializer (ClassName $p) {
		return if grep { $_ eq $p } @{ $self->serializer };
		push @{ $self->serializer }, $p;
	}
}

class RDF::Trine::FormatRegistry
{
	use MooseX::ClassAttribute;
	
	class_has instance => (
		is      => read_only,
		isa     => Object,
		default => sub { __PACKAGE__->new },
	);
	
	has formats => (
		is      => read_only,
		isa     => ArrayRef[ TrineFormat ],
		traits  => ['Array'],
		handles => {
			all_formats     => 'elements',
			filter_formats  => 'grep',
			_add_format     => 'push',
		},
	);
	
	method register_format (TrineFormat $f) {
		my @existing = $self->filter_formats(sub { $_->format_uri eq $f->format_uri });
		$self->_add_format($f) unless @existing;
		push @existing, $f;
		return $existing[0];
	}
	
	method find_format (Str $key, HashRef $opts?) {
		$opts //= {};
		$self->find_format_by_uri($key, $opts)         or
		$self->find_format_by_media_type($key, $opts)  or
		$self->find_format_by_name($key, $opts)
	}
	
	method find_format_by_uri (UriStr $u, HashRef $opts?) {
		$opts //= {};
		my @f = $self->filter_formats(sub {
			my $f = $_;
			$f->format_uri eq $u and $f->matches_opts($opts)
		});
		return unless @f;
		return(wantarray ? @f : $f[0]);
	}
	
	method find_format_by_media_type (Str $mt, HashRef $opts?) {
		$opts //= {};
		my @f = $self->filter_formats(sub {
			my $f = $_;
			$f->handles_media_type($mt) and $f->matches_opts($opts)
		});
		return unless @f;
		return(wantarray ? @f : $f[0]);
	}

	method find_format_by_name (Str $n, HashRef $opts?) {
		$opts //= {};
		my @f = $self->filter_formats(sub {
			my $f = $_;
			(grep { $n eq $_ } @{ $f->names }) and $f->matches_opts($opts)
		});
		return unless @f;
		return(wantarray ? @f : $f[0]);
	}

	method find_format_by_capabilities (HashRef $opts?) {
		$opts //= {};
		my @f = $self->filter_formats(sub { $_->matches_opts($opts) });
		return unless @f;
		return(wantarray ? @f : $f[0]);
	}
	

	build formats ($self:) {
		my $fc = 'RDF::Trine::Format';
		[
			$fc->new(
				names         => [qw( RDF/XML RDFXML )],
				format_uri    => 'http://www.w3.org/ns/formats/RDF_XML',
				media_types   => [qw( application/rdf+xml application/octet-stream )],
				extensions    => [qw( rdf xrdf rdfx )],
				magic_numbers => [qr{ <rdf:RDF }x],
				triples       => true,
			),
			$fc->new(
				names         => [qw( Turtle )],
				format_uri    => 'http://www.w3.org/ns/formats/Turtle',
				media_types   => [qw( text/turtle application/turtle application/x-turtle )],
				extensions    => [qw( ttl turtle )],
				magic_numbers => [qr{ \@prefix }x, qr{ \@base }x],
				triples       => true,
			),
			$fc->new(
				names         => [qw( N-Triples NTriples )],
				format_uri    => 'http://www.w3.org/ns/formats/N-Triples',
				media_types   => [qw( text/plain )],
				extensions    => [qw( nt )],
				triples       => true,
			),
			$fc->new(
				names         => [qw( XHTML+RDFa RDFa )],
				format_uri    => 'http://www.w3.org/ns/formats/RDFa',
				media_types   => [qw( application/xhtml+xml )],
				extensions    => [qw( xhtml )],
				magic_numbers => [qr{ xmlns="http://www\.w3\.org/1999/xhtml" }x],
				triples       => true,
			),
			$fc->new(
				names         => [qw( HTML+RDFa )],
				format_uri    => 'tag:cpan.org,2012:tobyink:format:HTMLRDFa',
				media_types   => [qw( text/html )],
				extensions    => [qw( html )],
				triples       => true,
			),
			$fc->new(
				names         => [qw( RDF/JSON RDFJSON )],
				format_uri    => 'tag:cpan.org,2012:tobyink:format:RDFJSON',
				media_types   => [qw( application/x-rdf+json )],
				extensions    => [qw( json )],
				triples       => true,
			),
			$fc->new(
				names         => [qw( TriG )],
				format_uri    => 'tag:cpan.org,2012:tobyink:format:TriG',
				media_types   => [qw( application/x-trig )],
				extensions    => [qw( trig )],
				triples       => true,
				quads         => true,
			),
			$fc->new(
				names         => [qw( N-Quads NQuads )],
				format_uri    => 'http://sw.deri.org/2008/07/n-quads/#n-quads',
				media_types   => [qw( text/x-nquads )],
				extensions    => [qw( nq )],
				triples       => true,
				quads         => true,
			),
			$fc->new(
				names         => ['OWL Functional Syntax', qw( OwlFn )],
				format_uri    => 'http://www.w3.org/ns/formats/OWL_Functional',
				media_types   => [qw( text/x-nquads )],
				extensions    => [qw( nq )],
				triples       => true,
				quads         => true,
			),
			$fc->new(
				names         => ['OWL Functional Syntax', qw( OwlFn )],
				format_uri    => 'http://www.w3.org/ns/formats/OWL_Functional',
				media_types   => [qw( text/owl-functional )],
				extensions    => [qw( ofn )],
				triples       => true,
			),
			$fc->new(
				names         => ['OWL XML', qw( OWLXML )],
				format_uri    => 'http://www.w3.org/ns/formats/OWL_XML',
				media_types   => [qw( application/owl+xml )],
				extensions    => [qw( owx owlx )],
				magic_numbers => [qr{ xmlns="http://www\.w3\.org/2002/07/owl#" }x],
				triples       => true,
			),
			$fc->new(
				names         => ['SPARQL Results in XML'],
				format_uri    => 'http://www.w3.org/ns/formats/SPARQL_Results_XML',
				media_types   => [qw( application/sparql-results+xml )],
				extensions    => [qw( srx xml )],
				magic_numbers => [qr{ xmlns="http://www\.w3\.org/2005/sparql-results#" }x],
				triples       => true,
				quads         => true,
				result_sets   => true,
				booleans      => true,
			),
			$fc->new(
				names         => ['SPARQL Results in JSON'],
				format_uri    => 'http://www.w3.org/ns/formats/SPARQL_Results_JSON',
				media_types   => [qw( application/sparql-results+json )],
				extensions    => [qw( srj )],
				triples       => true,
				quads         => true,
				result_sets   => true,
				booleans      => true,
			),
			$fc->new(
				names         => ['SPARQL Results in CSV'],
				format_uri    => 'http://www.w3.org/ns/formats/SPARQL_Results_CSV',
				media_types   => [qw( text/csv )],
				extensions    => [qw( csv )],
				triples       => true,
				quads         => true,
				result_sets   => true,
				booleans      => true,
			),
			$fc->new(
				names         => ['SPARQL Results in TSV'],
				format_uri    => 'http://www.w3.org/ns/formats/SPARQL_Results_TSV',
				media_types   => [qw( text/tab-separated-values )],
				extensions    => [qw( tsv tab )],
				triples       => true,
				quads         => true,
				result_sets   => true,
				booleans      => true,
			),
		],
	}	
}

role RDF::Trine::API::Capabilities
{
	requires qw(
		speed
		is_pure_perl
	);
}

role RDF::Trine::Serializer::API
	with RDF::Trine::API::Capabilities
{
	requires qw(
		serialize_iterator_to_file
	);
}

role RDF::Trine::Parser::API
	with RDF::Trine::API::Capabilities
{
	requires qw(
		parse
	);
}

class Example::Parser
	with RDF::Trine::Parser::API::Capabilities
{
	sub speed { 90 }
	
	RDF::Trine::FormatRegistry
		-> instance
		-> find_format('RDFXML')
		-> register_parser(__PACKAGE__);
}

class Example::Parser2
	with RDF::Trine::Parser::API::Capabilities
{
	sub speed { 50 }
	
	RDF::Trine::FormatRegistry
		-> instance
		-> find_format('RDFXML')
		-> register_parser(__PACKAGE__);
}

package main
{
	use RDF::Trine::Types::X qw(TrineFormat);
	
	my $xml_parsers = TrineFormat->coerce('application/rdf+xml')->parsers;	
	my ($fastest)   = reverse sort { $a->speed <=> $b->speed } @{ $xml_parsers };
	
	say "Fastest RDF/XML parser: ", $fastest;
	
	my @quad_formats = RDF::Trine::FormatRegistry->instance->find_format_by_capabilities({ quads => 1 });
	say "Quad formats: ", map { '['.$_->name.']' } @quad_formats;
}