view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

=head1 NAME
    
Changes - List of significant changes to Apache::Status::DBI
    
As of $Date: 2007-03-23 13:48:54 +0000 (Fri, 23 Mar 2007) $

$Revision: 9845 $

=head2 Changes in 1.012 (svn rev 9845),  16th August 2007

  Fixed escape_html for mod_perl2
  Tweaked auto detection of mod_perl2 when MOD_PERL_API_VERSION not set.

=head2 Changes in 1.011 (svn rev 9802),  26th July 2007

  Add mod_perl2 support, thanks to Philip M. Gollucci
  Improve err formatting to show Info and Warn states
  Remove need for version module.

=head2 Changes in 1.00 (svn rev 9324),  24th March 2007

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

# if MOD_PERL_API_VERSION env var exists then use it to determine mod_perl v1 or v2
# if not, then assume mod_perl v2 if we can load mod_perl2 module
use constant MP2 => (exists $ENV{MOD_PERL_API_VERSION})
        ? ($ENV{MOD_PERL_API_VERSION} >= 2)
        : eval { require mod_perl2 };

BEGIN {
    if (MP2) {
        require mod_perl2;
        require Apache2::Module;
        *escape_html = sub {
            my $s = shift;
            $s =~ s/&/&/g;
            $s =~ s/</&lt;/g;
            $s =~ s/>/&gt;/g;
            return $s;
        }
    }
    else {
        require Apache;
        require Apache::Util;
        Apache::Util->import(qw(escape_html));
    }
}

my %apache_status_menu_items = (
    DBI_handles => [ 'DBI Handles', \&apache_status_dbi_handles ],
);
my $apache_status_class;
if (MP2) {
    $apache_status_class = "Apache2::Status" if Apache2::Module::loaded('Apache2::Status');
}

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

    }
    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;
        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, 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;
    if (defined( my $err = $h->err )) {
        push @s, sprintf "%s%s %s %s\n", $pad,
            ($err ? "Error" : length($err) ? "Warning" : "Information"),
            $err, escape_html($h->errstr);
    }
    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 { _apache_status_dbi_handle($_, $level + 1) } @children;

    return @s;
}