As a test of my new mod_perl abilities I wrote a trivial SQL client.
It works, but if the query returns many rows then it takes a while.
As a first step I thought I would call $r->rflush; with every row
printed but
this does not work. I also tried $|=0; with no effect.
Here is the full module, 100 lines. The rows are printed in getarray
($$)
Any ideas would be appreciated
~quagly
package Sql::Client;
use Apache::Request;
use strict;
use warnings;
use Apache::Constants qw(:common);
my $r; #request
my $apr; #Apache::Request
my $host; #hostname of remote user
my $sql; #sql to execute
sub getarray ($$) {
my $dbh; # Database handle
my $sth; # Statement handle
my $p_sql; # sql statement passed as parameter
my @cols; #column array to bind results
my $titles; # array ref to column headers
my $r; # maybe if I pass the request it will
work
$p_sql = shift;
$r = shift;
# Connect
$dbh = DBI->connect (
"DBI:mysql:links_db::localhost",
"nobody",
"somebody",
{
PrintError => 1, # warn() on errors
RaiseError => 0, # don't die on error
AutoCommit => 1, # commit executes
immediately
}
);
# prepare statment
$sth = $dbh->prepare($p_sql);
$sth->execute;
$titles = $sth->{NAME_uc};
#--------------
# for minimal memory use, do it this way
@cols[0..$#$titles] = ();
$sth->bind_columns(\(@cols));
print "<TABLE BORDER>";
print "<TR>",
map("<TD>$_</TD>",@$titles),
"</TR>";
while ($sth->fetch) {
print "<TR>",
map("<TD>$_</TD>",@cols),
$r->rflush;
}
print "</TABLE>";
return;
}
sub handler {
$r = shift;
$apr = Apache::Request->new($r);
$sql = $apr->param('sql') || 'SELECT';
$sql='SELECT' if $apr->param('reset');
$r->content_type( 'text/html' );
$r->send_http_header;
return OK if $r->header_only;
$host = $r->get_remote_host;
$r->print(<<HTMLEND);
<HTML>
<HEAD>
<LINK REL="stylesheet" TYPE="text/css"
HREF="/styles/lightstyle.css"
>
<TITLE>Hello $host</TITLE>
<BODY>
<H1>Sql Client</H1>
<FORM METHOD="POST">
<P>Enter your Select Statement:
<BR>
<TEXTAREA NAME="sql" ROWS=8 COLS=60 WRAP>$sql</TEXTAREA>
<BR>
<INPUT TYPE="SUBMIT" VALUE="Submit">
<INPUT TYPE="SUBMIT" NAME="reset" VALUE="Reset">
</FORM>
HTMLEND
getarray($sql,$r) unless $sql =~ /^SELECT$/;
$r->print(<<HTMLEND);
</BODY>
</HTML>
HTMLEND
return OK;
}
1;
~
"</TR>";
