Add BackTraceOnWarning($onoff) to produce a backtrace on all warnings.

db/emutil.pm.in

@@ -15,10 +15,11 @@ use vars qw(@ISA @EXPORT);
 @EXPORT = qw(TBDB_CHECKDBSLOT_NOFLAGS TBDB_CHECKDBSLOT_WARN
 	     TBDB_CHECKDBSLOT_ERROR TBcheck_dbslot TBFieldErrorString
 	     TBGetUniqueIndex ParRun VersionInfo UpdateVersionInfo
-	     SpanningTree);
+	     SpanningTree BackTraceOnWarning);
 
 use emdb;
 use English;
+use Carp;
 
 #
 # Support for checking field values against what is specified.
@@ -599,5 +600,20 @@ sub SpanningTree($)
     return @newedges;
 }
 
+#
+# Toggle backtrace on warning.
+#
+sub BackTraceOnWarning($)
+{
+    my ($enable) = @_;
+
+    if ($enable) {
+	$SIG{__WARN__} = sub { Carp::cluck(@_); };
+    }
+    else {
+	$SIG{__WARN__} = 'DEFAULT';
+    }
+}
+
 # _Always_ make sure that this 1 is at the end of the file...
 1;