Author: timbo
Date: Tue Mar 20 07:46:45 2007
New Revision: 9285
Modified:
dbi/trunk/lib/DBD/Gofer.pm
dbi/trunk/lib/DBI/Gofer/Request.pm
dbi/trunk/lib/DBI/Gofer/Response.pm
dbi/trunk/lib/DBI/Gofer/Transport/Base.pm
Log:
Give less verbose outut for DB?_GOFER_TRACE=1
Modified: dbi/trunk/lib/DBD/Gofer.pm
==============================================================================
--- dbi/trunk/lib/DBD/Gofer.pm (original)
+++ dbi/trunk/lib/DBD/Gofer.pm Tue Mar 20 07:46:45 2007
@@ -457,7 +457,7 @@
my $request = $sth->{go_request};
$request->init_request($sth->{go_prepare_call}, undef);
- $request->sth_method_calls($sth->{go_method_calls})
+ $request->sth_method_calls(delete $sth->{go_method_calls})
if $sth->{go_method_calls};
$request->sth_result_attr({}); # (currently) also indicates this is an
sth request
@@ -479,8 +479,6 @@
or die "No response object returned by $transport";
$dbh->{go_response} = $response; # mainly for last_insert_id
- delete $sth->{go_method_calls};
-
if (my $dbh_attributes = $response->dbh_attributes) {
# XXX we don't STORE here, we just stuff the value into the
attribute cache
$dbh->{$_} = $dbh_attributes->{$_}
Modified: dbi/trunk/lib/DBI/Gofer/Request.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Request.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Request.pm Tue Mar 20 07:46:45 2007
@@ -7,6 +7,10 @@
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.
+use strict;
+
+use DBI qw(neat neat_list);
+
use base qw(DBI::Util::_accessor);
our $VERSION = sprintf("0.%06d", q$Revision$ =~ /(\d+)/o);
@@ -48,6 +52,24 @@
$self->dbh_wantarray($wantarray);
}
+sub summary_as_text {
+ my $self = shift;
+ my @s = '';
+
+ my ($dsn, $attr) = @{ $self->connect_args };
+ push @s, "dbh= connect('$dsn', , , { %{$attr||{}} ]} })";
+
+ my ($meth, @args) = @{ $self->dbh_method_call };
+ push @s, sprintf "dbh->%s(%s)", $meth, neat_list([EMAIL PROTECTED]);
+
+ for my $call (@{ $self->sth_method_calls || [] }) {
+ my ($meth, @args) = @$call;
+ push @s, sprintf "sth->%s(%s)", $meth, neat_list([EMAIL PROTECTED]);
+ }
+
+ return join("\n\t", @s) . "\n";
+}
+
1;
=head1 AUTHOR AND COPYRIGHT
Modified: dbi/trunk/lib/DBI/Gofer/Response.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Response.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Response.pm Tue Mar 20 07:46:45 2007
@@ -7,6 +7,10 @@
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.
+use strict;
+
+use DBI qw(neat neat_list);
+
use base qw(DBI::Util::_accessor);
our $VERSION = sprintf("0.%06d", q$Revision$ =~ /(\d+)/o);
@@ -75,6 +79,27 @@
}
+sub summary_as_text {
+ my $self = shift;
+ my ($rv, $err, $errstr, $state) = ($self->{rv}, $self->{err},
$self->{errstr}, $self->{state});
+ my @s = sprintf("rv=%s", (ref $rv) ? "[".neat_list($rv)."]" : $rv);
+ $s[-1] .= sprintf(" err=%s errstr=%s", $err, neat($errstr)) if defined
$err;
+ for my $rs (@{$self->sth_resultsets || []}) {
+ my ($rowset, $err, $errstr, $state)
+ = @{$rs}{qw(rowset err errstr state)};
+ my $summary = "rowset: ";
+ if ($rowset || $rs->{NUM_OF_FIELDS} > 0) {
+ $summary .= sprintf "%d rows, %d columns", scalar @{$rowset||[]},
$rs->{NUM_OF_FIELDS}
+ }
+ if (defined $err) {
+ $summary .= sprintf(", err=%s errstr=%s", $err, neat($errstr))
+ }
+ push @s, $summary;
+ }
+ return join("\n\t", @s). "\n";
+}
+
+
1;
=head1 AUTHOR AND COPYRIGHT
Modified: dbi/trunk/lib/DBI/Gofer/Transport/Base.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Transport/Base.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Transport/Base.pm Tue Mar 20 07:46:45 2007
@@ -66,15 +66,22 @@
sub _dump {
my ($self, $label, $data) = @_;
- require Data::Dumper;
- local $Data::Dumper::Indent = 1;
- local $Data::Dumper::Terse = 1;
- local $Data::Dumper::Useqq = 1;
- local $Data::Dumper::Sortkeys = 1;
- local $Data::Dumper::Quotekeys = 0;
- local $Data::Dumper::Deparse = 0;
- local $Data::Dumper::Purity = 0;
- $self->trace_msg("$label=".Data::Dumper::Dumper($data));
+ if ($self->trace >= 2) {
+ require Data::Dumper;
+ local $Data::Dumper::Indent = 1;
+ local $Data::Dumper::Terse = 1;
+ local $Data::Dumper::Useqq = 1;
+ local $Data::Dumper::Sortkeys = 1;
+ local $Data::Dumper::Quotekeys = 0;
+ local $Data::Dumper::Deparse = 0;
+ local $Data::Dumper::Purity = 0;
+ $self->trace_msg("$label: ".Data::Dumper::Dumper($data));
+ return;
+ }
+ else {
+ my $summary = eval { $data->summary_as_text } || $@ || "no summary
available\n";
+ $self->trace_msg("$label: $summary");
+ }
}
