Author: timbo
Date: Mon Jun 16 07:52:03 2008
New Revision: 11424
Modified:
dbi/trunk/lib/DBI/Gofer/Request.pm
dbi/trunk/lib/DBI/Gofer/Response.pm
Log:
Add outline_as_text methods to Gofer Request and Response objects
to get one-line summary of request or response objects.
Modified: dbi/trunk/lib/DBI/Gofer/Request.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Request.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Request.pm Mon Jun 16 07:52:03 2008
@@ -151,6 +151,31 @@
return join("\n\t", @s) . "\n";
}
+
+sub outline_as_text { # one-line version of summary_as_text
+ my $self = shift;
+ my @s = '';
+ my $neatlen = 80;
+
+ if (my $flags = $self->flags) {
+ push @s, sprintf "flags=0x%x", $flags;
+ }
+
+ my (undef, $meth, @args) = @{ $self->dbh_method_call };
+ push @s, sprintf "%s(%s)", $meth, neat_list([EMAIL PROTECTED], $neatlen);
+
+ for my $call (@{ $self->sth_method_calls || [] }) {
+ my ($meth, @args) = @$call;
+ push @s, sprintf "%s(%s)", $meth, neat_list([EMAIL PROTECTED],
$neatlen);
+ }
+
+ my ($method, $dsn) = @{ $self->dbh_connect_call };
+ push @s, "$method($dsn,...)"; # dsn last as it's usually less interesting
+
+ (my $outline = join("; ", @s)) =~ s/\s+/ /g; # squish whitespace, incl
newlines
+ return $outline;
+}
+
1;
=head1 NAME
Modified: dbi/trunk/lib/DBI/Gofer/Response.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Response.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Response.pm Mon Jun 16 07:52:03 2008
@@ -153,6 +153,42 @@
}
+sub outline_as_text { # one-line version of summary_as_text
+ my $self = shift;
+ my ($context) = @_;
+
+ my ($rv, $err, $errstr, $state) = ($self->{rv}, $self->{err},
$self->{errstr}, $self->{state});
+
+ my $s = sprintf("rv=%s", (ref $rv) ? "[".neat_list($rv)."]" : neat($rv));
+ $s .= sprintf(", err=%s %s", $err, neat($errstr))
+ if defined $err;
+ $s .= sprintf(", flags=0x%x", $self->{flags})
+ if $self->{flags};
+
+ if (my $sth_resultsets = $self->sth_resultsets) {
+ $s .= sprintf(", %d resultsets ", scalar @$sth_resultsets);
+
+ my @rs;
+ for my $rs (@{$self->sth_resultsets || []}) {
+ my $summary = "";
+ my ($rowset, $err, $errstr)
+ = @{$rs}{qw(rowset err errstr)};
+ my $NUM_OF_FIELDS = $rs->{NUM_OF_FIELDS} || 0;
+ my $rows = $rowset ? @$rowset : 0;
+ if ($rowset || $NUM_OF_FIELDS > 0) {
+ $summary .= sprintf "%dr x %dc", $rows, $NUM_OF_FIELDS;
+ }
+ $summary .= sprintf "%serr %s %s", ($summary?", ":""), $err,
neat($errstr)
+ if defined $err;
+ push @rs, $summary;
+ }
+ $s .= join "; ", map { "[$_]" } @rs;
+ }
+
+ return $s;
+}
+
+
1;
=head1 NAME
