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