Trace Levels Hack. Wenn es koennen jetzt in den lxdebug->enter_sub und leave_sub...

Um (derzeit) alle Traceausgaben zu bekommen in der lx-erp.conf $global_trabce_subs = 2; setzen.

Debugausgaben entfernt.

parse_amount, format_amount und round_amount auf tracelevel 2 gesetzt. Trace breaker in parse_amount gefixt.

[Merge der Revisionen 943:945 957 aus dem LINET prog Repo]

diff --git a/SL/Form.pm b/SL/Form.pm
index 1c03e10..80c67fc 100644 (file)
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -40,7 +40,7 @@ package Form;
 use HTML::Template;
 
 sub _input_to_hash {
-  $main::lxdebug->enter_sub();
+  $main::lxdebug->enter_sub(2);
 
   my $input = $_[0];
   my %in    = ();
@@ -51,13 +51,13 @@ sub _input_to_hash {
     $in{$name} = unescape(undef, $value);
   }
 
-  $main::lxdebug->leave_sub();
+  $main::lxdebug->leave_sub(2);
 
   return %in;
 }
 
 sub _request_to_hash {
-  $main::lxdebug->enter_sub();
+  $main::lxdebug->enter_sub(2);
 
   my ($input) = @_;
   my ($i,        $loc,  $key,    $val);
@@ -108,11 +108,11 @@ sub _request_to_hash {
       }
     }
 
-    $main::lxdebug->leave_sub();
+    $main::lxdebug->leave_sub(2);
     return %ATTACH;
 
       } else {
-    $main::lxdebug->leave_sub();
+    $main::lxdebug->leave_sub(2);
     return _input_to_hash($input);
   }
 }
