view release on metacpan or  search on metacpan

lib/Apache/Status/DBI.pm  view on Meta::CPAN

        "<b>DBI $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' }; ## no critic
        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, _apache_status_dbi_handle($_, 1) for @children;
    }
    
    push @s, "<hr>";
    push @s, "<font size=-2 color=grey>".__PACKAGE__." $VERSION</font>";
    push @s, "</pre>\n";
    return \@s;
}



sub _apache_status_dbi_handle {
    my ($h, $level) = @_;
    my $pad = "    " x $level;
    my $type = $h->{Type};

lib/Apache/Status/DBI.pm  view on Meta::CPAN

        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 \"<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 "    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;