package Web::ID::SAN::URI; use 5.010; use utf8; BEGIN { $Web::ID::SAN::URI::AUTHORITY = 'cpan:TOBYINK'; $Web::ID::SAN::URI::VERSION = '1.921'; } use Any::Moose 'X::Types::Moose' => [':all']; use Web::ID::Types ':all'; use Web::ID::Util; use Any::Moose; use namespace::clean -except => 'meta'; 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: PREFIX 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. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =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.