First pass at adding key files
This commit is contained in:
dsainty
149
site/slowtwitch.com/cgi-bin/articles/admin/GT/SQL/Monitor.pm
Normal file
149
site/slowtwitch.com/cgi-bin/articles/admin/GT/SQL/Monitor.pm
Normal file
@ -0,0 +1,149 @@
|
||||
# ====================================================================
|
||||
# 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';
|
||||
<style type="text/css">
|
||||
.sql_monitor td {
|
||||
border-bottom: 1px solid rgb(128, 128, 128);
|
||||
border-right: 1px solid rgb(128, 128, 128);
|
||||
padding: 2px;
|
||||
}
|
||||
.sql_monitor th {
|
||||
border-bottom: 2px solid rgb(128, 128, 128);
|
||||
border-right: 1px solid rgb(128, 128, 128);
|
||||
padding: 2px;
|
||||
}
|
||||
table.sql_monitor {
|
||||
border-collapse: collapse;
|
||||
border-left: 2px solid rgb(128, 128, 128);
|
||||
border-top: 2px solid rgb(128, 128, 128);
|
||||
border-bottom: 2px solid rgb(128, 128, 128);
|
||||
border-right: 2px solid rgb(128, 128, 128);
|
||||
}
|
||||
.sql_monitor pre {
|
||||
margin-bottom: 0px;
|
||||
margin-top: 0px;
|
||||
}
|
||||
</style>
|
||||
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 <pre> 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|<table class="sql_monitor">\n|;
|
||||
$table .= " <tr>\n";
|
||||
$table .= join '', map ' <th><pre>' . html_escape($_) . "</pre></th>\n",
|
||||
@$names;
|
||||
$table .= " </tr>\n";
|
||||
for (@$data) {
|
||||
$table .= " <tr>\n";
|
||||
for (@$_) {
|
||||
my $val = html_escape($_);
|
||||
$val .= "<br />" unless $val =~ /\S/;
|
||||
$table .= qq| <td><pre>$val</pre></td>\n|;
|
||||
}
|
||||
$table .= " </tr>\n";
|
||||
}
|
||||
$table .= "</table>";
|
||||
}
|
||||
elsif ($opts{style} and $opts{style} eq 'tabs') {
|
||||
$table = $opts{html} ? '<pre>' : '';
|
||||
for (@$data) {
|
||||
my @foo = map html_escape($_), @$_;
|
||||
$table .= join("\t", $opts{html} ? (map defined $_ ? html_escape($_) : '', @$_) : @$_) . "\n";
|
||||
}
|
||||
$table .= "</pre>" 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 = "<pre>" . html_escape($table) . "</pre>" if $opts{html};
|
||||
}
|
||||
$ret{results} = \$table;
|
||||
}
|
||||
else {
|
||||
$ret{results} = "Rows affected: $ret{rows}";
|
||||
}
|
||||
|
||||
return \%ret;
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user