File Coverage

blib/lib/Net/SAML2/Role/ProtocolMessage.pm
Criterion Covered Total %
statement 30 31 96.7
branch 1 2 50.0
condition n/a
subroutine 11 11 100.0
pod 1 1 100.0
total 43 45 95.5


line stmt bran cond sub pod time code
1 25     25   14899 use strict;
  25         74  
  25         738  
2 25     25   129 use warnings;
  25         53  
  25         1191  
3             package Net::SAML2::Role::ProtocolMessage;
4             our $VERSION = '0.72'; # TRIAL VERSION
5              
6 25     25   9110 use Moose::Role;
  25         108961  
  25         123  
7              
8             # ABSTRACT: Common behaviour for Protocol messages
9              
10 25     25   128902 use namespace::autoclean;
  25         51  
  25         210  
11              
12 25     25   24387 use DateTime;
  25         10966914  
  25         1237  
13 25     25   241 use MooseX::Types::URI qw/ Uri /;
  25         56  
  25         322  
14 25     25   61588 use Net::SAML2::Util qw(generate_id);
  25         705  
  25         1292  
15 25     25   8421 use Net::SAML2::Types qw(XsdID);
  25         80  
  25         110  
16              
17              
18             has id => (
19             isa => XsdID,
20             is => 'ro',
21             builder => "_build_id"
22             );
23              
24             has issue_instant => (
25             isa => 'Str',
26             is => 'ro',
27             builder => '_build_issue_instant',
28             );
29              
30             has issuer => (
31             isa => Uri,
32             is => 'rw',
33             required => 1,
34             coerce => 1,
35             );
36              
37             has issuer_namequalifier => (
38             isa => 'Str',
39             is => 'rw',
40             predicate => 'has_issuer_namequalifier',
41             );
42              
43             has issuer_format => (
44             isa => 'Str',
45             is => 'rw',
46             predicate => 'has_issuer_format',
47             );
48              
49             has destination => (
50             isa => Uri,
51             is => 'rw',
52             coerce => 1,
53             predicate => 'has_destination',
54             );
55              
56             sub _build_issue_instant {
57 37     37   71983 return DateTime->now(time_zone => 'UTC')->strftime('%FT%TZ');
58             }
59              
60             sub _build_id {
61 13     13   79 return generate_id();
62             }
63              
64              
65             sub status_uri {
66 2     2 1 5 my ($self, $status) = @_;
67              
68 2         10 my $statuses = {
69             success => 'urn:oasis:names:tc:SAML:2.0:status:Success',
70             requester => 'urn:oasis:names:tc:SAML:2.0:status:Requester',
71             responder => 'urn:oasis:names:tc:SAML:2.0:status:Responder',
72             partial => 'urn:oasis:names:tc:SAML:2.0:status:PartialLogout',
73             };
74              
75 2 50       6 if (exists $statuses->{$status}) {
76 2         15 return $statuses->{$status};
77             }
78              
79 0           return;
80             }
81              
82             1;
83              
84             __END__
85              
86             =pod
87              
88             =encoding UTF-8
89              
90             =head1 NAME
91              
92             Net::SAML2::Role::ProtocolMessage - Common behaviour for Protocol messages
93              
94             =head1 VERSION
95              
96             version 0.72
97              
98             =head1 DESCRIPTION
99              
100             Provides default ID and timestamp arguments for Protocol classes.
101              
102             Provides a status-URI lookup method for the statuses used by this
103             implementation.
104              
105             =head1 NAME
106              
107             Net::SAML2::Role::ProtocolMessage - the SAML2 ProtocolMessage Role object
108              
109             =head1 CONSTRUCTOR ARGUMENTS
110              
111             =over
112              
113             =item B<issuer>
114              
115             URI of issuer
116              
117             =item B<issuer_namequalifier>
118              
119             NameQualifier attribute for Issuer
120              
121             =item B<issuer_format>
122              
123             Format attribute for Issuer
124              
125             =item B<destination>
126              
127             URI of Destination
128              
129             =back
130              
131             =head1 METHODS
132              
133             =head2 status_uri( $status )
134              
135             Provides a mapping from short names for statuses to the full status URIs.
136              
137             Legal short names for B<$status> are:
138              
139             =over
140              
141             =item C<success>
142              
143             =item C<requester>
144              
145             =item C<responder>
146              
147             =back
148              
149             =head1 AUTHORS
150              
151             =over 4
152              
153             =item *
154              
155             Chris Andrews <chrisa@cpan.org>
156              
157             =item *
158              
159             Timothy Legge <timlegge@gmail.com>
160              
161             =back
162              
163             =head1 COPYRIGHT AND LICENSE
164              
165             This software is copyright (c) 2023 by Venda Ltd, see the CONTRIBUTORS file for others.
166              
167             This is free software; you can redistribute it and/or modify it under
168             the same terms as the Perl 5 programming language system itself.
169              
170             =cut