}
sub do_query {
+ $main::lxdebug->enter_sub(2);
+
my ($form, $dbh, $query) = splice(@_, 0, 3);
dump_query(LXDebug::QUERY, '', $query, @_);
$dbh->do($query, undef, @_) ||
$form->dberror($query . " (" . join(", ", @_) . ")");
}
+
+ $main::lxdebug->leave_sub(2);
}
sub selectrow_query { &selectfirst_array_query }
sub do_statement {
+ $main::lxdebug->enter_sub(2);
+
my ($form, $sth, $query) = splice(@_, 0, 3);
dump_query(LXDebug::QUERY, '', $query, @_);
$sth->execute(@_) ||
$form->dberror($query . " (" . join(", ", @_) . ")");
}
+
+ $main::lxdebug->leave_sub(2);
}
sub dump_query {
}
sub prepare_query {
+ $main::lxdebug->enter_sub(2);
+
my ($form, $dbh, $query) = splice(@_, 0, 3);
dump_query(LXDebug::QUERY, '', $query, @_);
my $sth = $dbh->prepare($query) || $form->dberror($query);
+
+ $main::lxdebug->leave_sub(2);
+
return $sth;
}
sub prepare_execute_query {
+ $main::lxdebug->enter_sub(2);
+
my ($form, $dbh, $query) = splice(@_, 0, 3);
dump_query(LXDebug::QUERY, '', $query, @_);
$sth->execute() || $form->dberror($query);
}
+ $main::lxdebug->leave_sub(2);
+
return $sth;
}
sub selectall_hashref_query {
+ $main::lxdebug->enter_sub(2);
+
my ($form, $dbh, $query) = splice(@_, 0, 3);
my $sth = prepare_execute_query($form, $dbh, $query, @_);
}
$sth->finish();
+ $main::lxdebug->leave_sub(2);
+
return $result;
}
sub selectall_array_query {
+ $main::lxdebug->enter_sub(2);
+
my ($form, $dbh, $query) = splice(@_, 0, 3);
my $sth = prepare_execute_query($form, $dbh, $query, @_);
}
$sth->finish();
+ $main::lxdebug->leave_sub(2);
+
return @result;
}
sub selectfirst_hashref_query {
+ $main::lxdebug->enter_sub(2);
+
my ($form, $dbh, $query) = splice(@_, 0, 3);
my $sth = prepare_execute_query($form, $dbh, $query, @_);
my $ref = $sth->fetchrow_hashref();
$sth->finish();
+ $main::lxdebug->leave_sub(2);
+
return $ref;
}
sub selectfirst_array_query {
+ $main::lxdebug->enter_sub(2);
+
my ($form, $dbh, $query) = splice(@_, 0, 3);
my $sth = prepare_execute_query($form, $dbh, $query, @_);
my @ret = $sth->fetchrow_array();
$sth->finish();
+ $main::lxdebug->leave_sub(2);
+
return @ret;
}
package LXDebug;
-use constant NONE => 0;
-use constant INFO => 1;
-use constant DEBUG1 => 2;
-use constant DEBUG2 => 4;
-use constant QUERY => 8;
-use constant TRACE => 16;
-use constant ALL => 31;
+use constant NONE => 0;
+use constant INFO => 1;
+use constant DEBUG1 => 2;
+use constant DEBUG2 => 4;
+use constant QUERY => 8;
+use constant TRACE => 16;
+use constant CALL_TRACE_ON_ERROR => 32;
+use constant ALL => 63;
use constant FILE_TARGET => 0;
use constant STDERR_TARGET => 1;
return 1;
}
+sub full_error_call_trace {
+ my ($self) = @_;
+
+ return 1 unless ($global_level & CALL_TRACE_ON_ERROR);
+
+ $self->message(CALL_TRACE_ON_ERROR, "Starting full caller dump:");
+ my $level = 0;
+ while (my ($dummy, $filename, $line, $subroutine) = caller $level) {
+ $self->message(CALL_TRACE_ON_ERROR, "${subroutine} from ${filename}:${line}");
+ $level++;
+ }
+
+ return 1;
+}
+
sub message {
my ($self, $level, $message) = @_;
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 ]
+ join '/', qw(info debug1 debug2 query trace error_call_trace)[ grep { (reverse split //, sprintf "%05b", $_[0])[$_] } 0..5 ]
}
1;