Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision 4b17bfa8

Von Moritz Bunkus vor mehr als 17 Jahren hinzugefügt

  • ID 4b17bfa891c1dd495558090ef8f558a51222b7a3
  • Vorgänger 8ef6c902
  • Nachfolger 142f7c2c

Mehr Debugmöglichkeiten für DBUtils.pm und allgemein für Fehlersituationen eingeführt, die über $form->error() signalisiert werden.

Unterschiede anzeigen:

SL/DBUtils.pm
29 29 
}
30 30 

  		




  31
  31
  
    
sub do_query {


  		




  
  32
  
    
  $main::lxdebug->enter_sub(2);


  		




  
  33
  
    

  		




  32
  34
  
    
  my ($form, $dbh, $query) = splice(@_, 0, 3);


  		




  33
  35
  
    

  		




  34
  36
  
    
  dump_query(LXDebug::QUERY, '', $query, @_);


  		




  ......




  39
  41
  
    
    $dbh->do($query, undef, @_) ||


  		




  40
  42
  
    
      $form->dberror($query . " (" . join(", ", @_) . ")");


  		




  41
  43
  
    
  }


  		




  
  44
  
    

  		




  
  45
  
    
  $main::lxdebug->leave_sub(2);


  		




  42
  46
  
    
}


  		




  43
  47
  
    

  		




  44
  48
  
    
sub selectrow_query { &selectfirst_array_query }


  		




  45
  49
  
    

  		




  46
  50
  
    
sub do_statement {


  		




  
  51
  
    
  $main::lxdebug->enter_sub(2);


  		




  
  52
  
    

  		




  47
  53
  
    
  my ($form, $sth, $query) = splice(@_, 0, 3);


  		




  48
  54
  
    

  		




  49
  55
  
    
  dump_query(LXDebug::QUERY, '', $query, @_);


  		




  ......




  54
  60
  
    
    $sth->execute(@_) ||


  		




  55
  61
  
    
      $form->dberror($query . " (" . join(", ", @_) . ")");


  		




  56
  62
  
    
  }


  		




  
  63
  
    

  		




  
  64
  
    
  $main::lxdebug->leave_sub(2);


  		




  57
  65
  
    
}


  		




  58
  66
  
    

  		




  59
  67
  
    
sub dump_query {


  		




  ......




  84
  92
  
    
}


  		




  85
  93
  
    

  		




  86
  94
  
    
sub prepare_query {


  		




  
  95
  
    
  $main::lxdebug->enter_sub(2);


  		




  
  96
  
    

  		




  87
  97
  
    
  my ($form, $dbh, $query) = splice(@_, 0, 3);


  		




  88
  98
  
    

  		




  89
  99
  
    
  dump_query(LXDebug::QUERY, '', $query, @_);


  		




  90
  100
  
    

  		




  91
  101
  
    
  my $sth = $dbh->prepare($query) || $form->dberror($query);


  		




  
  102
  
    

  		




  
  103
  
    
  $main::lxdebug->leave_sub(2);


  		




  
  104
  
    

  		




  92
  105
  
    
  return $sth;


  		




  93
  106
  
    
}


  		




  94
  107
  
    

  		




  95
  108
  
    
sub prepare_execute_query {


  		




  
  109
  
    
  $main::lxdebug->enter_sub(2);


  		




  
  110
  
    

  		




  96
  111
  
    
  my ($form, $dbh, $query) = splice(@_, 0, 3);


  		




  97
  112
  
    

  		




  98
  113
  
    
  dump_query(LXDebug::QUERY, '', $query, @_);


  		




  ......




  104
  119
  
    
    $sth->execute() || $form->dberror($query);


  		




  105
  120
  
    
  }


  		




  106
  121
  
    

  		




  
  122
  
    
  $main::lxdebug->leave_sub(2);


  		




  
  123
  
    

  		




  107
  124
  
    
  return $sth;


  		




  108
  125
  
    
}


  		




  109
  126
  
    

  		




  110
  127
  
    
sub selectall_hashref_query {


  		




  
  128
  
    
  $main::lxdebug->enter_sub(2);


  		




  
  129
  
    

  		




  111
  130
  
    
  my ($form, $dbh, $query) = splice(@_, 0, 3);


  		




  112
  131
  
    

  		




  113
  132
  
    
  my $sth = prepare_execute_query($form, $dbh, $query, @_);


  		




  ......




  117
  136
  
    
  }


  		




  118
  137
  
    
  $sth->finish();


  		




  119
  138
  
    

  		




  
  139
  
    
  $main::lxdebug->leave_sub(2);


  		




  
  140
  
    

  		




  120
  141
  
    
  return $result;


  		




  121
  142
  
    
}


  		




  122
  143
  
    

  		




  123
  144
  
    
sub selectall_array_query {


  		




  
  145
  
    
  $main::lxdebug->enter_sub(2);


  		




  
  146
  
    

  		




  124
  147
  
    
  my ($form, $dbh, $query) = splice(@_, 0, 3);


  		




  125
  148
  
    

  		




  126
  149
  
    
  my $sth = prepare_execute_query($form, $dbh, $query, @_);


  		




  ......




  130
  153
  
    
  }


  		




  131
  154
  
    
  $sth->finish();


  		




  132
  155
  
    

  		




  
  156
  
    
  $main::lxdebug->leave_sub(2);


  		




  
  157
  
    

  		




  133
  158
  
    
  return @result;


  		




  134
  159
  
    
}


  		




  135
  160
  
    

  		




  136
  161
  
    