@@ -162,7 +162,7 @@ sub debug {
 }
 
 sub escape {
-  $main::lxdebug->enter_sub();
+  $main::lxdebug->enter_sub(2);
 
   my ($self, $str, $beenthere) = @_;
 
@@ -173,13 +173,13 @@ sub escape {
 
   $str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge;
 
-  $main::lxdebug->leave_sub();
+  $main::lxdebug->leave_sub(2);
 
   return $str;
 }
 
 sub unescape {
-  $main::lxdebug->enter_sub();
+  $main::lxdebug->enter_sub(2);
 
   my ($self, $str) = @_;
 
@@ -188,7 +188,7 @@ sub unescape {
 
   $str =~ s/%([0-9a-fA-Z]{2})/pack("c",hex($1))/eg;
 
-  $main::lxdebug->leave_sub();
+  $main::lxdebug->leave_sub(2);
 
   return $str;
 }
@@ -578,7 +578,7 @@ sub sort_columns {
 }
 
 sub format_amount {
-  $main::lxdebug->enter_sub();
+  $main::lxdebug->enter_sub(2);
 
   my ($self, $myconfig, $amount, $places, $dash) = @_;
 
@@ -643,48 +643,28 @@ sub format_amount {
     }
   }
 
-  $main::lxdebug->leave_sub();
+  $main::lxdebug->leave_sub(2);
 
   return $amount;
 }
 
 sub parse_amount {
-  $main::lxdebug->enter_sub();
+  $main::lxdebug->enter_sub(2);
 
   my ($self, $myconfig, $amount) = @_;
-  $main::lxdebug->message(LXDebug::DEBUG2, "Start amount: $amount");
 
   if ($myconfig->{in_numberformat} == 1) {
-
     # Extra input number format 1000.00 or 1000,00
-    $main::lxdebug->message(LXDebug::DEBUG2,
-              "in_numberformat: " . $main::locale->text('1000,00 or 1000.00'));
     $amount =~ s/,/\./g;
-
-    #$main::lxdebug->message(LXDebug::DEBUG2, "1.Parsed Number: $amount") if ($amount);
     $amount = scalar reverse $amount;
-
-    #$main::lxdebug->message(LXDebug::DEBUG2, "2.Parsed Number: $amount") if ($amount);
     $amount =~ s/\./DOT/;
-
-    #$main::lxdebug->message(LXDebug::DEBUG2, "3.Parsed Number: $amount") if ($amount);
     $amount =~ s/\.//g;
-
-    #$main::lxdebug->message(LXDebug::DEBUG2, "4.Parsed Number: $amount") if ($amount);
     $amount =~ s/DOT/\./;
-
-    #$main::lxdebug->message(LXDebug::DEBUG2, "5.Parsed Number:" . $amount) if ($amount);
     $amount = scalar reverse $amount;
-    $main::lxdebug->message(LXDebug::DEBUG2,
-                            "Parsed amount:" . $amount . "\n");
-
+    $main::lxdebug->leave_sub(2);
     return ($amount * 1);
-
   }
-  $main::lxdebug->message(LXDebug::DEBUG2,
-              "in_numberformat: " . $main::locale->text('equal Outputformat'));
-  $main::lxdebug->message(LXDebug::DEBUG2,
-                          " = numberformat: $myconfig->{numberformat}");
+
   if (   ($myconfig->{numberformat} eq '1.000,00')
       || ($myconfig->{numberformat} eq '1000,00')) {
     $amount =~ s/\.//g;
@@ -697,15 +677,13 @@ sub parse_amount {
 
   $amount =~ s/,//g;
 
-  $main::lxdebug->message(LXDebug::DEBUG2, "Parsed amount:" . $amount . "\n")
-    if ($amount);
-  $main::lxdebug->leave_sub();
+  $main::lxdebug->leave_sub(2);
 
   return ($amount * 1);
 }
 
 sub round_amount {
-  $main::lxdebug->enter_sub();
+  $main::lxdebug->enter_sub(2);
 
   my ($self, $amount, $places) = @_;
   my $round_amount;
@@ -719,7 +697,7 @@ sub round_amount {
   $amount = $amount * (10**($places));
   $round_amount = int($amount + .5 * ($amount <=> 0)) / (10**($places));
 
-  $main::lxdebug->leave_sub();
+  $main::lxdebug->leave_sub(2);
 
   return $round_amount;
 

diff --git a/SL/LXDebug.pm b/SL/LXDebug.pm
index 00116dd..3a56e62 100644 (file)
--- a/SL/LXDebug.pm
+++ b/SL/LXDebug.pm
@@ -53,7 +53,9 @@ sub set_target {
 }
 
 sub enter_sub {
-  my ($self) = @_;
+  my ($self, $level) = @_;
+
+  return if $global_trace_subs < $level;
 
   if (!$self->{"trace_subs"} && !$global_trace_subs) {
     return;
@@ -77,7 +79,9 @@ sub enter_sub {
 }
 
 sub leave_sub {
-  my ($self) = @_;
+  my ($self, $level) = @_;
+
+  return if $global_trace_subs < $level;
 
   if (!$self->{"trace_subs"} && !$global_trace_subs) {
     return;

diff --git a/SL/Menu.pm b/SL/Menu.pm
index 0bdf945..a3fa3e5 100644 (file)
--- a/SL/Menu.pm
+++ b/SL/Menu.pm
@@ -138,7 +138,7 @@ sub menuitemNew {
 }
 
 sub access_control {
-  $main::lxdebug->enter_sub();
+  $main::lxdebug->enter_sub(2);
 
   my ($self, $myconfig, $menulevel) = @_;
 
@@ -161,7 +161,7 @@ sub access_control {
   @a = ();
   map { push @a, $_ unless $excl{$_} } (@menu);
 
-  $main::lxdebug->leave_sub();
+  $main::lxdebug->leave_sub(2);
 
   return @a;
 }

diff --git a/SL/User.pm b/SL/User.pm
index 6ce3c41..2da6216 100644 (file)
--- a/SL/User.pm
+++ b/SL/User.pm
@@ -612,7 +612,7 @@ sub dbneedsupdate {
 
 ## LINET
 sub calc_version {
-  $main::lxdebug->enter_sub();
+  $main::lxdebug->enter_sub(2);
 
   my (@v, $version, $i);
 
@@ -626,7 +626,7 @@ sub calc_version {
     $version += $v[$i];
   }
 
-  $main::lxdebug->leave_sub();
+  $main::lxdebug->leave_sub(2);
   return $version;
 }
 
@@ -733,6 +733,7 @@ sub dbupdate {
       last if ($version < $mindb);
 
       # apply upgrade
+      $main::lxdebug->message(DEBUG2, "Appliying Update $upgradescript");
       $self->process_query($form, $dbh, "sql/" . $form->{"dbdriver"} . "-upgrade/$upgradescript", $str_maxdb);
 
       $version = $maxdb;