Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision bce420e0

Von Sven Schöling vor fast 18 Jahren hinzugefügt

  • ID bce420e0f499519a4913db53275b8b1c682c99d7
  • Vorgänger 529c6ea4
  • Nachfolger e0f7d45d

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.

Unterschiede anzeigen:

SL/DBUtils.pm
33 33 
    $dbh->do($query, undef, @_) ||
34 34 
      $form->dberror($query . " (" . join(", ", @_) . ")");
35 35 
  }
36 
  dump_query(LXDebug::QUERY, '', $query . " (" . join(", ", @_) . ")");
36 37 
}
37 38 

  		




  38
  39
  
    
sub selectrow_query {


  		












  

    
      SL/LXDebug.pm
    
  





  3
  3
  
    
use constant NONE   => 0;


  		




  4
  4
  
    
use constant INFO   => 1;


  		




  5
  5
  
    
use constant DEBUG1 => 2;


  		




  6
  
  
    
use constant DEBUG2 => 3;


  		




  7
  
  
    
use constant QUERY  => 4;


  		




  
  6
  
    
use constant DEBUG2 => 4;


  		




  
  7
  
    
use constant QUERY  => 8;


  		




  
  8
  
    
use constant TRACE  => 16;


  		




  
  9
  
    
use constant ALL    => 31;


  		




  8
  10
  
    

  		




  9
  11
  
    
use constant FILE_TARGET   => 0;


  		




  10
  12
  
    
use constant STDERR_TARGET => 1;


  		




  ......




  18
  20
  
    
  $data_dumper_available = $@ ? 0 : 1;


  		




  19
  21
  
    

  		




  20
  22
  
    
  $global_level      = NONE;


  		




  21
  
  
    
  $global_trace_subs = 0;


  		




  22
  23
  
    
}


  		




  23
  24
  
    

  		




  24
  25
  
    
