1####################################################################################################################################
2# COMMON EXCEPTION MODULE
3####################################################################################################################################
4package pgBackRestDoc::Common::Exception;
5
6use strict;
7use warnings FATAL => qw(all);
8use Carp qw(confess longmess);
9
10use Scalar::Util qw(blessed);
11
12use Exporter qw(import);
13    our @EXPORT = qw();
14
15####################################################################################################################################
16# Error Definitions
17####################################################################################################################################
18use constant ERROR_MINIMUM                                          => 25;
19push @EXPORT, qw(ERROR_MINIMUM);
20use constant ERROR_MAXIMUM                                          => 125;
21push @EXPORT, qw(ERROR_MAXIMUM);
22
23use constant ERROR_ASSERT                                           => 25;
24push @EXPORT, qw(ERROR_ASSERT);
25use constant ERROR_CHECKSUM                                         => 26;
26push @EXPORT, qw(ERROR_CHECKSUM);
27use constant ERROR_CONFIG                                           => 27;
28push @EXPORT, qw(ERROR_CONFIG);
29use constant ERROR_FILE_INVALID                                     => 28;
30push @EXPORT, qw(ERROR_FILE_INVALID);
31use constant ERROR_FORMAT                                           => 29;
32push @EXPORT, qw(ERROR_FORMAT);
33use constant ERROR_OPTION_INVALID_VALUE                             => 32;
34push @EXPORT, qw(ERROR_OPTION_INVALID_VALUE);
35use constant ERROR_PG_RUNNING                                       => 38;
36push @EXPORT, qw(ERROR_PG_RUNNING);
37use constant ERROR_PATH_NOT_EMPTY                                   => 40;
38push @EXPORT, qw(ERROR_PATH_NOT_EMPTY);
39use constant ERROR_FILE_OPEN                                        => 41;
40push @EXPORT, qw(ERROR_FILE_OPEN);
41use constant ERROR_FILE_READ                                        => 42;
42push @EXPORT, qw(ERROR_FILE_READ);
43use constant ERROR_ARCHIVE_MISMATCH                                 => 44;
44push @EXPORT, qw(ERROR_ARCHIVE_MISMATCH);
45use constant ERROR_ARCHIVE_DUPLICATE                                => 45;
46push @EXPORT, qw(ERROR_ARCHIVE_DUPLICATE);
47use constant ERROR_PATH_CREATE                                      => 47;
48push @EXPORT, qw(ERROR_PATH_CREATE);
49use constant ERROR_LOCK_ACQUIRE                                     => 50;
50push @EXPORT, qw(ERROR_LOCK_ACQUIRE);
51use constant ERROR_BACKUP_MISMATCH                                  => 51;
52push @EXPORT, qw(ERROR_BACKUP_MISMATCH);
53use constant ERROR_PATH_OPEN                                        => 53;
54push @EXPORT, qw(ERROR_PATH_OPEN);
55use constant ERROR_PATH_SYNC                                        => 54;
56push @EXPORT, qw(ERROR_PATH_SYNC);
57use constant ERROR_FILE_MISSING                                     => 55;
58push @EXPORT, qw(ERROR_FILE_MISSING);
59use constant ERROR_DB_CONNECT                                       => 56;
60push @EXPORT, qw(ERROR_DB_CONNECT);
61use constant ERROR_DB_QUERY                                         => 57;
62push @EXPORT, qw(ERROR_DB_QUERY);
63use constant ERROR_DB_MISMATCH                                      => 58;
64push @EXPORT, qw(ERROR_DB_MISMATCH);
65use constant ERROR_PATH_REMOVE                                      => 61;
66push @EXPORT, qw(ERROR_PATH_REMOVE);
67use constant ERROR_STOP                                             => 62;
68push @EXPORT, qw(ERROR_STOP);
69use constant ERROR_FILE_WRITE                                       => 64;
70push @EXPORT, qw(ERROR_FILE_WRITE);
71use constant ERROR_FEATURE_NOT_SUPPORTED                            => 67;
72push @EXPORT, qw(ERROR_FEATURE_NOT_SUPPORTED);
73use constant ERROR_ARCHIVE_COMMAND_INVALID                          => 68;
74push @EXPORT, qw(ERROR_ARCHIVE_COMMAND_INVALID);
75use constant ERROR_LINK_EXPECTED                                    => 69;
76push @EXPORT, qw(ERROR_LINK_EXPECTED);
77use constant ERROR_LINK_DESTINATION                                 => 70;
78push @EXPORT, qw(ERROR_LINK_DESTINATION);
79use constant ERROR_PATH_MISSING                                     => 73;
80push @EXPORT, qw(ERROR_PATH_MISSING);
81use constant ERROR_FILE_MOVE                                        => 74;
82push @EXPORT, qw(ERROR_FILE_MOVE);
83use constant ERROR_PATH_TYPE                                        => 77;
84push @EXPORT, qw(ERROR_PATH_TYPE);
85use constant ERROR_DB_MISSING                                       => 80;
86push @EXPORT, qw(ERROR_DB_MISSING);
87use constant ERROR_DB_INVALID                                       => 81;
88push @EXPORT, qw(ERROR_DB_INVALID);
89use constant ERROR_ARCHIVE_TIMEOUT                                  => 82;
90push @EXPORT, qw(ERROR_ARCHIVE_TIMEOUT);
91use constant ERROR_ARCHIVE_DISABLED                                 => 87;
92push @EXPORT, qw(ERROR_ARCHIVE_DISABLED);
93use constant ERROR_FILE_OWNER                                       => 88;
94push @EXPORT, qw(ERROR_FILE_OWNER);
95use constant ERROR_PATH_EXISTS                                      => 92;
96push @EXPORT, qw(ERROR_PATH_EXISTS);
97use constant ERROR_FILE_EXISTS                                      => 93;
98push @EXPORT, qw(ERROR_FILE_EXISTS);
99use constant ERROR_CRYPTO                                           => 95;
100push @EXPORT, qw(ERROR_CRYPTO);
101use constant ERROR_INVALID                                          => 123;
102push @EXPORT, qw(ERROR_INVALID);
103use constant ERROR_UNHANDLED                                        => 124;
104push @EXPORT, qw(ERROR_UNHANDLED);
105use constant ERROR_UNKNOWN                                          => 125;
106push @EXPORT, qw(ERROR_UNKNOWN);
107
108####################################################################################################################################
109# CONSTRUCTOR
110####################################################################################################################################
111sub new
112{
113    my $class = shift;       # Class name
114    my $strLevel = shift;    # Log level
115    my $iCode = shift;       # Error code
116    my $strMessage = shift;  # ErrorMessage
117    my $strTrace = shift;    # Stack trace
118    my $rExtra = shift;      # Extra info used exclusively by the logging system
119    my $bErrorC = shift;     # Is this a C error?
120
121    if ($iCode < ERROR_MINIMUM || $iCode > ERROR_MAXIMUM)
122    {
123        $iCode = ERROR_INVALID;
124    }
125
126    # Create the class hash
127    my $self = {};
128    bless $self, $class;
129
130    # Initialize exception
131    $self->{strLevel} = $strLevel;
132    $self->{iCode} = $iCode;
133    $self->{strMessage} = $strMessage;
134    $self->{strTrace} = $strTrace;
135    $self->{rExtra} = $rExtra;
136    $self->{bErrorC} = $bErrorC ? 1 : 0;
137
138    return $self;
139}
140
141####################################################################################################################################
142# level
143####################################################################################################################################
144sub level
145{
146    my $self = shift;
147
148    return $self->{strLevel};
149}
150
151####################################################################################################################################
152# CODE
153####################################################################################################################################
154sub code
155{
156    my $self = shift;
157
158    return $self->{iCode};
159}
160
161####################################################################################################################################
162# extra
163####################################################################################################################################
164sub extra
165{
166    my $self = shift;
167
168    return $self->{rExtra};
169}
170
171####################################################################################################################################
172# MESSAGE
173####################################################################################################################################
174sub message
175{
176    my $self = shift;
177
178    return $self->{strMessage};
179}
180
181####################################################################################################################################
182# TRACE
183####################################################################################################################################
184sub trace
185{
186    my $self = shift;
187
188    return $self->{strTrace};
189}
190
191####################################################################################################################################
192# isException - is this a structured exception or a default Perl exception?
193####################################################################################################################################
194sub isException
195{
196    my $roException = shift;
197
198    # Only check if defined
199    if (defined($roException) && defined($$roException))
200    {
201        # If a standard Exception
202        if (blessed($$roException))
203        {
204            return $$roException->isa('pgBackRestDoc::Common::Exception') ? 1 : 0;
205        }
206        # Else if a specially formatted string from the C library
207        elsif ($$roException =~ /^PGBRCLIB\:[0-9]+\:/)
208        {
209            # Split message and discard the first part used for identification
210            my @stryException = split(/\:/, $$roException);
211            shift(@stryException);
212
213            # Construct exception fields
214            my $iCode = shift(@stryException) + 0;
215            my $strTrace = shift(@stryException) . qw{:} . shift(@stryException);
216            my $strMessage = join(':', @stryException);
217
218            # Create exception
219            $$roException = new pgBackRestDoc::Common::Exception("ERROR", $iCode, $strMessage, $strTrace, undef, 1);
220
221            return 1;
222        }
223    }
224
225    return 0;
226}
227
228push @EXPORT, qw(isException);
229
230####################################################################################################################################
231# exceptionCode
232#
233# Extract the error code from an exception - if a Perl exception return ERROR_UNKNOWN.
234####################################################################################################################################
235sub exceptionCode
236{
237    my $oException = shift;
238
239    return isException(\$oException) ? $oException->code() : ERROR_UNKNOWN;
240}
241
242push @EXPORT, qw(exceptionCode);
243
244####################################################################################################################################
245# exceptionMessage
246#
247# Extract the error message from an exception - if a Perl exception return bare exception.
248####################################################################################################################################
249sub exceptionMessage
250{
251    my $oException = shift;
252
253    return isException(\$oException) ? $oException->message() : $oException;
254}
255
256push @EXPORT, qw(exceptionMessage);
257
2581;
259