Author: timbo
Date: Tue Mar 20 06:38:06 2007
New Revision: 9281
Modified:
dbi/trunk/Changes
dbi/trunk/lib/DBD/Gofer.pm
dbi/trunk/lib/DBI/Gofer/Transport/mod_perl.pm
Log:
For Sybase warn about >9 params (temp) and do proper numeric sorting.
Integrate mod_perl transport with Apache::Status.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Tue Mar 20 06:38:06 2007
@@ -6,6 +6,13 @@
=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.
Modified: dbi/trunk/lib/DBD/Gofer.pm
==============================================================================
--- dbi/trunk/lib/DBD/Gofer.pm (original)
+++ dbi/trunk/lib/DBD/Gofer.pm Tue Mar 20 06:38:06 2007
@@ -438,7 +438,14 @@
# XXX the sort here is a hack to work around a DBD::Sybase bug
# but only works properly for params 1..9
# (reverse because of the unshift)
- for my $p (reverse sort keys %$ParamValues) {
+ my @params = reverse sort keys %$ParamValues;
+ if (@params > 9 && $sth->{Database}{go_dsn} =~ /dbi:Sybase/) {
+ # if more than 9 then we need to do a proper numeric sort
+ # also warn to alert user of this issue
+ warn "Sybase param binding order hack in use";
+ @params = sort { $b <=> $a } @params;
+ }
+ for my $p (@params) {
# unshift to put binds before execute call
unshift @{ $sth->{go_method_calls} },
[ 'bind_param', $p, $ParamValues->{$p}, $ParamAttr->{$p} ];
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 Tue Mar 20 06:38:06 2007
@@ -9,6 +9,7 @@
use constant MP2 => ( exists $ENV{MOD_PERL_API_VERSION} and
$ENV{MOD_PERL_API_VERSION} >= 2 );
BEGIN {
if (MP2) {
+ warn "NOT RECENTLY TESTED";
require Apache2::RequestIO;
require Apache2::RequestRec;
require Apache2::RequestUtil;
@@ -20,6 +21,8 @@
}
}
+use Apache::Util qw(escape_html);
+
use base qw(DBI::Gofer::Transport::Base);
our $VERSION = sprintf("0.%06d", q$Revision$ =~ /(\d+)/o);
@@ -31,6 +34,18 @@
my %executor_cache;
+if (MP2) {
+ if (Apache2::Module::loaded('Apache2::Status')) {
+ Apache2::Status->menu_item('DBI_Gofer' => 'DBI Gofer connections',
\&gofer_status_function);
+ }
+}
+elsif ($INC{'Apache.pm'} # is Apache.pm loaded?
+ and Apache->can('module') # really?
+ and Apache->module('Apache::Status')) { # Apache::Status too?
+ Apache::Status->menu_item('DBI_Gofer' => 'DBI Gofer connections',
\&gofer_status_function);
+}
+
+
sub handler : method {
my $self = shift;
my $r = shift;
@@ -113,6 +128,57 @@
%executor_configs = %$configs;
}
+
+# prepare 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",
+
+ );
+
+ my %drivers = DBI->installed_drivers();
+ push @s, sprintf("%d drivers loaded: %s<p>", scalar keys %drivers, join(",
", keys %drivers));
+
+ while ( my ($driver, $h) = each %drivers) {
+ my $version = do { no strict; ${"DBD::${driver}::VERSION"} || 'undef'
};
+ my @children = grep { defined } @{$h->{ChildHandles}};
+
+ push @s, sprintf "<hr><b>DBD::$driver</b> <font size=-2
color=grey>version $version, %d dbh (%d cached, %d active) $h</font>\n\n",
+ 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, "</pre>";
+ return [EMAIL PROTECTED];
+}
+
+sub show_dbi_handle {
+ my ($h, $level) = @_;
+ $level ||= 0;
+ my @s;
+ my $type = $h->{Type};
+ my @children = grep { defined } @{$h->{ChildHandles}};
+ 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";
+ @children = sort { ($a->{Statement}||"$a") cmp ($b->{Statement}||"$b")
} @children;
+ }
+ else {
+ push @s, sprintf "%sh %s %s\n", $h->{Type}, "\t" x $level, $h;
+ }
+ push @s, show_dbi_handle($_, $level + 1) for @children;
+ return @s;
+}
+
1;
__END__
