Neue Option in LXDebug: LXDebug->WARN.

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.

diff --git a/SL/Dispatcher.pm b/SL/Dispatcher.pm
index e5a7daab89f8fc2520a1bac3dfff637ed8fba0e6..2c0539bb899e2015287cccba63692de1f3063ea4 100644 (file)
--- a/SL/Dispatcher.pm
+++ b/SL/Dispatcher.pm
@@ -82,6 +82,10 @@ sub pre_startup_setup {
     %::myconfig    = ();
     %::called_subs = (); # currently used for recursion detection
   }
     %::myconfig    = ();
     %::called_subs = (); # currently used for recursion detection
   }

+
+  $SIG{__WARN__} = sub {
+    $::lxdebug->warn(@_);
+  }

 }
 
 sub pre_startup_checks {
 }
 
 sub pre_startup_checks {

diff --git a/SL/LXDebug.pm b/SL/LXDebug.pm
index e3778d44fd9f9d6e0684d7c0e35cbb783b7cd089..7d17aec6d719aa229695f913c195aa169492282d 100644 (file)
--- 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 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;
 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 {
 }
 
 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
 
   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 {
 }
 
 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
 
   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 {
 }
 
 sub message {

+  no warnings;

   my ($self, $level, $message) = @_;
 
   $self->_write(level2string($level), $message) if (($self->{"level"} | $global_level) & $level || !$level);
 }
   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) = @_;
 
 sub dump {
   my ($self, $level, $name, $variable) = @_;


@@ -210,6 +217,7 @@ sub is_tracing_enabled {
 }
 
 sub _write {
 }
 
 sub _write {

+  no warnings;

   my ($self, $prefix, $message) = @_;
   my $date = strftime("%Y-%m-%d %H:%M:%S $$ [" . getppid() . "] ${prefix}: ", localtime(time()));
   local *FILE;
   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 {
 }
 
 sub level2string {

+  no warnings;

   # use $_[0] as a bit mask and return levelstrings separated by /
   # 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 {
 }
 
 sub begin_request {

diff --git a/config/lx-erp.conf b/config/lx-erp.conf
index 205147d691fdfd4f9b4c61f2815eea675898ac10..e388b8511d62e3985e2420d462abb3672aa14d5d 100644 (file)
--- 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::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
 # 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;
 
 # 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;
 1;

diff --git a/config/lx-erp.conf.default b/config/lx-erp.conf.default
index e031c3e056f32a3119b34e2df41650e2856da527..6b3b80fff78d232d786da54fd7f83af94c136fd2 100644 (file)
--- 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::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
 # LXDebug::ALL    - alle Debugausgaben
 #
 # LXDebug::DEVEL  - wie INFO | QUERY | TRACE | BACKTRACE_ON_ERROR