File Coverage

blib/lib/OpenID/Lite/RelyingParty/Discover/Parser/XRI.pm
Criterion Covered Total %
statement 12 46 26.0
branch 0 18 0.0
condition n/a
subroutine 4 7 57.1
pod 0 1 0.0
total 16 72 22.2


line stmt bran cond sub pod time code
1             package OpenID::Lite::RelyingParty::Discover::Parser::XRI;
2              
3 1     1   8 use Any::Moose;
  1         2  
  1         9  
4             with 'OpenID::Lite::Role::Parser';
5             with 'OpenID::Lite::Role::ErrorHandler';
6              
7 1     1   860 use OpenID::Lite::Util::XRI;
  1         3  
  1         12  
8 1     1   24 use OpenID::Lite::RelyingParty::Discover::Service::Builder;
  1         1  
  1         9  
9              
10             sub parse {
11 0     0 0   my ( $self, $result ) = @_;
12              
13 0           my $identifier = $result->normalized_identifier;
14 0           my $doc = $result->xrds;
15              
16             my @xrd
17 0           = $doc->findnodes(q{*[local-name()='XRDS']/*[local-name()='XRD']});
18 0 0         return $self->ERROR( sprintf q{XRD element not found for iname "%s".},
19             $identifier )
20             unless @xrd > 0;
21              
22 0           @xrd = reverse @xrd;
23 0           my $last_xrd = shift @xrd;
24              
25 0 0         my $canonical_id = $self->_get_canonical_id($last_xrd)
26             or return $self->ERROR( sprintf q{No CanonicalID found for XRI "%s".},
27             $identifier );
28              
29 0 0         $self->_validate_canonical_id( \@xrd, $canonical_id, $identifier )
30             or return $self->ERROR( sprintf q{Invalid XRDS for XRI "%s".},
31             $identifier );
32              
33 0           my $builder = OpenID::Lite::RelyingParty::Discover::Service::Builder->new(
34             claimed_identifier => $canonical_id, );
35              
36 0           my $services = $builder->build_services($last_xrd);
37 0           $_->display_identifier($identifier) for @$services;
38 0 0         return $self->ERROR(q{No service found.}) unless @$services > 0;
39 0           return $services;
40             }
41              
42             sub _validate_canonical_id {
43 0     0     my ( $self, $xrd_list, $canonical_id, $iname ) = @_;
44 0           my $child_id = lc $canonical_id;
45 0           for my $xrd ( @$xrd_list ) {
46 0           my $parent_sought = substr($child_id, rindex($child_id, '!'));
47 0           my @cids = $xrd->findnodes(q{*[local-name()='CanonicalID']});
48 0 0         return 0 unless @cids > 0;
49 0           my $cid = $cids[0];
50 0           my $parent
51             = OpenID::Lite::Util::XRI->make_xri( $cid->findvalue(q{text()}) );
52 0 0         return 0 unless $parent;
53 0 0         return 0 if ($parent_sought ne lc $parent);
54 0           $child_id = $parent_sought;
55             }
56              
57 0           my $root = OpenID::Lite::Util::XRI->root_authority($iname);
58 0 0         return 0 unless
59             OpenID::Lite::Util::XRI->provider_is_authoritative($root, $child_id);
60 0           1;
61             }
62              
63             sub _get_canonical_id {
64 0     0     my ( $self, $xrd ) = @_;
65              
66 0           my @cids = $xrd->findnodes(q{*[local-name()='CanonicalID']});
67 0 0         return unless @cids > 0;
68              
69 0           my $cid = $cids[0];
70 0           my $canonical_id
71             = OpenID::Lite::Util::XRI->make_xri( $cid->findvalue(q{text()}) );
72              
73 0           return $canonical_id;
74             }
75              
76 1     1   576 no Any::Moose;
  1         2  
  1         6  
77             __PACKAGE__->meta->make_immutable;
78             1;
79