File Coverage

blib/lib/Net/Duo/Exception.pm
Criterion Covered Total %
statement 60 60 100.0
branch 8 8 100.0
condition 4 4 100.0
subroutine 16 16 100.0
pod 11 11 100.0
total 99 99 100.0


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__