Author: timbo
Date: Wed Mar 21 06:00:26 2007
New Revision: 9288
Modified:
dbi/trunk/Changes
dbi/trunk/lib/DBI/Gofer/Transport/mod_perl.pm
Log:
Polish up Apache::Status output
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Wed Mar 21 06:00:26 2007
@@ -7,27 +7,23 @@
=cut
Extract http transport into new distribution.
-
-Add trace modules that just records the last N trace messages into an array
-and prepends them to any error message.
-
Ping via policy!
-
Add attr-passthru to prepare()?
Terminology for client and server ends
I could make the short transport/policy name do a lookup in both
DBD::Gofer::Transport and DBIx::Gofer::Transport.
Document user/passwd issues at the various levels of the stack
-is_sth_request via dbh_method_call->[0] =~ /^prepare/?
Policy for dbh attr FETCH (ie example_driver_path)
or piggyback on skip_connect_check
could also remember which attr have been returned to us
so not bother FETCHing them (unless pedantic)
Refactor http transport like the others re timeout
Call method on transport timeout so transport can cleanup/reset it it wants
-XXX quote policy control
-prepare(...,{ Err=>\my $isolated_err, ...})
+
Profile: autoderef Path elements that are refs (ref to scalar & ref to array)
to make it cheap to gather path 'dynamically' from existing dynamic values
+prepare(...,{ Err=>\my $isolated_err, ...})
+Add trace modules that just records the last N trace messages into an array
+and prepends them to any error message.
=head2 Changes in DBI 1.55 (svn rev XXX), XXX
Modified: dbi/trunk/lib/DBI/Gofer/Transport/mod_perl.pm
==============================================================================
--- dbi/trunk/lib/DBI/Gofer/Transport/mod_perl.pm (original)
+++ dbi/trunk/lib/DBI/Gofer/Transport/mod_perl.pm Wed Mar 21 06:00:26 2007
@@ -129,12 +129,12 @@
}
-# prepare menu item for Apache::Status
+# XXX --- these should be moved into a separate module (Apache::Status::DBI?)
+# menu item for Apache::Status
sub gofer_status_function {
my($r, $q) = @_;
my @s = ("<pre>",
- "<b>DBI $VERSION Drivers, Connections and Statements</b><p>\n",
-
+ "<b>DBI $DBI::VERSION - Drivers, Connections and Statements</b><p>\n",
);
my %drivers = DBI->installed_drivers();
@@ -148,34 +148,65 @@
scalar @children, scalar keys %{$h->{CachedKids}||{}},
$h->{ActiveKids};
@children = sort { ($a->{Name}||"$a") cmp ($b->{Name}||"$b") }
@children;
- push @s, show_dbi_handle($_, 0) for @children;
+ push @s, show_dbi_handle($_, 1) for @children;
}
- push @s, "</pre>";
+ push @s, "<hr></pre>";
return [EMAIL PROTECTED];
}
sub show_dbi_handle {
my ($h, $level) = @_;
- $level ||= 0;
- my @s;
+ my $pad = " " x $level;
my $type = $h->{Type};
my @children = grep { defined } @{$h->{ChildHandles}};
+ my @boolean_attr = qw(
+ Active Executed RaiseError PrintError ShowErrorStatement PrintWarn
+ CompatMode InactiveDestroy HandleError HandleSetErr
+ ChopBlanks LongTruncOk TaintIn TaintOut Profile);
+ my @scalar_attr = qw(
+ ErrCount TraceLevel FetchHashKeyName LongReadLen
+ );
+ my @scalar_attr2 = qw();
+
+ my @s;
if ($type eq 'db') {
- push @s, sprintf "DSN \"%s\" <font size=-2 color=grey>$h</font>\n",
$h->{Name};
- push @s, sprintf " Error: %s %s\n",
- $h->err, escape_html($h->errstr) if $h->err;
- my $sql = escape_html($h->{Statement} || ''); $sql =~ s/\n/ /g;
- push @s, sprintf " Statement: $sql\n" if $sql;
- push @s, sprintf " sth: %d (%d cached, %d active)\n",
- scalar @children, scalar keys %{$h->{CachedKids}||{}},
$h->{ActiveKids};
- push @s, "\n";
+ push @s, sprintf "DSN \"<b>%s</b>\" <font size=-2
color=grey>%s</font>\n", $h->{Name}, $h;
@children = sort { ($a->{Statement}||"$a") cmp ($b->{Statement}||"$b")
} @children;
+ push @boolean_attr, qw(AutoCommit);
+ push @scalar_attr, qw(Username);
}
else {
- push @s, sprintf "%sh %s %s\n", $h->{Type}, "\t" x $level, $h;
+ push @s, sprintf " sth <font size=-2 color=grey>%s</font>\n", $h;
+ push @scalar_attr2, qw(NUM_OF_PARAMS NUM_OF_FIELDS CursorName);
+ }
+
+ push @s, sprintf "%sAttributes: %s\n", $pad,
+ join ", ", grep { $h->{$_} } @boolean_attr;
+ push @s, sprintf "%sAttributes: %s\n", $pad,
+ join ", ", map { "$_=".DBI::neat($h->{$_}) } @scalar_attr;
+ if (my $sql = escape_html($h->{Statement} || '')) {
+ $sql =~ s/\n/ /g;
+ push @s, sprintf "%sStatement: <b>%s</b>\n", $pad, $sql;
+ my $ParamValues = $type eq 'st' && $h->{ParamValues};
+ push @s, sprintf "%sParamValues: %s\n", $pad,
+ join ", ", map { "$_=".DBI::neat($ParamValues->{$_}) } sort
keys %$ParamValues
+ if $ParamValues && %$ParamValues;
}
- push @s, show_dbi_handle($_, $level + 1) for @children;
+ push @s, sprintf "%sAttributes: %s\n", $pad,
+ join ", ", map { "$_=".DBI::neat($h->{$_}) } @scalar_attr2
+ if @scalar_attr2;
+ push @s, sprintf "%sRows: %s\n", $pad, $h->rows
+ if $type eq 'st' || $h->rows != -1;
+ push @s, sprintf "%sError: %s %s\n", $pad,
+ $h->err, escape_html($h->errstr) if $h->err;
+ push @s, sprintf " sth: %d (%d cached, %d active)\n",
+ scalar @children, scalar keys %{$h->{CachedKids}||{}}, $h->{ActiveKids}
+ if @children;
+ push @s, "\n";
+
+ push @s, map { show_dbi_handle($_, $level + 1) } @children;
+
return @s;
}
