From 847d924bbcaa4f6021d74c408f71319074103880 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Sven=20Sch=C3=B6ling?= <s.schoeling@linet-services.de>
Date: Mon, 16 Aug 2010 11:11:19 +0200
Subject: [PATCH] Neue Option in LXDebug: LXDebug->WARN.
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

Sämtliche Perl warnings die auftreten, werden jetzt über einen
Sighandler an LXDebug weitergeleitet, und werden, sofern gewünscht,
in das LxOffice Log geschrieben.

Das ganze soll später dazu dienen, inkrementell die Module von warnings zu
befreien, und später dann das Programm im globalen -w Modus laufen lassen zu
können.
---
 SL/Dispatcher.pm           |  4 ++++
 SL/LXDebug.pm              | 21 +++++++++++++++------
 config/lx-erp.conf         |  7 +++++++
 config/lx-erp.conf.default |  2 ++
 4 files changed, 28 insertions(+), 6 deletions(-)

diff --git a/SL/Dispatcher.pm b/SL/Dispatcher.pm
index e5a7daab8..2c0539bb8 100644
--- a/SL/Dispatcher.pm
+++ b/SL/Dispatcher.pm
@@ -82,6 +82,10 @@ sub pre_startup_setup {
     %::myconfig    = ();
     %::called_subs = (); # currently used for recursion detection
   }
+
+  $SIG{__WARN__} = sub {
+    $::lxdebug->warn(@_);
+  }
 }
 
 sub pre_startup_checks {
diff --git a/SL/LXDebug.pm b/SL/LXDebug.pm
index e3778d44f..7d17aec6d 100644
--- a/SL/LXDebug.pm
+++ b/SL/LXDebug.pm
@@ -8,7 +8,8 @@ use constant QUERY              =>  1 << 3;
 use constant TRACE              =>  1 << 4;
 use constant BACKTRACE_ON_ERROR =>  1 << 5;
 use constant REQUEST_TIMER      =>  1 << 6;
-use constant ALL                => (1 << 7) - 1;
+use constant WARN               =>  1 << 7;
+use constant ALL                => (1 << 8) - 1;
 use constant DEVEL              => INFO | QUERY | TRACE | BACKTRACE_ON_ERROR | REQUEST_TIMER;
 
 use constant FILE_TARGET   => 0;
@@ -65,8 +66,8 @@ sub set_target {
 }
 
 sub enter_sub {
-  my ($self, $level) = @_;
-  $level *= 1;
+  my $self  = shift;
+  my $level = shift || 0;
 
   return 1 unless ($global_level & TRACE);          # ignore if traces aren't active
   return 1 if $level && !($global_level & $level);  # ignore if level of trace isn't active
@@ -89,8 +90,8 @@ sub enter_sub {
 }
 
 sub leave_sub {
-  my ($self, $level) = @_;
-  $level *= 1;
+  my $self  = shift;
+  my $level = shift || 0;
 
   return 1 unless ($global_level & TRACE);           # ignore if traces aren't active
   return 1 if $level && !($global_level & $level);   # ignore if level of trace isn't active
@@ -125,10 +126,16 @@ sub show_backtrace {
 }
 
 sub message {
+  no warnings;
   my ($self, $level, $message) = @_;
 
   $self->_write(level2string($level), $message) if (($self->{"level"} | $global_level) & $level || !$level);
 }
+sub warn {
+  no warnings;
+  my ($self, $message) = @_;
+  $self->message(WARN, $message);
+}
 
 sub dump {
   my ($self, $level, $name, $variable) = @_;
@@ -210,6 +217,7 @@ sub is_tracing_enabled {
 }
 
 sub _write {
+  no warnings;
   my ($self, $prefix, $message) = @_;
   my $date = strftime("%Y-%m-%d %H:%M:%S $$ [" . getppid() . "] ${prefix}: ", localtime(time()));
   local *FILE;
@@ -227,8 +235,9 @@ sub _write {
 }
 
 sub level2string {
+  no warnings;
   # use $_[0] as a bit mask and return levelstrings separated by /
-  join '/', qw(info debug1 debug2 query trace error_call_trace)[ grep { (reverse split //, sprintf "%05b", $_[0])[$_] } 0..5 ]
+  join '/', qw(info debug1 debug2 query trace error_call_trace request_timer WARNING)[ grep { (reverse split //, sprintf "%08b", $_[0])[$_] } 0..7 ]
 }
 
 sub begin_request {
diff --git a/config/lx-erp.conf b/config/lx-erp.conf
index 205147d69..e388b8511 100644
--- a/config/lx-erp.conf
+++ b/config/lx-erp.conf
@@ -101,6 +101,7 @@ $pg_restore_exe = "pg_restore";
 # LXDebug::TRACE  - Tracing von Funktionsaufrufen
 # LXDebug::BACKTRACE_ON_ERROR - Vollständiger Aufrufpfad, wenn $form->error() aufgerufen wird
 # LXDebug::REQUEST_TIMER - Timing von Requests loggen
+# LXDebug::WARN - warnings
 # LXDebug::ALL    - alle Debugausgaben
 #
 # LXDebug::DEVEL  - wie INFO | QUERY | TRACE | BACKTRACE_ON_ERROR
@@ -116,4 +117,10 @@ $LXDebug::global_level = LXDebug->NONE;
 # weshalb sie normalerweise deaktiviert ist.
 $LXDebug::watch_form = 0;
 
+# Zum debuggen von Latexausgaben. Wenn diese Option auf 1 gesetzt wird, werden
+# temporäre Dateien, die bei der Erstellung von PDFs aus Latex erzeugt werden,
+# nach Abschluß der Erstellung oder im Fehlerfall nicht gelöscht, damit man sie
+# untersuchen kann.
+$::keep_temp_files = 0;
+
 1;
diff --git a/config/lx-erp.conf.default b/config/lx-erp.conf.default
index e031c3e05..6b3b80fff 100644
--- a/config/lx-erp.conf.default
+++ b/config/lx-erp.conf.default
@@ -99,6 +99,8 @@ $pg_restore_exe = "pg_restore";
 # LXDebug::QUERY  - SQL Queries
 # LXDebug::TRACE  - Tracing von Funktionsaufrufen
 # LXDebug::BACKTRACE_ON_ERROR - Vollständiger Aufrufpfad, wenn $form->error() aufgerufen wird
+# LXDebug::REQUEST_TIMER - Timing von Requests loggen
+# LXDebug::WARN - warnings
 # LXDebug::ALL    - alle Debugausgaben
 #
 # LXDebug::DEVEL  - wie INFO | QUERY | TRACE | BACKTRACE_ON_ERROR
-- 
2.20.1