diff --git a/doc/doc.pl b/doc/doc.pl
index e56d04e49..f375cac45 100755
--- a/doc/doc.pl
+++ b/doc/doc.pl
@@ -336,7 +336,7 @@ eval
or do
{
# If a backrest exception then return the code
- exit $EVAL_ERROR->code() if (isException($EVAL_ERROR));
+ exit $EVAL_ERROR->code() if (isException(\$EVAL_ERROR));
# Else output the unhandled error
print $EVAL_ERROR;
diff --git a/doc/release.pl b/doc/release.pl
index 11135575f..49383a76b 100755
--- a/doc/release.pl
+++ b/doc/release.pl
@@ -196,7 +196,7 @@ eval
or do
{
# If a backrest exception then return the code
- exit $EVAL_ERROR->code() if (isException($EVAL_ERROR));
+ exit $EVAL_ERROR->code() if (isException(\$EVAL_ERROR));
# Else output the unhandled error
print $EVAL_ERROR;
diff --git a/doc/xml/release.xml b/doc/xml/release.xml
index 9682f4608..e236d89ce 100644
--- a/doc/xml/release.xml
+++ b/doc/xml/release.xml
@@ -32,6 +32,10 @@
Add C error handler.
+
+
+ Perl error handler recognizes errors thrown from the C library.
+
diff --git a/lib/pgBackRest/Archive/Info.pm b/lib/pgBackRest/Archive/Info.pm
index dc449904c..233d689f4 100644
--- a/lib/pgBackRest/Archive/Info.pm
+++ b/lib/pgBackRest/Archive/Info.pm
@@ -102,7 +102,7 @@ sub new
{
# Capture error information
$iResult = exceptionCode($EVAL_ERROR);
- $strResultMessage = exceptionMessage($EVAL_ERROR->message());
+ $strResultMessage = exceptionMessage($EVAL_ERROR);
};
if ($iResult != 0)
diff --git a/lib/pgBackRest/Backup/Info.pm b/lib/pgBackRest/Backup/Info.pm
index 0cfcbd6e0..8672e6e52 100644
--- a/lib/pgBackRest/Backup/Info.pm
+++ b/lib/pgBackRest/Backup/Info.pm
@@ -146,7 +146,7 @@ sub new
{
# Capture error information
$iResult = exceptionCode($EVAL_ERROR);
- $strResultMessage = exceptionMessage($EVAL_ERROR->message());
+ $strResultMessage = exceptionMessage($EVAL_ERROR);
};
if ($iResult != 0)
diff --git a/lib/pgBackRest/Check/Check.pm b/lib/pgBackRest/Check/Check.pm
index db51d8150..3b241c7f6 100644
--- a/lib/pgBackRest/Check/Check.pm
+++ b/lib/pgBackRest/Check/Check.pm
@@ -88,7 +88,7 @@ sub process
{
# Capture error information
$iResult = exceptionCode($EVAL_ERROR);
- $strResultMessage = exceptionMessage($EVAL_ERROR->message());
+ $strResultMessage = exceptionMessage($EVAL_ERROR);
};
# Check archive.info
@@ -104,7 +104,7 @@ sub process
{
# Capture error information
$iResult = exceptionCode($EVAL_ERROR);
- $strResultMessage = exceptionMessage($EVAL_ERROR->message());
+ $strResultMessage = exceptionMessage($EVAL_ERROR);
};
}
@@ -123,7 +123,7 @@ sub process
{
# Capture error information
$iResult = exceptionCode($EVAL_ERROR);
- $strResultMessage = exceptionMessage($EVAL_ERROR->message());
+ $strResultMessage = exceptionMessage($EVAL_ERROR);
};
}
diff --git a/lib/pgBackRest/Common/Exception.pm b/lib/pgBackRest/Common/Exception.pm
index debba809a..92450e34f 100644
--- a/lib/pgBackRest/Common/Exception.pm
+++ b/lib/pgBackRest/Common/Exception.pm
@@ -248,15 +248,32 @@ sub trace
}
####################################################################################################################################
-# isException
-#
-# Is this a structured exception?
+# isException - is this a structured exception or a default Perl exception?
####################################################################################################################################
sub isException
{
- my $oException = shift;
+ my $roException = shift;
- return defined($oException) && blessed($oException) && $oException->isa('pgBackRest::Common::Exception') ? 1 : 0;
+ # Only check if defined
+ if (defined($roException) && defined($$roException))
+ {
+ # If a standard Exception
+ if (blessed($$roException))
+ {
+ return $$roException->isa('pgBackRest::Common::Exception') ? 1 : 0;
+ }
+ # Else if a specially formatted string from the C library
+ elsif ($$roException =~ /^PGBRCLIB\:[0-9]+\:/)
+ {
+ my @stryException = split(/\:/, $$roException);
+ $$roException = new pgBackRest::Common::Exception(
+ "ERROR", $stryException[1] + 0, $stryException[4], $stryException[2] . qw{:} . $stryException[3]);
+
+ return 1;
+ }
+ }
+
+ return 0;
}
push @EXPORT, qw(isException);
@@ -270,7 +287,7 @@ sub exceptionCode
{
my $oException = shift;
- return isException($oException) ? $oException->code() : ERROR_UNKNOWN;
+ return isException(\$oException) ? $oException->code() : ERROR_UNKNOWN;
}
push @EXPORT, qw(exceptionCode);
@@ -284,7 +301,7 @@ sub exceptionMessage
{
my $oException = shift;
- return isException($oException) ? $oException->message() : $oException;
+ return isException(\$oException) ? $oException->message() : $oException;
}
push @EXPORT, qw(exceptionMessage);
diff --git a/lib/pgBackRest/Common/Exit.pm b/lib/pgBackRest/Common/Exit.pm
index e6e950c49..4c958a467 100644
--- a/lib/pgBackRest/Common/Exit.pm
+++ b/lib/pgBackRest/Common/Exit.pm
@@ -73,7 +73,7 @@ sub exitSafe
if (!defined($iExitCode))
{
# If a backrest exception
- if (isException($oException))
+ if (isException(\$oException))
{
$iExitCode = $oException->code();
logException($oException);
diff --git a/lib/pgBackRest/Protocol/Base/Minion.pm b/lib/pgBackRest/Protocol/Base/Minion.pm
index 1b8c6c325..692ba01c6 100644
--- a/lib/pgBackRest/Protocol/Base/Minion.pm
+++ b/lib/pgBackRest/Protocol/Base/Minion.pm
@@ -92,7 +92,7 @@ sub errorWrite
my $oException = shift;
# Throw hard error if this is not a standard exception
- if (!isException($oException))
+ if (!isException(\$oException))
{
confess &log(ERROR, 'unknown error: ' . $oException, ERROR_UNKNOWN);
}
@@ -189,7 +189,7 @@ sub process
logLevelSet(undef, undef, PROTOCOL);
# If standard exception
- if (isException($oException))
+ if (isException(\$oException))
{
confess &log($oException->level(), $oException->message(), $oException->code());
}
diff --git a/lib/pgBackRest/Protocol/Command/Master.pm b/lib/pgBackRest/Protocol/Command/Master.pm
index 4afa792f6..ab0ba61b1 100644
--- a/lib/pgBackRest/Protocol/Command/Master.pm
+++ b/lib/pgBackRest/Protocol/Command/Master.pm
@@ -112,7 +112,7 @@ sub close
my $strError = 'unable to shutdown protocol';
my $strHint = 'HINT: the process completed all operations successfully but protocol-timeout may need to be increased.';
- if (isException($oException))
+ if (isException(\$oException))
{
$iExitStatus = $oException->code();
}
diff --git a/lib/pgBackRest/Protocol/Local/Process.pm b/lib/pgBackRest/Protocol/Local/Process.pm
index 77def927e..a2564635c 100644
--- a/lib/pgBackRest/Protocol/Local/Process.pm
+++ b/lib/pgBackRest/Protocol/Local/Process.pm
@@ -334,7 +334,7 @@ sub process
my $oException = $EVAL_ERROR;
# If not a backrest exception then always confess it - something has gone very wrong
- confess $oException if (!isException($oException));
+ confess $oException if (!isException(\$oException));
# If the process is has terminated throw the exception
if (!defined($hLocal->{oLocal}->io()->processId()))
diff --git a/lib/pgBackRest/Stanza.pm b/lib/pgBackRest/Stanza.pm
index 64bd40157..b0a25add2 100644
--- a/lib/pgBackRest/Stanza.pm
+++ b/lib/pgBackRest/Stanza.pm
@@ -322,7 +322,7 @@ sub infoObject
# Reset console logging and capture error information
logEnable();
$iResult = exceptionCode($EVAL_ERROR);
- $strResultMessage = exceptionMessage($EVAL_ERROR->message());
+ $strResultMessage = exceptionMessage($EVAL_ERROR);
};
if ($iResult != 0)
@@ -445,7 +445,7 @@ sub infoFileCreate
# Reset console logging and capture error information
logEnable();
$iResult = exceptionCode($EVAL_ERROR);
- $strResultMessage = exceptionMessage($EVAL_ERROR->message());
+ $strResultMessage = exceptionMessage($EVAL_ERROR);
};
# If we got here without error then save the reconstructed file
diff --git a/libc/LibC.h b/libc/LibC.h
new file mode 100644
index 000000000..80c7dd01e
--- /dev/null
+++ b/libc/LibC.h
@@ -0,0 +1,62 @@
+/***********************************************************************************************************************************
+Helper macros for LibC.xs
+***********************************************************************************************************************************/
+
+/***********************************************************************************************************************************
+Package Names
+***********************************************************************************************************************************/
+#define PACKAGE_NAME "pgBackRest"
+#define PACKAGE_NAME_LIBC PACKAGE_NAME "::LibC"
+
+/***********************************************************************************************************************************
+Load C error into ERROR_SV_error
+
+#define FUNCTION_NAME_ERROR "libcExceptionNew"
+
+#define ERROR_SV() \
+ SV *ERROR_SV_error; \
+ \
+ { \
+ // Push parameters onto the Perl stack \
+ ENTER; \
+ SAVETMPS; \
+ PUSHMARK(SP); \
+ EXTEND(SP, 2); \
+ PUSHs(sv_2mortal(newSViv(errorCode()))); \
+ PUSHs(sv_2mortal(newSVpv(errorMessage(), 0))); \
+ PUTBACK; \
+ \
+ // Call error function \
+ int count = call_pv(PACKAGE_NAME_LIBC "::" FUNCTION_NAME_ERROR, G_SCALAR); \
+ SPAGAIN; \
+ \
+ // Check that correct number of parameters was returned \
+ if (count != 1) \
+ croak("expected 1 return value from " FUNCTION_NAME_ERROR "()"); \
+ \
+ // Make a copy of the error that can be returned \
+ ERROR_SV_error = newSVsv(POPs); \
+ \
+ // Clean up the stack \
+ PUTBACK; \
+ FREETMPS; \
+ LEAVE; \
+ }
+
+This turned out to be a dead end because Perl 5.10 does not support croak_sv(), but this code has been kept for example purposes.
+***********************************************************************************************************************************/
+
+/***********************************************************************************************************************************
+Error handling macros that throw a Perl error when a C error is caught
+***********************************************************************************************************************************/
+#define ERROR_XS_BEGIN() \
+ ERROR_TRY()
+
+#define ERROR_XS() \
+ croak("PGBRCLIB:%d:%s:%d:%s", errorCode(), errorFileName(), errorFileLine(), errorMessage());
+
+#define ERROR_XS_END() \
+ ERROR_CATCH_ANY() \
+ { \
+ ERROR_XS(); \
+ }
diff --git a/libc/LibC.xs b/libc/LibC.xs
index 962c8a182..0ff4e6d95 100644
--- a/libc/LibC.xs
+++ b/libc/LibC.xs
@@ -26,11 +26,15 @@ C includes
These includes are from the src directory. There is no Perl-specific code in them.
***********************************************************************************************************************************/
#include "common/error.h"
-#include "common/type.h"
#include "config/config.h"
#include "config/configRule.h"
#include "postgres/pageChecksum.h"
+/***********************************************************************************************************************************
+Helper macros
+***********************************************************************************************************************************/
+#include "LibC.h"
+
/***********************************************************************************************************************************
Constant include
diff --git a/test/lib/pgBackRestTest/Common/RunTest.pm b/test/lib/pgBackRestTest/Common/RunTest.pm
index 87eb389e3..7d15ab059 100644
--- a/test/lib/pgBackRestTest/Common/RunTest.pm
+++ b/test/lib/pgBackRestTest/Common/RunTest.pm
@@ -344,7 +344,7 @@ sub testResult
# Restore the log level
logLevelSet($strLogLevelFile, $strLogLevelConsole, $strLogLevelStdErr, $bLogTimestamp);
- if (!isException($EVAL_ERROR))
+ if (!isException(\$EVAL_ERROR))
{
confess "unexpected standard Perl exception" . (defined($EVAL_ERROR) ? ": ${EVAL_ERROR}" : '');
}
@@ -421,7 +421,7 @@ sub testException
{
logEnable();
- if (!isException($EVAL_ERROR))
+ if (!isException(\$EVAL_ERROR))
{
confess "${strError} but actual was standard Perl exception" . (defined($EVAL_ERROR) ? ": ${EVAL_ERROR}" : '');
}
diff --git a/test/lib/pgBackRestTest/Env/ConfigEnvTest.pm b/test/lib/pgBackRestTest/Env/ConfigEnvTest.pm
index 62a580d6c..1b1380013 100644
--- a/test/lib/pgBackRestTest/Env/ConfigEnvTest.pm
+++ b/test/lib/pgBackRestTest/Env/ConfigEnvTest.pm
@@ -158,7 +158,7 @@ sub configTestLoadExpect
$bErrorFound = true;
- if (isException($oException))
+ if (isException(\$oException))
{
if ($oException->code() != $iExpectedError)
{
diff --git a/test/test.pl b/test/test.pl
index 3ed64bbae..9927d61cd 100755
--- a/test/test.pl
+++ b/test/test.pl
@@ -968,7 +968,7 @@ eval
or do
{
# If a backrest exception then return the code
- exit $EVAL_ERROR->code() if (isException($EVAL_ERROR));
+ exit $EVAL_ERROR->code() if (isException(\$EVAL_ERROR));
# Else output the unhandled error
syswrite(*STDOUT, $EVAL_ERROR);
diff --git a/test/travis.pl b/test/travis.pl
index 2fdd057e3..c8f3e7a6f 100755
--- a/test/travis.pl
+++ b/test/travis.pl
@@ -181,7 +181,7 @@ eval
or do
{
# If a backrest exception then return the code
- exit $EVAL_ERROR->code() if (isException($EVAL_ERROR));
+ exit $EVAL_ERROR->code() if (isException(\$EVAL_ERROR));
# Else output the unhandled error
print $EVAL_ERROR;