sub new {


  		




  ......




  29
  30
  
    
  $self->{"file"}       = "/tmp/lx-office-debug.log";


  		




  30
  31
  
    
  $self->{"target"}     = FILE_TARGET;


  		




  31
  32
  
    
  $self->{"level"}      = 0;


  		




  32
  
  
    
  $self->{"trace_subs"} = 0;


  		




  33
  33
  
    

  		




  34
  34
  
    
  while ($_[0]) {


  		




  35
  35
  
    
    $self->{ $_[0] } = $_[1];


  		




  ......




  54
  54
  
    

  		




  55
  55
  
    
sub enter_sub {


  		




  56
  56
  
    
  my ($self, $level) = @_;


  		




  
  57
  
    
  $level *= 1;


  		




  57
  58
  
    

  		




  58
  
  
    
  return 1 if $global_trace_subs < $level;


  		




  59
  
  
    

  		




  60
  
  
    
  if (!$self->{"trace_subs"} && !$global_trace_subs) {


  		




  61
  
  
    
    return 1;


  		




  62
  
  
    
  }


  		




  
  59
  
    
  return 1 unless ($global_level & TRACE);          # ignore if traces aren't active


  		




  
  60
  
    
  return 1 if $level && !($global_level & $level);  # ignore if level of trace isn't active


  		




  63
  61
  
    

  		




  64
  62
  
    
  my ($package, $filename, $line, $subroutine) = caller(1);


  		




  65
  63
  
    
  my ($dummy1, $self_filename, $self_line) = caller(0);


  		




  66
  64
  
    

  		




  67
  
  
    
  my $indent = " " x $self->{"calldepth"};


  		




  68
  
  
    
  $self->{"calldepth"} += 1;


  		




  
  65
  
    
  my $indent = " " x $self->{"calldepth"}++;


  		




  69
  66
  
    

  		




  70
  67
  
    
  if (!defined($package)) {


  		




  71
  
  
    
    $self->_write('sub', $indent . "\\ top-level?\n");


  		




  
  68
  
    
    $self->_write('sub' . $level, $indent . "\\ top-level?\n");


  		




  72
  69
  
    
  } else {


  		




  73
  
  
    
    $self->_write('sub', $indent


  		




  
  70
  
    
    $self->_write('sub' . $level, $indent


  		




  74
  71
  
    
                    . "\\ ${subroutine} in "


  		




  75
  72
  
    
                    . "${self_filename}:${self_line} called from "


  		




  76
  73
  
    
                    . "${filename}:${line}\n");


  		




  ......




  80
  77
  
    

  		




  81
  78
  
    
sub leave_sub {


  		




  82
  79
  
    
  my ($self, $level) = @_;


  		




  
  80
  
    
  $level *= 1;


  		




  83
  81
  
    

  		




  84
  
  
    
  return 1 if $global_trace_subs < $level;


  		




  85
  
  
    

  		




  86
  
  
    
  if (!$self->{"trace_subs"} && !$global_trace_subs) {


  		




  87
  
  
    
    return 1;


  		




  88
  
  
    
  }


  		




  
  82
  
    
  return 1 unless ($global_level & TRACE);           # ignore if traces aren't active


  		




  
  83
  
    
  return 1 if $level && !($global_level & $level);   # ignore if level of trace isn't active


  		




  89
  84
  
    

  		




  90
  85
  
    
  my ($package, $filename, $line, $subroutine) = caller(1);


  		




  91
  86
  
    
  my ($dummy1, $self_filename, $self_line) = caller(0);


  		




  92
  87
  
    

  		




  93
  
  
    
  $self->{"calldepth"} -= 1;


  		




  94
  
  
    
  my $indent = " " x $self->{"calldepth"};


  		




  
  88
  
    
  my $indent = " " x --$self->{"calldepth"};


  		




  95
  89
  
    

  		




  96
  90
  
    
  if (!defined($package)) {


  		




  97
  
  
    
    $self->_write('sub', $indent . "/ top-level?\n");


  		




  
  91
  
    
    $self->_write('sub' . $level, $indent . "/ top-level?\n");


  		




  98
  92
  
    
  } else {


  		




  99
  
  
    
    $self->_write('sub', $indent . "/ ${subroutine} in " . "${self_filename}:${self_line}\n");


  		




  
  93
  
    
    $self->_write('sub' . $level, $indent . "/ ${subroutine} in " . "${self_filename}:${self_line}\n");


  		




  100
  94
  
    
  }


  		




  101
  95
  
    
  return 1;


  		




  102
  96
  
    
}


  		




  103
  97
  
    

  		




  104
  98
  
    
sub message {


  		




  105
  99
  
    
  my ($self, $level, $message) = @_;


  		




  106
  
  
    
  my ($log_level) = $self->{"level"};


  		




  107
  
  
    

  		




  108
  
  
    
  if ($global_level && ($global_level > $log_level)) {


  		




  109
  
  
    
    $log_level = $global_level;


  		




  110
  
  
    
  }


  		




  111
  
  
    

  		




  112
  
  
    
  if ($log_level >= $level) {


  		




  113
  
  
    
    $self->_write(INFO   == $level ? "info"


  		




  114
  
  
    
                : DEBUG1 == $level ? "debug1" 


  		




  115
  
  
    
                : DEBUG2 == $level ? "debug2"


  		




  116
  
  
    
                : QUERY  == $level ? "query":"",


  		




  117
  
  
    
                $message );


  		




  118
  
  
    
  }


  		




  
  100
  
    
  $self->_write(level2string($level), $message) if (($self->{"level"} | $global_level) & $level);


  		




  119
  101
  
    
}


  		




  120
  102
  
    

  		




  121
  103
  
    
sub dump {


  		




  ......




  132
  114
  
    

  		




  133
  115
  
    
sub enable_sub_tracing {


  		




  134
  116
  
    
  my ($self) = @_;


  		




  135
  
  
    
  $self->{"trace_subs"} = 1;


  		




  
  117
  
    
  $self->{level} | TRACE;


  		




  136
  118
  
    
}


  		




  137
  119
  
    

  		




  138
  120
  
    
sub disable_sub_tracing {


  		




  139
  121
  
    
  my ($self) = @_;


  		




  140
  
  
    
  $self->{"trace_subs"} = 0;


  		




  
  122
  
    
  $self->{level} & ~ TRACE;


  		




  141
  123
  
    
}


  		




  142
  124
  
    

  		




  143
  125
  
    
sub _write {


  		




  ......




  157
  139
  
    
  }


  		




  158
  140
  
    
}


  		




  159
  141
  
    

  		




  
  142
  
    
sub level2string {


  		




  
  143
  
    
  # use $_[0] as a bit mask and return levelstrings separated by /


  		




  
  144
  
    
  join '/', qw(info debug1 debug2 query trace)[ grep { (reverse split //, sprintf "%05b", $_[0])[$_] } 0..4 ]


  		




  
  145
  
    
}


  		




  
  146
  
    

  		




  160
  147
  
    
1;


  		












  

    
      lx-erp.conf
    
  





  71
  71
  
    

  		




  72
  72
  
    

  		




  73
  73
  
    
# Globale Debug-Ausgaben (de-)aktivieren? Moegliche Werte sind


  		




  74
  
  
    
# LXDebug::NONE, LXDebug::INFO, LXDebug::DEBUG1, LXDebug::DEBUG2, LXDebug::QUERY


  		




  
  74
  
    
# LXDebug::NONE   - keine Debugausgaben


  		




  
  75
  
    
# LXDebug::INFO


  		




  
  76
  
    
# LXDebug::DEBUG1 


  		




  
  77
  
    
# LXDebug::DEBUG2 


  		




  
  78
  
    
# LXDebug::QUERY  - SQL Queries 


  		




  
  79
  
    
# LXDebug::TRACE  - Tracing von Funktionsaufrufen


  		




  
  80
  
    
# LXDebug::ALL    - alle Debugausgaben


  		




  
  81
  
    
#


  		




  
  82
  
    
# Beipiel: 


  		




  
  83
  
    
#   $LXDebug::global_level = LXDebug::TRACE | LXDebug::QUERY;


  		




  75
  84
  
    
$LXDebug::global_level = LXDebug::NONE;


  		




  76
  
  
    
$LXDebug::global_trace_subs = 0;


  		




  77
  85
  
    

  		




  78
  86
  
    
1;


  		




  79
  87
  
    

  		












Auch abrufbar als:  Unified diff