| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package OpenID::Lite::RelyingParty::Discover::Service::Builder; |
|
2
|
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
6
|
use Any::Moose; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
544
|
use List::MoreUtils qw(any); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
61
|
|
|
6
|
1
|
|
|
1
|
|
6
|
use OpenID::Lite::RelyingParty::Discover::Service; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
7
|
|
|
7
|
1
|
|
|
|
|
746
|
use OpenID::Lite::Constants::Namespace qw( |
|
8
|
|
|
|
|
|
|
SIGNON_2_0 |
|
9
|
|
|
|
|
|
|
SIGNON_1_1 |
|
10
|
|
|
|
|
|
|
SIGNON_1_0 |
|
11
|
|
|
|
|
|
|
SERVER_2_0 |
|
12
|
|
|
|
|
|
|
XRD_2_0 |
|
13
|
|
|
|
|
|
|
SPEC_1_0 |
|
14
|
1
|
|
|
1
|
|
29
|
); |
|
|
1
|
|
|
|
|
2
|
|
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
has 'claimed_identifier' => ( |
|
17
|
|
|
|
|
|
|
is => 'rw', |
|
18
|
|
|
|
|
|
|
isa => 'Str', |
|
19
|
|
|
|
|
|
|
required => 1, |
|
20
|
|
|
|
|
|
|
); |
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub build_services { |
|
23
|
0
|
|
|
0
|
0
|
|
my ( $self, $xrd ) = @_; |
|
24
|
0
|
|
|
|
|
|
my @service_nodes = $xrd->findnodes(q{*[local-name()='Service']}); |
|
25
|
0
|
|
|
|
|
|
my @services; |
|
26
|
0
|
|
|
|
|
|
for my $service_elem (@service_nodes) { |
|
27
|
0
|
0
|
|
|
|
|
my $service = $self->build_service($service_elem) |
|
28
|
|
|
|
|
|
|
or next; |
|
29
|
0
|
|
|
|
|
|
push @services, $service; |
|
30
|
|
|
|
|
|
|
} |
|
31
|
0
|
|
|
|
|
|
return \@services; |
|
32
|
|
|
|
|
|
|
} |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub build_service { |
|
35
|
0
|
|
|
0
|
0
|
|
my ( $self, $service_elem ) = @_; |
|
36
|
|
|
|
|
|
|
|
|
37
|
0
|
|
|
|
|
|
my @uri_nodes = $service_elem->findnodes(q{*[local-name()='URI']}); |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# Schwartzian transform |
|
40
|
0
|
|
|
|
|
|
my @uris = map { $_->[0] } |
|
|
0
|
|
|
|
|
|
|
|
41
|
0
|
|
0
|
|
|
|
sort { $a->[1] <=> $b->[1] } |
|
42
|
|
|
|
|
|
|
map { |
|
43
|
0
|
|
|
|
|
|
[ $_->findvalue(q{text()}), $_->findvalue(q{@priority}) || 100 ] |
|
44
|
|
|
|
|
|
|
} @uri_nodes; |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
#my @uris = map { $_->findvalue(q{text()}) } |
|
47
|
|
|
|
|
|
|
# sort { |
|
48
|
|
|
|
|
|
|
# ( $a->findvalue(q{@priority}) || 100 ) |
|
49
|
|
|
|
|
|
|
# <=> ( $b->findvalue(q{@priority}) || 100 ) |
|
50
|
|
|
|
|
|
|
# } @uri_nodes; |
|
51
|
|
|
|
|
|
|
|
|
52
|
0
|
|
|
|
|
|
my @type_nodes = $service_elem->findnodes(q{*[local-name()='Type']}); |
|
53
|
0
|
|
|
|
|
|
my @types = map { $_->findvalue(q{text()}) } @type_nodes; |
|
|
0
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
|
|
55
|
0
|
0
|
0
|
|
|
|
return unless @uris > 0 && @types > 0; |
|
56
|
|
|
|
|
|
|
return |
|
57
|
|
|
|
|
|
|
unless ( |
|
58
|
|
|
|
|
|
|
any { |
|
59
|
0
|
0
|
0
|
0
|
|
|
$_ eq SERVER_2_0 |
|
|
|
|
0
|
|
|
|
|
|
60
|
|
|
|
|
|
|
|| $_ eq SIGNON_2_0 |
|
61
|
|
|
|
|
|
|
|| $_ eq SIGNON_1_1 |
|
62
|
|
|
|
|
|
|
|| $_ eq SIGNON_1_0; |
|
63
|
|
|
|
|
|
|
} |
|
64
|
|
|
|
|
|
|
@types |
|
65
|
0
|
0
|
|
|
|
|
); |
|
66
|
|
|
|
|
|
|
|
|
67
|
0
|
|
|
|
|
|
my $service = OpenID::Lite::RelyingParty::Discover::Service->new; |
|
68
|
0
|
|
|
|
|
|
$service->add_uris(@uris); |
|
69
|
0
|
|
|
|
|
|
$service->add_types(@types); |
|
70
|
|
|
|
|
|
|
|
|
71
|
0
|
0
|
|
|
|
|
unless ( $service->is_op_identifier ) { |
|
72
|
0
|
|
|
|
|
|
$service->claimed_identifier( $self->claimed_identifier ); |
|
73
|
0
|
|
|
|
|
|
my $op_local_identifier; |
|
74
|
0
|
|
|
|
|
|
my $xpath_template |
|
75
|
|
|
|
|
|
|
= q{*[local-name()='%s' and namespace-uri()='%s']/text()}; |
|
76
|
0
|
0
|
|
0
|
|
|
if ( any { $_ eq SIGNON_2_0 } @types ) { |
|
|
0
|
|
|
|
|
|
|
|
77
|
0
|
|
|
|
|
|
$op_local_identifier |
|
78
|
|
|
|
|
|
|
= $service_elem->findvalue( sprintf $xpath_template, |
|
79
|
|
|
|
|
|
|
'LocalID', XRD_2_0 ); |
|
80
|
|
|
|
|
|
|
} |
|
81
|
0
|
0
|
|
0
|
|
|
if ( any { $_ eq SIGNON_1_1 || $_ eq SIGNON_1_0 } @types ) { |
|
|
0
|
0
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
|
$op_local_identifier |
|
83
|
|
|
|
|
|
|
= $service_elem->findvalue( sprintf $xpath_template, |
|
84
|
|
|
|
|
|
|
'Delegate', SPEC_1_0 ); |
|
85
|
|
|
|
|
|
|
} |
|
86
|
|
|
|
|
|
|
|
|
87
|
0
|
0
|
|
|
|
|
$service->op_local_identifier($op_local_identifier) |
|
88
|
|
|
|
|
|
|
if $op_local_identifier; |
|
89
|
|
|
|
|
|
|
} |
|
90
|
0
|
|
|
|
|
|
return $service; |
|
91
|
|
|
|
|
|
|
} |
|
92
|
|
|
|
|
|
|
|
|
93
|
1
|
|
|
1
|
|
7
|
no Any::Moose; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
5
|
|
|
94
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
|
95
|
|
|
|
|
|
|
1; |
|
96
|
|
|
|
|
|
|
|