From bce420e0f499519a4913db53275b8b1c682c99d7 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Sven=20Sch=C3=B6ling?= <s.schoeling@linet-services.de>
Date: Fri, 9 Mar 2007 15:21:51 +0000
Subject: [PATCH] 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.
---
 SL/DBUtils.pm |  1 +
 SL/LXDebug.pm | 61 ++++++++++++++++++++-------------------------------
 lx-erp.conf   | 12 ++++++++--
 3 files changed, 35 insertions(+), 39 deletions(-)

diff --git a/SL/DBUtils.pm b/SL/DBUtils.pm
index 4336446fa..78a381775 100644
--- 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 10536c098..1071ef3e7 100644
--- 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 515daba96..6818572e1 100644
--- 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;
 
-- 
2.20.1