Debugmechanismus leicht verbessert.

Tracing ist jetzt keine unabhaengige Variable mehr sondern ein Aspekt.
Alle anderen Debuglevel sind jetzt bitexklusiv, und koennen einzeln an und ausgemacht werden.

Grund dafuer ist, dass jetzt mit QUERY ein Modus eingefuehrt wird, der es erlaubt alle SQL queries die ueber die Funktion do_query laufen zu loggen.
Gut zum debuggen der notorisch kaputten Buchungsfunktionen, die 20x auf die Datenbank zugreifen.

diff --git a/SL/DBUtils.pm b/SL/DBUtils.pm
index 4336446fa6aec6500be1c8d4e7cef42f758cfdf1..78a38177548b7349ca75c710bea2a262388c143e 100644 (file)
--- a/SL/DBUtils.pm
+++ b/SL/DBUtils.pm
@@ -33,6 +33,7 @@ sub do_query {
     $dbh->do($query, undef, @_) ||
       $form->dberror($query . " (" . join(", ", @_) . ")");
   }
+  dump_query(LXDebug::QUERY, '', $query . " (" . join(", ", @_) . ")");
 }
 
 sub selectrow_query {

diff --git a/SL/LXDebug.pm b/SL/LXDebug.pm
index 10536c098656d2d0a28c921151f4cfaf5d1b354c..1071ef3e7656b5ae74fc17b97c074eb9275d79e6 100644 (file)
--- a/SL/LXDebug.pm
+++ b/SL/LXDebug.pm
@@ -3,8 +3,10 @@ package LXDebug;
 use constant NONE   => 0;
 use constant INFO   => 1;
 use constant DEBUG1 => 2;
-use constant DEBUG2 => 3;
-use constant QUERY  => 4;
+use constant DEBUG2 => 4;
+use constant QUERY  => 8;
+use constant TRACE  => 16;
+use constant ALL    => 31;
 
 use constant FILE_TARGET   => 0;
 use constant STDERR_TARGET => 1;
@@ -18,7 +20,6 @@ BEGIN {
   $data_dumper_available = $@ ? 0 : 1;
 
   $global_level      = NONE;
-  $global_trace_subs = 0;
 }
 
 sub new {
@@ -29,7 +30,6 @@ sub new {
   $self->{"file"}       = "/tmp/lx-office-debug.log";
   $self->{"target"}     = FILE_TARGET;
   $self->{"level"}      = 0;
-  $self->{"trace_subs"} = 0;
 
   while ($_[0]) {
     $self->{ $_[0] } = $_[1];
@@ -54,23 +54,20 @@ sub set_target {
 
 sub enter_sub {
   my ($self, $level) = @_;
+  $level *= 1;
 
-  return 1 if $global_trace_subs < $level;
-
-  if (!$self->{"trace_subs"} && !$global_trace_subs) {
-    return 1;
-  }
+  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
 
   my ($package, $filename, $line, $subroutine) = caller(1);
   my ($dummy1, $self_filename, $self_line) = caller(0);
 
-  my $indent = " " x $self->{"calldepth"};
-  $self->{"calldepth"} += 1;
+  my $indent = " " x $self->{"calldepth"}++;
 
   if (!defined($package)) {
-    $self->_write('sub', $indent . "\\ top-level?\n");
+    $self->_write('sub' . $level, $indent . "\\ top-level?\n");
   } else {
-    $self->_write('sub', $indent
+    $self->_write('sub' . $level, $indent
                     . "\\ ${subroutine} in "
                     . "${self_filename}:${self_line} called from "
                     . "${filename}:${line}\n");
@@ -80,42 +77,27 @@ sub enter_sub {
 
 sub leave_sub {
   my ($self, $level) = @_;
+  $level *= 1;
 
-  return 1 if $global_trace_subs < $level;
-
-  if (!$self->{"trace_subs"} && !$global_trace_subs) {
-    return 1;
-  }
+  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
 
   my ($package, $filename, $line, $subroutine) = caller(1);
   my ($dummy1, $self_filename, $self_line) = caller(0);
 
-  $self->{"calldepth"} -= 1;
-  my $indent = " " x $self->{"calldepth"};
+  my $indent = " " x --$self->{"calldepth"};
 
   if (!defined($package)) {
-    $self->_write('sub', $indent . "/ top-level?\n");
+    $self->_write('sub' . $level, $indent . "/ top-level?\n");
   } else {
-    $self->_write('sub', $indent . "/ ${subroutine} in " . "${self_filename}:${self_line}\n");
+    $self->_write('sub' . $level, $indent . "/ ${subroutine} in " . "${self_filename}:${self_line}\n");
   }
   return 1;
 }
 
 sub message {
   my ($self, $level, $message) = @_;
-  my ($log_level) = $self->{"level"};
-
-  if ($global_level && ($global_level > $log_level)) {
-    $log_level = $global_level;
-  }
-
-  if ($log_level >= $level) {
-    $self->_write(INFO   == $level ? "info"
-                : DEBUG1 == $level ? "debug1" 
-                : DEBUG2 == $level ? "debug2"
-                : QUERY  == $level ? "query":"",
-                $message );
-  }
+  $self->_write(level2string($level), $message) if (($self->{"level"} | $global_level) & $level);
 }
 
 sub dump {
@@ -132,12 +114,12 @@ sub dump {
 
 sub enable_sub_tracing {
   my ($self) = @_;
-  $self->{"trace_subs"} = 1;
+  $self->{level} | TRACE;
 }
 
 sub disable_sub_tracing {
   my ($self) = @_;
-  $self->{"trace_subs"} = 0;
+  $self->{level} & ~ TRACE;
 }
 
 sub _write {
@@ -157,4 +139,9 @@ sub _write {
   }
 }
 
+sub level2string {
+  # use $_[0] as a bit mask and return levelstrings separated by /
+  join '/', qw(info debug1 debug2 query trace)[ grep { (reverse split //, sprintf "%05b", $_[0])[$_] } 0..4 ]
+}
+
 1;

diff --git a/lx-erp.conf b/lx-erp.conf
index 515daba9679d9993c53da22f9ed0680f1983c008..6818572e11ec9a512f901865bd0682ff89a0de96 100644 (file)
--- a/lx-erp.conf
+++ b/lx-erp.conf
@@ -71,9 +71,17 @@ $dbcharset = "ISO-8859-15";
 
 
 # Globale Debug-Ausgaben (de-)aktivieren? Moegliche Werte sind
-# LXDebug::NONE, LXDebug::INFO, LXDebug::DEBUG1, LXDebug::DEBUG2, LXDebug::QUERY
+# LXDebug::NONE   - keine Debugausgaben
+# LXDebug::INFO
+# LXDebug::DEBUG1 
+# LXDebug::DEBUG2 
+# LXDebug::QUERY  - SQL Queries 
+# LXDebug::TRACE  - Tracing von Funktionsaufrufen
+# LXDebug::ALL    - alle Debugausgaben
+#
+# Beipiel: 
+#   $LXDebug::global_level = LXDebug::TRACE | LXDebug::QUERY;
 $LXDebug::global_level = LXDebug::NONE;
-$LXDebug::global_trace_subs = 0;
 
 1;