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
|
|
|
|
|
|
|
|