Source

p5-web-id / lib / Web / ID / SAN / URI.pm

Full commit
package Web::ID::SAN::URI;

use 5.010;
use utf8;

BEGIN {
	$Web::ID::SAN::URI::AUTHORITY = 'cpan:TOBYINK';
	$Web::ID::SAN::URI::VERSION   = '1.924_02';
}

use Web::ID::Types -types;
use Web::ID::Util;

use Moose;
use namespace::sweep;
extends 'Web::ID::SAN';

has '+type' => (default => 'uniformResourceIdentifier');

override uri_object => sub
{
	my ($self) = @_;
	return Uri->new($self->value);
};

around _build_model => sub
{
	my ($orig, $self) = @_;
	my $model = $self->$orig;
	return get_trine_model($self->value => $model);
};

around associated_keys => sub
{
	my ($orig, $self) = @_;
	my @keys = $self->$orig;
	
	my $results = $self->_query->execute( $self->model );
	RESULT: while (my $result = $results->next)
	{
		# trim any whitespace around modulus
		# (HACK for MyProfile WebIDs)
		# Should probably be in ::Util.
		$result->{modulus}->[0] =~ s/(^\s+)|(\s+$)//g;
		
		my $modulus = make_bigint_from_node(
			$result->{modulus},
			fallback      => $result->{hexModulus},
			fallback_type =>'hex',
		);
		my $exponent = make_bigint_from_node(
			$result->{exponent},
			fallback      => $result->{decExponent},
			fallback_type =>'dec',
		);
		
		my $key = $self->key_factory->(
			modulus  => $modulus,
			exponent => $exponent,
			);
		push @keys, $key if $key;
	}
	
	return @keys;
};

sub _query
{
	my ($self) = @_;
	return "RDF::Query"->new( sprintf(<<'SPARQL', (($self->uri_object)x4)) );
PREFIX cert: <http://www.w3.org/ns/auth/cert#>
PREFIX rsa: <http://www.w3.org/ns/auth/rsa#>
SELECT
	?modulus
	?exponent
	?decExponent
	?hexModulus
WHERE
{
	{
		?key
			cert:identity <%s> ;
			rsa:modulus ?modulus ;
			rsa:public_exponent ?exponent .
	}
	UNION
	{
		<%s> cert:key ?key .
		?key
			rsa:modulus ?modulus ;
			rsa:public_exponent ?exponent .
	}
	UNION
	{
		?key
			cert:identity <%s> ;
			cert:modulus ?modulus ;
			cert:exponent ?exponent .
	}
	UNION
	{
		<%s> cert:key ?key .
		?key
			cert:modulus ?modulus ;
			cert:exponent ?exponent .
	}
	OPTIONAL { ?modulus cert:hex ?hexModulus . }
	OPTIONAL { ?exponent cert:decimal ?decExponent . }
}
SPARQL
}

__PACKAGE__
__END__

=head1 NAME

Web::ID::SAN::URI - represents subjectAltNames that are URIs

=head1 DESCRIPTION

subjectAltNames such as these are the foundation of the whole WebID idea.

=head1 BUGS

Please report any bugs to
L<http://rt.cpan.org/Dist/Display.html?Queue=Web-ID>.

=head1 SEE ALSO

L<Web::ID>,
L<Web::ID::SAN>.

=head1 AUTHOR

Toby Inkster E<lt>tobyink@cpan.orgE<gt>.

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2012 by Toby Inkster.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=head1 DISCLAIMER OF WARRANTIES

THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.