File Coverage

blib/lib/Net/FreeIPA/Error.pm
Criterion Covered Total %
statement 77 77 100.0
branch 30 30 100.0
condition 19 24 79.1
subroutine 15 15 100.0
pod 7 7 100.0
total 148 153 96.7


line stmt bran cond sub pod time code
1             package Net::FreeIPA::Error;
2             $Net::FreeIPA::Error::VERSION = '3.0.1';
3 9     9   626 use strict;
  9         11  
  9         213  
4 9     9   31 use warnings;
  9         9  
  9         383  
5              
6 9     9   36 use base qw(Exporter);
  9         11  
  9         815  
7              
8             our @EXPORT = qw(mkerror);
9              
10 9     9   971 use Readonly;
  9         5577  
  9         446  
11              
12 9     9   2033 use overload bool => 'is_error', '==' => '_is_equal', '!=' => '_is_not_equal', '""' => '_stringify';
  9         1508  
  9         90  
13              
14             Readonly our $DUPLICATE_ENTRY => 'DuplicateEntry';
15             Readonly our $NOT_FOUND => 'NotFound';
16             Readonly our $ALREADY_INACTIVE => 'AlreadyInactive';
17              
18             Readonly::Hash our %ERROR_CODES => {
19             $DUPLICATE_ENTRY => 4002,
20             $NOT_FOUND => 4001,
21             $ALREADY_INACTIVE => 4010,
22             };
23              
24             Readonly::Hash our %REVERSE_ERROR_CODES => map {$ERROR_CODES{$_} => $_} keys %ERROR_CODES;
25              
26             =head1 NAME
27              
28             Net::FreeIPA::Error is an error class for Net::FreeIPA.
29              
30             Boolean logic and (non)-equal operator are overloaded using C method.
31             (Use C<==> and C also for name/message, not C / C operators).
32              
33             =head2 Public methods
34              
35             =over
36              
37             =item mkerror
38              
39             A C factory
40              
41             =cut
42              
43             sub mkerror
44             {
45 47     47 1 4378 return Net::FreeIPA::Error->new(@_);
46             }
47              
48              
49             =item new
50              
51             Create new error instance from options, e.g. from a (decoded dereferenced) JSON response.
52              
53             Arguments are handled by C.
54              
55             =cut
56              
57             sub new
58             {
59 48     48 1 593 my $this = shift;
60 48   33     173 my $class = ref($this) || $this;
61 48         79 my $self = {
62             __errattr => [],
63             };
64 48         51 bless $self, $class;
65              
66 48         90 $self->set_error(@_);
67              
68 48         89 return $self;
69             };
70              
71             =item set_error
72              
73             Process arguments to error
74              
75             =over
76              
77             =item no args/undef: reset the error attribute
78              
79             =item single argument string: convert to an C instance with message
80              
81             =item single argument hasref/Error instance: make a copy
82              
83             =item single argument/other: set Error message and save original in _orig attribute
84              
85             =item options (more than one arg): set the options
86              
87             =back
88              
89             =cut
90              
91             sub set_error
92             {
93 55     55 1 45 my $self = shift;
94              
95 55         35 my $nrargs = scalar @_;
96              
97 55         45 my %opts;
98 55 100       116 if ($nrargs == 1) {
    100          
99 10         11 my $err = shift;
100 10         12 my $ref = ref($err);
101              
102 10 100 100     45 if($ref eq 'Net::FreeIPA::Error') {
    100          
    100          
    100          
103 1         1 %opts = map {$_ => $err->{$_}} @{$err->{__errattr}};
  1         3  
  1         2  
104             } elsif ($ref eq 'HASH') {
105 2         8 %opts = %$err;
106             } elsif (defined($err) && $ref eq '') {
107 3         5 $opts{message} = $err;
108             } elsif (defined($err)) {
109 1         3 $opts{message} = "unknown error type $ref, see _orig attribute";
110 1         1 $opts{_orig} = $err;
111             }
112             } elsif ($nrargs > 1) {
113 35         59 %opts = @_;
114             }
115              
116              
117             # Wipe current state
118             # Do this after the %opts are build, to allow copies of itself
119 55         40 foreach my $key (@{$self->{__errattr}}) {
  55         164  
120 7         11 delete $self->{$key};
121             }
122 55         57 $self->{__errattr} = [];
123              
124             # sort produces sorted __errattr
125 55         106 foreach my $key (sort keys %opts) {
126 44         48 $self->{$key} = $opts{$key};
127 44         28 push(@{$self->{__errattr}}, $key);
  44         71  
128             }
129              
130 55         68 return $self;
131             }
132              
133             =item is_error
134              
135             Test if this is an error or not.
136              
137             If an optiona l C argument is passed,
138             test if error name or code is equal to C.
139              
140             A numerical type is compare to the code, a string is compare to the name or message
141              
142             For a set of known errorcodes, a automatic reverse lookup is performed.
143             When e.g. only the error name attribute is set, one can test using a known errorcode.
144              
145             =cut
146              
147             sub is_error
148             {
149 137     137 1 182 my ($self, $type, $reverse_lookup) = @_;
150              
151 137 100       207 $reverse_lookup = 1 if ! defined($reverse_lookup);
152              
153 137         87 my $res;
154              
155 137 100       140 if(defined($type)) {
156 53         29 my $revtype;
157              
158 53 100       145 if ($type =~ m/^\d+$/) {
159 28 100       67 $revtype = $REVERSE_ERROR_CODES{$type} if (exists($REVERSE_ERROR_CODES{$type}));
160 28   100     215 $res = exists($self->{code}) && ($self->{code} == $type);
161             } else {
162 25 100       57 $revtype = $ERROR_CODES{$type} if (exists($ERROR_CODES{$type}));
163 25   66     245 $res = (exists($self->{name}) && ($self->{name} eq $type)) || (exists($self->{message}) && ($self->{message} eq $type));
164             }
165              
166             # If a reverse known error is found, and it is not yet an error, lookup the reverse
167             # Disable the reverse-lookup here to avoid loop
168 53 100 100     171 $res = $self->is_error($revtype, 0) if ($reverse_lookup && defined($revtype) && ! $res);
      100        
169             } else {
170 84   66     201 $res = exists($self->{code}) || exists($self->{name}) || exists($self->{message});
171             }
172              
173 137 100       314 return $res ? 1 : 0;
174             }
175              
176             =item is_duplicate
177              
178             Test if this is a DuplicateEntry error
179              
180             =cut
181              
182             sub is_duplicate
183             {
184 4     4 1 12 my ($self) = @_;
185              
186 4         5 return $self->is_error($DUPLICATE_ENTRY);
187             }
188              
189             =item is_already_inactive
190              
191             Test if this is a AlreadyInactive error
192              
193             =cut
194              
195             sub is_already_inactive
196             {
197 4     4 1 13 my ($self) = @_;
198              
199 4         4 return $self->is_error($ALREADY_INACTIVE);
200             }
201              
202              
203             =item is_not_found
204              
205             Test if this is a NotFound error
206              
207             =cut
208              
209             sub is_not_found
210             {
211 4     4 1 12 my ($self) = @_;
212              
213 4         5 return $self->is_error($NOT_FOUND);
214             }
215              
216             # is_equal for overloading ==
217             # handle == undef (otherwise this would be $self->is_error)
218             sub _is_equal
219             {
220             # Use shift, looks like a 3rd argument (an empty string) is passed
221 7     7   166 my $self = shift;
222 7         7 my $othererror = shift;
223 7   66     19 return defined($othererror) && $self->is_error($othererror);
224             }
225              
226             # inverse is_equal for overloading !=
227             sub _is_not_equal
228             {
229 1     1   1 my $self = shift;
230 1         3 return ! $self->_is_equal(@_);
231             }
232              
233             # _stringify create string for stringification
234             sub _stringify
235             {
236 38     38   620 my $self = shift;
237              
238 38 100       40 if ($self->is_error()) {
239 27         22 my @fields;
240 27         25 foreach my $attr (qw(name code message)) {
241 81 100       132 push(@fields, $self->{$attr}) if exists ($self->{$attr});
242             }
243 27         102 return "Error ".join('/', @fields);
244             } else {
245 11         34 return "No error";
246             };
247             }
248              
249             =pod
250              
251             =back
252              
253             =cut
254              
255             1;