sub selectfirst_hashref_query {


  		




  
  162
  
    
  $main::lxdebug->enter_sub(2);


  		




  
  163
  
    

  		




  137
  164
  
    
  my ($form, $dbh, $query) = splice(@_, 0, 3);


  		




  138
  165
  
    

  		




  139
  166
  
    
  my $sth = prepare_execute_query($form, $dbh, $query, @_);


  		




  140
  167
  
    
  my $ref = $sth->fetchrow_hashref();


  		




  141
  168
  
    
  $sth->finish();


  		




  142
  169
  
    

  		




  
  170
  
    
  $main::lxdebug->leave_sub(2);


  		




  
  171
  
    

  		




  143
  172
  
    
  return $ref;


  		




  144
  173
  
    
}


  		




  145
  174
  
    

  		




  146
  175
  
    
sub selectfirst_array_query {


  		




  
  176
  
    
  $main::lxdebug->enter_sub(2);


  		




  
  177
  
    

  		




  147
  178
  
    
  my ($form, $dbh, $query) = splice(@_, 0, 3);


  		




  148
  179
  
    

  		




  149
  180
  
    
  my $sth = prepare_execute_query($form, $dbh, $query, @_);


  		




  150
  181
  
    
  my @ret = $sth->fetchrow_array();


  		




  151
  182
  
    
  $sth->finish();


  		




  152
  183
  
    

  		




  
  184
  
    
  $main::lxdebug->leave_sub(2);


  		




  
  185
  
    

  		




  153
  186
  
    
  return @ret;


  		




  154
  187
  
    
}


  		




  155
  188
  
    

  		












  

    
      SL/Form.pm
    
  





  258
  258
  
    
sub error {


  		




  259
  259
  
    
  $main::lxdebug->enter_sub();


  		




  260
  260
  
    

  		




  
  261
  
    
  $main::lxdebug->full_error_call_trace();


  		




  
  262
  
    

  		




  261
  263
  
    
  my ($self, $msg) = @_;


  		




  262
  264
  
    
  if ($ENV{HTTP_USER_AGENT}) {


  		




  263
  265
  
    
    $msg =~ s/\n/<br>/g;


  		












  

    
      SL/LXDebug.pm
    
  





  1
  1
  
    
package LXDebug;


  		




  2
  2
  
    

  		




  3
  
  
    
use constant NONE   => 0;


  		




  4
  
  
    
use constant INFO   => 1;


  		




  5
  
  
    
use constant DEBUG1 => 2;


  		




  6
  
  
    
use constant DEBUG2 => 4;


  		




  7
  
  
    
use constant QUERY  => 8;


  		




  8
  
  
    
use constant TRACE  => 16;


  		




  9
  
  
    
use constant ALL    => 31;


  		




  
  3
  
    
use constant NONE                => 0;


  		




  
  4
  
    
use constant INFO                => 1;


  		




  
  5
  
    
use constant DEBUG1              => 2;


  		




  
  6
  
    
use constant DEBUG2              => 4;


  		




  
  7
  
    
use constant QUERY               => 8;


  		




  
  8
  
    
use constant TRACE               => 16;


  		




  
  9
  
    
use constant CALL_TRACE_ON_ERROR => 32;


  		




  
  10
  
    
use constant ALL                 => 63;


  		




  10
  11
  
    

  		




  11
  12
  
    
use constant FILE_TARGET   => 0;


  		




  12
  13
  
    
use constant STDERR_TARGET => 1;


  		




  ......




  99
  100
  
    
  return 1;


  		




  100
  101
  
    
}


  		




  101
  102
  
    

  		




  
  103
  
    
sub full_error_call_trace {


  		




  
  104
  
    
  my ($self) = @_;


  		




  
  105
  
    

  		




  
  106
  
    
  return 1 unless ($global_level & CALL_TRACE_ON_ERROR);


  		




  
  107
  
    

  		




  
  108
  
    
  $self->message(CALL_TRACE_ON_ERROR, "Starting full caller dump:");


  		




  
  109
  
    
  my $level = 0;


  		




  
  110
  
    
  while (my ($dummy, $filename, $line, $subroutine) = caller $level) {


  		




  
  111
  
    
    $self->message(CALL_TRACE_ON_ERROR, "${subroutine} from ${filename}:${line}");


  		




  
  112
  
    
    $level++;


  		




  
  113
  
    
  }


  		




  
  114
  
    

  		




  
  115
  
    
  return 1;


  		




  
  116
  
    
}


  		




  
  117
  
    

  		




  102
  118
  
    
sub message {


  		




  103
  119
  
    
  my ($self, $level, $message) = @_;


  		




  104
  120
  
    

  		




  ......




  146
  162
  
    

  		




  147
  163
  
    
sub level2string {


  		




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


  		




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


  		




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


  		




  150
  166
  
    
}


  		




  151
  167
  
    

  		




  152
  168
  
    
1;


  		












  

    
      lx-erp.conf
    
  





  77
  77
  
    
# LXDebug::DEBUG2 


  		




  78
  78
  
    
# LXDebug::QUERY  - SQL Queries 


  		




  79
  79
  
    
# LXDebug::TRACE  - Tracing von Funktionsaufrufen


  		




  
  80
  
    
# LXDebug::CALL_TRACE_ON_ERROR - Vollst?ndiger Aufrufpfad, wenn $form->error() aufgerufen wird


  		




  80
  81
  
    
# LXDebug::ALL    - alle Debugausgaben


  		




  81
  82
  
    
#


  		




  82
  83
  
    
# Beipiel: 


  		












Auch abrufbar als:  Unified diff