line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Rich exception object for Net::Duo actions. |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# All Net::Duo APIs throw Net::Duo::Exception objects on any failure, |
4
|
|
|
|
|
|
|
# including internal errors, protocol errors, HTTP errors, and failures |
5
|
|
|
|
|
|
|
# returned by the Duo API. This is a rich exception object that carries all |
6
|
|
|
|
|
|
|
# available details about the failure and can be inspected by the caller to |
7
|
|
|
|
|
|
|
# recover additional information. If the caller doesn't care about the |
8
|
|
|
|
|
|
|
# details, it provides a stringification that is suitable for simple error |
9
|
|
|
|
|
|
|
# messages. |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
# SPDX-License-Identifier: MIT |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
package Net::Duo::Exception 1.02; |
14
|
|
|
|
|
|
|
|
15
|
11
|
|
|
11
|
|
110363
|
use 5.014; |
|
11
|
|
|
|
|
57
|
|
16
|
11
|
|
|
11
|
|
66
|
use strict; |
|
11
|
|
|
|
|
23
|
|
|
11
|
|
|
|
|
229
|
|
17
|
11
|
|
|
11
|
|
68
|
use warnings; |
|
11
|
|
|
|
|
23
|
|
|
11
|
|
|
|
|
345
|
|
18
|
|
|
|
|
|
|
|
19
|
11
|
|
|
11
|
|
65
|
use HTTP::Response; |
|
11
|
|
|
|
|
20
|
|
|
11
|
|
|
|
|
598
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# Enable this object to be treated like a string scalar. |
22
|
11
|
|
|
11
|
|
71
|
use overload '""' => \&to_string, 'cmp' => \&spaceship; |
|
11
|
|
|
|
|
20
|
|
|
11
|
|
|
|
|
149
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
############################################################################## |
25
|
|
|
|
|
|
|
# Constructors |
26
|
|
|
|
|
|
|
############################################################################## |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# Construct an exception from a Duo error reply. If the provided object |
29
|
|
|
|
|
|
|
# does not have a stat key with a value of FAIL, this call will be |
30
|
|
|
|
|
|
|
# converted automatically to a call to protocol(). |
31
|
|
|
|
|
|
|
# |
32
|
|
|
|
|
|
|
# $class - Class of the exception to create |
33
|
|
|
|
|
|
|
# $object - The decoded JSON object representing the error reply |
34
|
|
|
|
|
|
|
# $content - The undecoded content of the server reply |
35
|
|
|
|
|
|
|
# |
36
|
|
|
|
|
|
|
# Returns: Newly-constructed exception |
37
|
|
|
|
|
|
|
sub api { |
38
|
4
|
|
|
4
|
1
|
11
|
my ($class, $object, $content) = @_; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# Ensure that we have a valid stat key. |
41
|
4
|
100
|
|
|
|
18
|
if (!defined($object->{stat})) { |
|
|
100
|
|
|
|
|
|
42
|
1
|
|
|
|
|
4
|
return $class->protocol('missing stat value in JSON reply', $content); |
43
|
|
|
|
|
|
|
} elsif ($object->{stat} ne 'FAIL') { |
44
|
1
|
|
|
|
|
4
|
my $e = $class->protocol('invalid stat value', $content); |
45
|
1
|
|
|
|
|
3
|
$e->{detail} = $object->{stat}; |
46
|
1
|
|
|
|
|
5
|
return $e; |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# Set the exception information from the JSON object. |
50
|
|
|
|
|
|
|
my $self = { |
51
|
|
|
|
|
|
|
code => $object->{code} // 50000, |
52
|
|
|
|
|
|
|
message => $object->{message} // 'missing error message', |
53
|
|
|
|
|
|
|
detail => $object->{message_detail}, |
54
|
2
|
|
100
|
|
|
16
|
content => $content, |
|
|
|
100
|
|
|
|
|
55
|
|
|
|
|
|
|
}; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# Create the object and return it. |
58
|
2
|
|
|
|
|
5
|
bless($self, $class); |
59
|
2
|
|
|
|
|
8
|
return $self; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# Construct an exception from an HTTP::Response object. |
63
|
|
|
|
|
|
|
# |
64
|
|
|
|
|
|
|
# $class - Class of the exception to create |
65
|
|
|
|
|
|
|
# $response - An HTTP::Response object representing the failure |
66
|
|
|
|
|
|
|
# |
67
|
|
|
|
|
|
|
# Returns: Newly-constructed exception |
68
|
|
|
|
|
|
|
sub http { |
69
|
1
|
|
|
1
|
1
|
114
|
my ($class, $response) = @_; |
70
|
1
|
|
|
|
|
5
|
my $self = { |
71
|
|
|
|
|
|
|
code => $response->code() . '00', |
72
|
|
|
|
|
|
|
message => $response->message(), |
73
|
|
|
|
|
|
|
content => $response->decoded_content(), |
74
|
|
|
|
|
|
|
}; |
75
|
1
|
|
|
|
|
228
|
bless($self, $class); |
76
|
1
|
|
|
|
|
4
|
return $self; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# Construct an exception for an internal error from a simple message. |
80
|
|
|
|
|
|
|
# |
81
|
|
|
|
|
|
|
# $class - Class of the exception to create |
82
|
|
|
|
|
|
|
# $message - The error message |
83
|
|
|
|
|
|
|
# |
84
|
|
|
|
|
|
|
# Returns: Newly-constructed exception |
85
|
|
|
|
|
|
|
sub internal { |
86
|
2
|
|
|
2
|
1
|
91
|
my ($class, $message) = @_; |
87
|
2
|
|
|
|
|
7
|
my $self = { |
88
|
|
|
|
|
|
|
code => 50000, |
89
|
|
|
|
|
|
|
message => $message, |
90
|
|
|
|
|
|
|
}; |
91
|
2
|
|
|
|
|
5
|
bless($self, $class); |
92
|
2
|
|
|
|
|
11
|
return $self; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# Construct an exception that propagates another internal exception. |
96
|
|
|
|
|
|
|
# Convert it to a string when propagating it, and remove the file and line |
97
|
|
|
|
|
|
|
# information if present. |
98
|
|
|
|
|
|
|
# |
99
|
|
|
|
|
|
|
# $class - Class of the exception to create |
100
|
|
|
|
|
|
|
# $exception - Exception to propagate |
101
|
|
|
|
|
|
|
# |
102
|
|
|
|
|
|
|
# Returns: Newly-constructed exception |
103
|
|
|
|
|
|
|
sub propagate { |
104
|
1
|
|
|
1
|
1
|
3
|
my ($class, $exception) = @_; |
105
|
1
|
|
|
|
|
20
|
$exception =~ s{ [ ] at [ ] \S+ [ ] line [ ] \d+[.]? \n+ \z }{}xms; |
106
|
1
|
|
|
|
|
4
|
return $class->internal($exception); |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
# Construct an exception for a protocol failure, where we got an HTTP |
110
|
|
|
|
|
|
|
# success code but couldn't parse the result or couldn't find the JSON |
111
|
|
|
|
|
|
|
# keys that we were expecting. |
112
|
|
|
|
|
|
|
# |
113
|
|
|
|
|
|
|
# $class - Class of the exception to create |
114
|
|
|
|
|
|
|
# $message - Error message indicating what's wrong |
115
|
|
|
|
|
|
|
# $reply - The content of the HTTP reply |
116
|
|
|
|
|
|
|
# |
117
|
|
|
|
|
|
|
# Returns: Newly-created exception |
118
|
|
|
|
|
|
|
sub protocol { |
119
|
3
|
|
|
3
|
1
|
7
|
my ($class, $message, $reply) = @_; |
120
|
3
|
|
|
|
|
10
|
my $self = { |
121
|
|
|
|
|
|
|
code => 50000, |
122
|
|
|
|
|
|
|
message => $message, |
123
|
|
|
|
|
|
|
content => $reply, |
124
|
|
|
|
|
|
|
}; |
125
|
3
|
|
|
|
|
7
|
bless($self, $class); |
126
|
3
|
|
|
|
|
8
|
return $self; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
############################################################################## |
130
|
|
|
|
|
|
|
# Accessors and overloads |
131
|
|
|
|
|
|
|
############################################################################## |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# Basic accessors. |
134
|
8
|
|
|
8
|
1
|
2973
|
sub code { my $self = shift; return $self->{code} } |
|
8
|
|
|
|
|
54
|
|
135
|
8
|
|
|
8
|
1
|
17
|
sub content { my $self = shift; return $self->{content} } |
|
8
|
|
|
|
|
34
|
|
136
|
8
|
|
|
8
|
1
|
26
|
sub detail { my $self = shift; return $self->{detail} } |
|
8
|
|
|
|
|
36
|
|
137
|
8
|
|
|
8
|
1
|
17
|
sub message { my $self = shift; return $self->{message} } |
|
8
|
|
|
|
|
33
|
|
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# The cmp implmenetation converts the exception to a string and then compares |
140
|
|
|
|
|
|
|
# it to the other argument. |
141
|
|
|
|
|
|
|
# |
142
|
|
|
|
|
|
|
# $self - Net::Duo::Exception object |
143
|
|
|
|
|
|
|
# $other - The other object (generally a string) to which to compare it |
144
|
|
|
|
|
|
|
# $swap - True if the order needs to be swapped for a proper comparison |
145
|
|
|
|
|
|
|
# |
146
|
|
|
|
|
|
|
# Returns: -1, 0, or 1 per the cmp interface contract |
147
|
|
|
|
|
|
|
sub spaceship { |
148
|
4
|
|
|
4
|
1
|
13
|
my ($self, $other, $swap) = @_; |
149
|
4
|
|
|
|
|
9
|
my $string = $self->to_string; |
150
|
4
|
100
|
|
|
|
12
|
if ($swap) { |
151
|
2
|
|
|
|
|
11
|
return ($other cmp $string); |
152
|
|
|
|
|
|
|
} else { |
153
|
2
|
|
|
|
|
10
|
return ($string cmp $other); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
# A verbose message with all the information from the exception except for |
158
|
|
|
|
|
|
|
# the full content of the reply. |
159
|
|
|
|
|
|
|
# |
160
|
|
|
|
|
|
|
# $self - Net::Duo::Exception |
161
|
|
|
|
|
|
|
# |
162
|
|
|
|
|
|
|
# Returns: A string version of the exception information. |
163
|
|
|
|
|
|
|
sub to_string { |
164
|
13
|
|
|
13
|
1
|
27
|
my ($self) = @_; |
165
|
13
|
|
|
|
|
23
|
my $code = $self->{code}; |
166
|
13
|
|
|
|
|
21
|
my $detail = $self->{detail}; |
167
|
13
|
|
|
|
|
20
|
my $message = $self->{message}; |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
# Our verbose format is the message, followed by the detail in |
170
|
|
|
|
|
|
|
# parentheses if available, and then the error code in brackets. |
171
|
13
|
|
|
|
|
28
|
my $result = $message; |
172
|
13
|
100
|
|
|
|
36
|
if (defined($detail)) { |
173
|
2
|
|
|
|
|
6
|
$result .= " ($detail)"; |
174
|
|
|
|
|
|
|
} |
175
|
13
|
|
|
|
|
33
|
$result .= " [$code]"; |
176
|
13
|
|
|
|
|
45
|
return $result; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
1; |
180
|
|
|
|
|
|
|
__END__ |