# ==================================================================== # Gossamer Threads Module Library - http://gossamer-threads.com/ # # GT::SQL::Monitor # Author: Jason Rhinelander # CVS Info : 087,071,086,086,085 # $Id: Monitor.pm,v 1.7 2008/12/05 01:28:49 brewt Exp $ # # Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved. # ==================================================================== # package GT::SQL::Monitor; use strict; use vars qw/@EXPORT_OK $CSS/; use Carp qw/croak/; use GT::CGI qw/:escape/; require Exporter; @EXPORT_OK = qw/query/; use constant CSS => <<'CSS'; CSS sub query { # ----------------------------------------------------------------------------- # Handles the 'SQL Monitor' function of various Gossamer Threads products. # Takes a hash of options: # table - any GT::SQL table object # style - the style to use - 'tab', 'text' or 'html'; defaults to 'text' # html - ('tab' or 'text' mode) whether values should be HTML escaped and the whole thing surrounded by a
tag
# query - the query to run
# css - if defined, the value will be used for the CSS in 'html' style; otherwise _css() is used
# Returned is a hash reference containing:
# db_prefix - the database prefix currently in use
# style - the value of the 'style' option
# query - the query performed
# rows - the number of rows returned by the query, or possibly the number of rows affected
# results - a scalar reference to the result of the query, if a SELECT/SHOW/sp_*
# error - set to 1 if an error occurred
# error_connect - set to an error message if the database connection failed
# error_prepare - set to an error message if the prepare failed
# error_execute - set to an error message if the execute failed
#
my %opts = @_;
$opts{table} and $opts{query} or croak "query() called without table and/or query options";
$opts{table}->connect or return { error => 1, error_connect => $GT::SQL::error };
my %ret = (
db_prefix => $opts{table}->{connect}->{PREFIX},
style => $opts{style},
query => $opts{query}
);
my $sth = $opts{table}->prepare($opts{query}) or return { %ret, error => 1, error_prepare => $GT::SQL::error };
my $rv = $sth->execute or return { %ret, error => 1, error_execute => $GT::SQL::error };
my $names = $sth->row_names;
$ret{rows} = $sth->rows || 0;
if ($opts{query} =~ /^\s*(SELECT|DESCRIBE|SHOW|EXPLAIN|sp_)/i) {
my $table = '';
my $data = $sth->fetchall_arrayref;
if ($opts{style} and $opts{style} eq 'html') {
$table .= defined $opts{css} ? $opts{css} : CSS;
$table .= qq|' . html_escape($_) . " | \n",
@$names;
$table .= "
|---|
$val | \n|;
}
$table .= "
' : '';
for (@$data) {
my @foo = map html_escape($_), @$_;
$table .= join("\t", $opts{html} ? (map defined $_ ? html_escape($_) : '', @$_) : @$_) . "\n";
}
$table .= "" if $opts{html};
}
else { # style = 'text'
my @max_width = (0) x @$names;
for ($names, @$data) {
for my $i (0 .. $#$_) {
my $width = length $_->[$i];
$max_width[$i] = $width if $width > $max_width[$i];
}
}
$table = join('+', '', map("-" x ($_ + 2), @max_width), '') . "\n";
$table .= '|';
for my $i (0 .. $#$names) {
$table .= sprintf " %-$max_width[$i]s |", $names->[$i];
}
$table .= "\n";
$table .= join('+', '', map("-" x ($_ + 2), @max_width), '') . "\n";
for (@$data) {
$table .= '|';
for my $i (0 .. $#$names) {
$table .= sprintf " %-$max_width[$i]s |", $_->[$i];
}
$table .= "\n";
}
$table .= join('+', '', map("-" x ($_ + 2), @max_width), '') . "\n";
$table = "" . html_escape($table) . "" if $opts{html}; } $ret{results} = \$table; } else { $ret{results} = "Rows affected: $ret{rows}"; } return \%ret; }