2995 lines
112 KiB
Perl
2995 lines
112 KiB
Perl
# ==================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::SQL::Admin
|
|
# Author : Scott Beck
|
|
# CVS Info : 087,071,086,086,085
|
|
# $Id: Admin.pm,v 1.161 2009/05/11 22:57:15 brewt Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ==================================================================
|
|
#
|
|
# Description:
|
|
# Used to create a basic admin area for the most common admin
|
|
# setup. For anything more complex use the Display modules
|
|
# individually. This also proves an excelent example of
|
|
# how to use the HTML module.
|
|
#
|
|
|
|
package GT::SQL::Admin;
|
|
# ===================================================================
|
|
use strict;
|
|
use GT::Base;
|
|
use GT::AutoLoader;
|
|
use GT::CGI;
|
|
use GT::SQL;
|
|
use GT::SQL::Display::HTML;
|
|
|
|
use vars qw/
|
|
@ISA $DEBUG $VERSION $ERROR_MESSAGE $ATTRIBS
|
|
$BAR_COLOR $BAR_FONT $TITLE_FONT $FONT $BODY
|
|
$ROW_COLOR1 $ROW_COLOR2 %ACTION
|
|
/;
|
|
|
|
# Possible arguments to new
|
|
$ATTRIBS = {
|
|
header => undef,
|
|
footer => undef,
|
|
start_form => undef,
|
|
end_form => undef,
|
|
start_html => undef,
|
|
end_html => undef,
|
|
record => undef
|
|
};
|
|
|
|
# Error messages are stored in GT::SQL.
|
|
@ISA = qw/GT::Base/;
|
|
$ERROR_MESSAGE = 'GT::SQL';
|
|
$DEBUG = 0;
|
|
$VERSION = sprintf "%d.%03d", q$Revision: 1.161 $ =~ /(\d+)\.(\d+)/;
|
|
|
|
# Some default HTML attributes.
|
|
$BODY = 'bgcolor="#FFFFFF"';
|
|
$BAR_COLOR = 'navy';
|
|
$BAR_FONT = "face='Arial' size='2' color='#FFFFFF'";
|
|
$TITLE_FONT = "face='Arial' size='2' color='#000000'";
|
|
$FONT = "face='Tahoma,Arial,Helvetica' size='2' color='#000000'";
|
|
$ROW_COLOR1 = 'bgcolor="#dddddd"';
|
|
$ROW_COLOR2 = 'bgcolor="#eeeeee"';
|
|
|
|
%ACTION = (
|
|
add_form => 1,
|
|
add_record => 1,
|
|
add_success => 1,
|
|
delete_records => 1,
|
|
delete_results => 1,
|
|
delete_search_form => 1,
|
|
delete_search_results => 1,
|
|
download_file => 1,
|
|
edit_table_def => 1,
|
|
editor_add_field => 1,
|
|
editor_add_field_form => 1,
|
|
editor_column_checks => 1,
|
|
editor_column_form => 1,
|
|
editor_column_help => 1,
|
|
editor_columns => 1,
|
|
editor_delete_field => 1,
|
|
editor_delete_field_form => 1,
|
|
editor_export_data => 1,
|
|
editor_export_data_form => 1,
|
|
editor_import_data => 1,
|
|
editor_import_data_form => 1,
|
|
editor_modify_columns => 1,
|
|
editor_table_form => 1,
|
|
editor_update_def => 1,
|
|
modify_error => 1,
|
|
modify_form => 1,
|
|
modify_multi_records => 1,
|
|
modify_multi_results => 1,
|
|
modify_multi_search_results => 1,
|
|
modify_record => 1,
|
|
modify_search_form => 1,
|
|
modify_search_results => 1,
|
|
modify_success => 1,
|
|
search_form => 1,
|
|
search_results => 1,
|
|
view_file => 1
|
|
);
|
|
|
|
# ================================================================================ #
|
|
# SIMPLE INTERFACE #
|
|
# ================================================================================ #
|
|
|
|
##
|
|
# $obj->process($defs, $in);
|
|
# --------------------
|
|
# $defs must be the full path to the directory
|
|
# the definition file GT::SQL created.
|
|
# $in is a cgi object. This will process
|
|
# the cgi object from the forms it created.
|
|
# The proper changes will then be made and the
|
|
# results shown to the user.
|
|
# You should call this after testing to see if
|
|
# the input from the cgi is for_me.
|
|
##
|
|
sub process {
|
|
my $self = shift;
|
|
$self->initialize(@_) or return;
|
|
|
|
# Find out what we are doing.
|
|
my $action = $self->{cgi}->{do};
|
|
if (exists $ACTION{$action}) {
|
|
$self->$action();
|
|
# print "<p><pre>QUERY STACK: ", GT::SQL->query_stack_disp, "</pre>"; # if ($self->{_debug});
|
|
}
|
|
else {
|
|
# ERROR they should have called for_me to see if there was an action for me :)
|
|
return $self->error('NOACTION', 'FATAL', $action);
|
|
}
|
|
}
|
|
|
|
sub initialize {
|
|
my ($self, @in) = @_;
|
|
|
|
# Find out what we have, and store the CGI values in self->{cgi}.
|
|
my $opt = $self->common_param(@in) or return $self->error("BADARGS", 'FATAL', '$obj->process($in) where $in is a CGI object');
|
|
$self->{in} = $opt->{cgi};
|
|
$self->{cgi} = $self->common_param($opt->{cgi}) or return $self->error("BADARGS", 'FATAL', "You must pass in a cgi object");
|
|
|
|
my $tbl_names = ($self->{cgi}->{db}) || ($opt->{tables}) || (return $self->error('BADARGS', 'FATAL', 'No table passed in via CGI or tables method'));
|
|
ref($tbl_names) || ($tbl_names = [ $tbl_names ]);
|
|
|
|
if ($opt->{def_path}) {
|
|
return $self->error(BADARGS => FATAL => "The 'def_path' argument to \$admin->process is deprecated. You should pass in a GT::SQL object using 'db' instead.");
|
|
}
|
|
$self->{db} = $opt->{db} or return $self->error('BADARGS', 'FATAL', 'Error: You must pass in a GT::SQL object.');
|
|
$self->{table} = $self->{db}->table(@$tbl_names) or return;
|
|
|
|
# Get the name of this table.
|
|
my $prefix = $self->{db}->prefix;
|
|
if (length $prefix) {
|
|
$self->{record} ||= join(',', map { s/^$prefix//; $_; } $self->{table}->name);
|
|
}
|
|
else {
|
|
$self->{record} ||= join(',', $self->{table}->name);
|
|
}
|
|
|
|
# Get the Display object.
|
|
if ($opt->{display}) {
|
|
$self->{html} = $opt->{display};
|
|
}
|
|
else {
|
|
$self->{html} = $self->{db}->html($self->{table}, $self->{cgi});
|
|
}
|
|
$self->{html}->{url} = GT::CGI->url(remove_empty => 1);
|
|
|
|
# Set any attributes the user passed in to process.
|
|
foreach my $option (keys %{$ATTRIBS}) {
|
|
$self->{$option} = $opt->{$option} if (exists $opt->{$option});
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub preserve {
|
|
my $self = shift;
|
|
if (@_) {
|
|
my $preserve = shift;
|
|
$self->{preserve} = $preserve;
|
|
}
|
|
return $self->{preserve};
|
|
}
|
|
|
|
##
|
|
# GT::SQL::Admin->for_me($in);
|
|
# ----------------------------
|
|
# $in is a cgi object. You should call this in
|
|
# an if to see if the cgi object is from a form
|
|
# this module produced.
|
|
##
|
|
sub for_me {
|
|
my ($self, @in) = @_;
|
|
|
|
# Get options
|
|
my $opt = $self->common_param(@in) or return $self->error("BADARGS", 'FATAL', 'GT::SQL::Admin->for_me($in) where $in is a CGI object');
|
|
|
|
# There is no action so return false
|
|
$opt->{do} or return 0;
|
|
$opt->{db} or return 0;
|
|
|
|
# Check to see if there is a routine in this module.
|
|
return exists $ACTION{$opt->{do}};
|
|
}
|
|
|
|
# Make sure AUTOLOAD does not catch destroyed objects.
|
|
sub DESTROY {}
|
|
|
|
# ================================================================================ #
|
|
# FILE HANDLING #
|
|
# ================================================================================ #
|
|
|
|
$COMPILE{download_file} = __LINE__ . <<'END_OF_SUB';
|
|
sub download_file {
|
|
my ($self, $inline) = @_;
|
|
my $in = $self->{in};
|
|
|
|
my $table_name = $in->param('db');
|
|
my $id = $in->param('id');
|
|
my $cn = $in->param('cn');
|
|
my $src = $in->param('src') || 'db';
|
|
my $fname = $in->param('fname');
|
|
|
|
unless ($table_name and $id and $cn) {
|
|
print $in->header();
|
|
print $self->_start_html({ title => 'Error Downloading' });
|
|
print $self->_header("Unknown Document Reference", $@);
|
|
print $self->_end_html;
|
|
return;
|
|
}
|
|
|
|
my $tbl = $self->{table};
|
|
my ($fh, $size, $mimetype);
|
|
if ($src eq 'db') {
|
|
eval { $fh = $tbl->file_info($cn, $id) };
|
|
if ($fh) {
|
|
$fname = $fh->File_Name();
|
|
$mimetype = $fh->File_MimeType();
|
|
$size = $fh->File_Size();
|
|
}
|
|
}
|
|
else {
|
|
require GT::SQL::File;
|
|
eval { $fh = GT::SQL::File->open($fname) };
|
|
$size = -s $fname;
|
|
$fname = GT::SQL::File->get_filename($fname);
|
|
}
|
|
|
|
if (!$fh) {
|
|
print $in->header();
|
|
print $self->_start_html({ title => 'Error Downloading' });
|
|
print $self->_header("Error Downloading File", $@ || "Cannot find file pointed to by ID: $id and Column: $cn");
|
|
print $self->_end_html;
|
|
}
|
|
else {
|
|
print $self->{in}->header(
|
|
$self->{in}->file_headers(
|
|
filename => $fname,
|
|
size => $size,
|
|
$inline ? () : (inline => 0)
|
|
)
|
|
);
|
|
|
|
$fh->File_Binary() and binmode STDOUT;
|
|
|
|
while (read($fh, my $buffer, 4096)) {
|
|
print $buffer;
|
|
}
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
|
|
sub view_file {
|
|
my $self = shift;
|
|
$self->download_file(1);
|
|
}
|
|
|
|
|
|
# ================================================================================ #
|
|
# SEARCHING RECORDS #
|
|
# ================================================================================ #
|
|
|
|
$COMPILE{search_form} = __LINE__ . <<'END_OF_SUB';
|
|
sub search_form {
|
|
my ($self, $msg) = @_;
|
|
$msg &&= qq|<FONT COLOR="red"><B>$msg</B></FONT>|;
|
|
|
|
print $self->{in}->header;
|
|
print $self->_start_html({ title => "Search Form" });
|
|
print $self->_header("Search Form", $msg || "Search the database to view records.");
|
|
print $self->_start_form({ do => "search_results", db => $self->{cgi}->{db}, method => 'POST' });
|
|
print $self->{html}->form({ mode => 'search_form', search_opts => 1, file_browse => 1 });
|
|
print "<p>", $self->_search_options;
|
|
print "<p>", $self->_buttons("Search");
|
|
print $self->_end_form;
|
|
print $self->_footer;
|
|
print $self->_end_html;
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $obj->search_results;
|
|
# ---------------------
|
|
# Produces the search results for the user to view.
|
|
##
|
|
$COMPILE{search_results} = __LINE__ . <<'END_OF_SUB';
|
|
sub search_results {
|
|
my $self = shift;
|
|
print $self->{in}->header;
|
|
|
|
# Make sure the user passed in some values to search on
|
|
$self->_check_opts or return $self->search_form("You must specify at least one search term.");
|
|
|
|
# Format the cgi for searching
|
|
$self->format_search_cgi;
|
|
|
|
# Do the search and count the results.
|
|
my $sth = $self->{table}->query_sth($self->{cgi});
|
|
my $hits = $self->{table}->hits();
|
|
if ($hits == 0) {
|
|
return $self->search_form("Your search did not match any records.");
|
|
}
|
|
|
|
print $self->_start_html({ title => "Search Results" });
|
|
print $self->_header("Search Results", "Your search returned <b>$hits</b> result(s).");
|
|
my $speedbar = '';
|
|
my $name = GT::CGI->url(remove_empty => 1);
|
|
if ($hits > ($self->{cgi}->{mh} || 25)) {
|
|
$speedbar = "<p><font $FONT>Pages: ";
|
|
$speedbar .= $self->{html}->toolbar($self->{cgi}->{nh} || 1, $self->{cgi}->{mh} || 25, $hits, $name);
|
|
$speedbar .= "</font></p>\n";
|
|
print $speedbar;
|
|
}
|
|
|
|
if ($self->{in}->param('dr') and $self->{in}->param('dr') eq 'rows') {
|
|
print qq!<p><table width=500 border=1 cellpadding=0 cellspacing=0><tr><td><table width="100%" border=0 cellpadding=1 cellspacing=0>!;
|
|
print "<tr>", $self->{html}->display_row_cols({ mode => 'search_results' }), "</tr>";
|
|
my $i = 0;
|
|
while (my $result = $sth->fetchrow_hashref) {
|
|
print "<tr ", ( ($i++ % 2) ? $ROW_COLOR1 : $ROW_COLOR2 ), ">", $self->{html}->display_row({ mode => 'search_results', values => $result }), "</tr>";
|
|
}
|
|
print "</table></td></tr></table>";
|
|
}
|
|
|
|
else {
|
|
while (my $result = $sth->fetchrow_hashref) {
|
|
print "<p>", $self->{html}->display({ mode => 'search_results', values => $result });
|
|
}
|
|
}
|
|
|
|
print $speedbar if ($speedbar);
|
|
print "<p>", $self->_footer;
|
|
print $self->_end_html;
|
|
}
|
|
END_OF_SUB
|
|
|
|
# ================================================================================ #
|
|
# ADD RECORDS #
|
|
# ================================================================================ #
|
|
|
|
##
|
|
# $obj->add_form;
|
|
# ---------------
|
|
# This will print the add form for the current
|
|
# tables that we are working with. All the
|
|
# options that were set in settings will apply
|
|
# to the html that is printed here.
|
|
##
|
|
$COMPILE{add_form} = __LINE__ . <<'END_OF_SUB';
|
|
sub add_form {
|
|
my ($self, $msg) = @_;
|
|
print $self->{in}->header;
|
|
my $hk = [$self->{table}->ai];
|
|
$msg &&= qq|<FONT COLOR="red"><B>$msg</B></FONT>|;
|
|
print $self->_start_html({ title => $msg ? "Add Record Failed" : "Add Record" });
|
|
print $self->_header($msg ? "Add Record Failed" : "Add Record", $msg || "Add a record to the database");
|
|
print $self->_start_form({ do => "add_record", db => $self->{cgi}->{db} });
|
|
print $self->{html}->form({ mode => 'add_form', defaults => 1, hide => $hk, hide_timestamp => 1, search_opts => 0, file_field => 1 });
|
|
print "<p>", $self->_buttons("Add");
|
|
print $self->_end_form;
|
|
print $self->_footer;
|
|
print $self->_end_html;
|
|
|
|
return 1;
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $obj->add_record;
|
|
# -----------------------
|
|
# This will add the record to the database and
|
|
# return the record ID on success undef on failure.
|
|
##
|
|
$COMPILE{add_record} = __LINE__ . <<'END_OF_SUB';
|
|
sub add_record {
|
|
my $self = shift;
|
|
|
|
# Turn arrays into delimited fields
|
|
$self->format_insert_cgi;
|
|
|
|
if (defined(my $ret = $self->{table}->add($self->{cgi}))) {
|
|
$self->add_success($ret);
|
|
}
|
|
else {
|
|
local $^W;
|
|
my $error = $GT::SQL::error;
|
|
$error =~ s/\n/<br>\n<li>/g;
|
|
|
|
$self->add_form("<ul><li>$error</ul>");
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $obj->add_success;
|
|
# ------------------
|
|
# This will print the success page after adding a
|
|
# record.
|
|
##
|
|
$COMPILE{add_success} = __LINE__ . <<'END_OF_SUB';
|
|
sub add_success {
|
|
my ($self, $id) = @_;
|
|
print $self->{in}->header;
|
|
|
|
my $hsh;
|
|
if ($self->{table}->ai) {
|
|
$hsh = $self->{table}->get($id, 'HASH');
|
|
}
|
|
else {
|
|
my $lookup = {};
|
|
for ($self->{table}->pk) { $lookup->{$_} = $self->{cgi}->{$_}; }
|
|
$hsh = $self->{table}->get($lookup, 'HASH');
|
|
}
|
|
|
|
print $self->_start_html({ title => "Record Added" });
|
|
print $self->_header("Record Added", "The following record was successfully added:");
|
|
print "<p>";
|
|
print $self->{html}->display({ mode => 'add_success', values => $hsh });
|
|
print "<p>", $self->_footer;
|
|
print $self->_end_html;
|
|
}
|
|
END_OF_SUB
|
|
|
|
# ================================================================================ #
|
|
# DELETE RECORDS #
|
|
# ================================================================================ #
|
|
|
|
##
|
|
# $obj->delete_search_form;
|
|
# -------------------------
|
|
# Produces the search form to search to delete records.
|
|
#
|
|
# $obj->delete_search_form($message);
|
|
# ------------------------------------
|
|
# Same thing as above but puts the message at the top in
|
|
# red and bold. Great for errors or not search results.
|
|
##
|
|
$COMPILE{delete_search_form} = __LINE__ . <<'END_OF_SUB';
|
|
sub delete_search_form {
|
|
my ($self, $msg) = @_;
|
|
print $self->{in}->header;
|
|
$msg &&= qq|<FONT COLOR="red"><B>$msg</B></FONT>|;
|
|
|
|
print $self->_start_html({ title => "Delete Records" });
|
|
print $self->_header("Delete Records", $msg || "Search to delete records.");
|
|
print $self->_start_form({ do => "delete_search_results", db => $self->{cgi}->{db}, method => 'POST' });
|
|
print $self->{html}->form({ mode => 'delete_search_form', search_opts => 1 });
|
|
print "<p>", $self->_search_options;
|
|
print "<p>", $self->_buttons("Search");
|
|
print $self->_end_form;
|
|
print $self->_footer;
|
|
print $self->_end_html;
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $obj->delete_search_results;
|
|
# ----------------------------
|
|
# Performs the search and returns the result forms
|
|
# to delete records.
|
|
##
|
|
$COMPILE{delete_search_results} = __LINE__ . <<'END_OF_SUB';
|
|
sub delete_search_results {
|
|
my $self = shift;
|
|
print $self->{in}->header;
|
|
|
|
# Make sure the user passed in some values to search on
|
|
$self->_check_opts or return $self->delete_search_form("You must specify at least one search term.");
|
|
|
|
# Format the cgi for searching
|
|
$self->format_search_cgi;
|
|
|
|
# Do the search and count the results.
|
|
my $sth = $self->{table}->query_sth($self->{cgi});
|
|
my $hits = $self->{table}->hits();
|
|
|
|
# Return if we haven't found anything.
|
|
if ($hits == 0) {
|
|
return $self->delete_search_form("Your search returned no results.");
|
|
}
|
|
|
|
print $self->_start_html({ title => "Search Results" });
|
|
print $self->_start_form({ do => 'delete_records', db => $self->{cgi}->{db} });
|
|
print $self->_header("Search Results", "Your search returned <b>$hits</b> result(s).");
|
|
my $speedbar = '';
|
|
if ($hits > ($self->{cgi}->{mh} || 25)) {
|
|
my $name = GT::CGI->url(remove_empty => 1);
|
|
$speedbar = "<p><font $FONT>Pages: ";
|
|
$speedbar .= $self->{html}->toolbar($self->{cgi}->{nh} || 1, $self->{cgi}->{mh} || 25, $hits, $name);
|
|
$speedbar .= "</font></p>\n";
|
|
print $speedbar;
|
|
}
|
|
my $i = 1;
|
|
|
|
my @pk;
|
|
|
|
# If we have a relation
|
|
if (exists $self->{table}->{tables}) {
|
|
for my $t (values %{$self->{table}->{tables}}) {
|
|
push @pk, map { $t->name . '.' . $_ } $t->pk;
|
|
}
|
|
}
|
|
else {
|
|
@pk = $self->{table}->pk;
|
|
}
|
|
|
|
if ($self->{in}->param('dr') and $self->{in}->param('dr') eq 'rows') {
|
|
|
|
print qq!<p><table width=500 border=1 cellpadding=0 cellspacing=0><tr><td><table width="100%" border=0 cellpadding=1 cellspacing=0>!;
|
|
print "<tr><td><font $FONT><b>Delete</b></font></td>", $self->{html}->display_row_cols({ mode => 'search_results' }), "</tr>";
|
|
|
|
while (my $result = $sth->fetchrow_hashref) {
|
|
foreach my $key (@pk) {
|
|
if ($self->{table}->can('_complete_name')) {
|
|
my $new = {};
|
|
for (keys %{$result}) {
|
|
$new->{$self->{table}->_complete_name($_)} = $result->{$_};
|
|
}
|
|
$result = $new;
|
|
}
|
|
my $val = $result->{$key};
|
|
$self->{html}->escape(\$val);
|
|
print qq~<input type=hidden name="$i-$key" value="$val">~;
|
|
}
|
|
print "<tr ", ( ($i % 2) ? $ROW_COLOR1 : $ROW_COLOR2 ), ">";
|
|
print qq~<td><font $FONT><input type="checkbox" name="delete" value="$i"></td>~;
|
|
print $self->{html}->display_row({ mode => 'search_results', values => $result }), "</tr>";
|
|
print qq~</tr>~;
|
|
$i++;
|
|
}
|
|
|
|
print "</table></td></tr></table></td></tr></table>\n";
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
while (my $result = $sth->fetchrow_hashref) {
|
|
foreach my $key (@pk) {
|
|
if ($self->{table}->can('_complete_name')) {
|
|
my $new = {};
|
|
for (keys %{$result}) {
|
|
$new->{$self->{table}->_complete_name($_)} = $result->{$_};
|
|
}
|
|
$result = $new;
|
|
}
|
|
my $val = $result->{$key};
|
|
$self->{html}->escape(\$val);
|
|
print qq~<input type=hidden name="$i-$key" value="$val">~;
|
|
}
|
|
print qq~<p><table border=0><tr><td><input type="checkbox" name="delete" value="$i"></td><td>~;
|
|
print $self->{html}->display({ mode => 'delete_search_results', values => $result });
|
|
print "</td></tr></table>\n";
|
|
$i++;
|
|
}
|
|
|
|
}
|
|
|
|
|
|
print $speedbar if ($speedbar);
|
|
print <<END_OF_HTML if $i > 2; # Only print the Check All box if there is more than one thing to check
|
|
<script language="Javascript">
|
|
function CheckAll (box) {
|
|
for (var i = document.admin.elements.length - 1; i >= 0; i--) {
|
|
if (document.admin.elements[i].name != 'delete') { continue }
|
|
if (box.checked == false) {
|
|
document.admin.elements[i].checked = false;
|
|
}
|
|
else {
|
|
document.admin.elements[i].checked = true;
|
|
}
|
|
}
|
|
}
|
|
</script>
|
|
<p><font $FONT><input type=checkbox onClick="CheckAll(this)"> Check All</FONT></p>
|
|
END_OF_HTML
|
|
print "<p>", $self->_buttons("Delete");
|
|
print $self->_end_form;
|
|
print $self->_footer;
|
|
print $self->_end_html;
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $obj->delete_records;
|
|
# ---------------------
|
|
# Performs the delete and returns the success page.
|
|
##
|
|
$COMPILE{delete_records} = __LINE__ . <<'END_OF_SUB';
|
|
sub delete_records {
|
|
my $self = shift;
|
|
|
|
# Make sure we have something to delete.
|
|
$self->{cgi}->{delete} or return $self->delete_results(0);
|
|
|
|
# If they selected only one record to delete we still need an array ref
|
|
ref $self->{cgi}->{delete} eq 'ARRAY' or $self->{cgi}->{delete} = [$self->{cgi}->{delete}];
|
|
|
|
# Need to know the names of the columns for this Table.
|
|
my @columns = keys %{$self->{table}->cols};
|
|
|
|
# Need to know the number of records modified
|
|
my $rec_modified = 0;
|
|
|
|
# For through the record numbers. These are the values of the
|
|
# check boxes
|
|
foreach my $rec_num (@{$self->{cgi}->{delete}}) {
|
|
my $change = {};
|
|
foreach my $column (@columns) {
|
|
$change->{$column} = $self->{cgi}->{"$rec_num-$column"} if exists $self->{cgi}->{"$rec_num-$column"};
|
|
}
|
|
next unless (keys %$change);
|
|
my $ret = $self->{table}->delete($change);
|
|
if (defined $ret and ($ret != 0)) {
|
|
$rec_modified++;
|
|
}
|
|
}
|
|
|
|
# Return the results page with the proper arguments depending on if we got an error or not.
|
|
return $self->delete_results($rec_modified);
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{delete_results} = __LINE__ . <<'END_OF_SUB';
|
|
sub delete_results {
|
|
my ($self, $num_modified) = @_;
|
|
print $self->{in}->header;
|
|
|
|
print $self->_start_html({ title => "Records Deleted" });
|
|
print $self->_header("Records Deleted", "<b>$num_modified</b> record(s) were deleted.");
|
|
print "<P>", $self->_footer;
|
|
print $self->_end_html;
|
|
}
|
|
END_OF_SUB
|
|
|
|
# ================================================================================ #
|
|
# MODIFY RECORDS #
|
|
# ================================================================================ #
|
|
|
|
##
|
|
# $obj->modify_search_form;
|
|
# -------------------------
|
|
# Returns the html form to search to modify a
|
|
# record.
|
|
#
|
|
# $obj->modify_search_form($message);
|
|
# ----------------------------------
|
|
# The same thing just puts the message at the top of the
|
|
# field. Great for errors.
|
|
##
|
|
$COMPILE{modify_search_form} = __LINE__ . <<'END_OF_SUB';
|
|
sub modify_search_form {
|
|
my ($self, $msg) = @_;
|
|
print $self->{in}->header;
|
|
$msg &&= qq|<FONT COLOR="red"><B>$msg</B></FONT>|;
|
|
|
|
print $self->_start_html({ title => "Modify Record" });
|
|
print $self->_header("Modify Record", $msg || "Search to modify a record.");
|
|
print $self->_start_form({ do => "modify_search_results", db => $self->{cgi}->{db}, method => 'POST' });
|
|
print $self->{html}->form({ mode => 'modify_search_form', search_opts => 1 });
|
|
print "<p>", $self->_search_options({ modify_mult => 1 });
|
|
print "<p>", $self->_buttons("Search");
|
|
print $self->_end_form;
|
|
print $self->_footer;
|
|
print $self->_end_html;
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $obj->modify_search_results;
|
|
# ----------------------------
|
|
# Returns the form that displays the results of a
|
|
# search to modify a record.
|
|
##
|
|
$COMPILE{modify_search_results} = __LINE__ . <<'END_OF_SUB';
|
|
sub modify_search_results {
|
|
my $self = shift;
|
|
print $self->{in}->header;
|
|
|
|
# If they are modifying multiple records.
|
|
if ($self->{cgi}->{modify_multi_form}) {
|
|
return $self->modify_multi_search_results(@_);
|
|
}
|
|
|
|
# Make sure the user passed in some values to search on
|
|
$self->_check_opts or return $self->modify_search_form("You must specify at least one search term");
|
|
|
|
# Format the cgi for searching
|
|
$self->format_search_cgi;
|
|
|
|
# Do the search and count the results.
|
|
my $sth = $self->{table}->query_sth($self->{cgi}) or return $self->modify_search_form($GT::SQL::error);
|
|
my $hits = $self->{table}->hits();
|
|
|
|
# Return if we haven't found anything.
|
|
if ($hits == 0) {
|
|
return $self->modify_search_form("Your search returned no results.");
|
|
}
|
|
|
|
# Go straight to the modify form if we only have on result.
|
|
if ($hits == 1) {
|
|
$self->{cgi}->{modify} = 0;
|
|
my $row = $sth->fetchrow_hashref;
|
|
foreach (keys %$row) {
|
|
$self->{cgi}->{$_} = $row->{$_};
|
|
}
|
|
return $self->modify_form();
|
|
}
|
|
|
|
print $self->_start_html({ title => "Search Results" });
|
|
print $self->_start_form({ do => 'modify_form', db => $self->{cgi}->{db} });
|
|
print $self->_header("Search Results", "Your search returned <b>$hits</b> result(s).");
|
|
|
|
my $speedbar = '';
|
|
if ($hits > ($self->{cgi}->{mh} || 25)) {
|
|
my $name = GT::CGI->url(remove_empty => 1);
|
|
$speedbar = "<p><font $FONT>Pages: ";
|
|
$speedbar .= $self->{html}->toolbar($self->{cgi}->{nh} || 1, $self->{cgi}->{mh} || 25, $hits, $name);
|
|
$speedbar .= "</font></p>\n";
|
|
print $speedbar;
|
|
}
|
|
my $i = 1;
|
|
my @pk;
|
|
if (exists $self->{table}->{tables}) {
|
|
for my $t (values %{$self->{table}->{tables}}) {
|
|
push @pk, map { $t->name . '.' . $_ } $t->pk;
|
|
}
|
|
}
|
|
else {
|
|
@pk = $self->{table}->pk;
|
|
}
|
|
|
|
if ($self->{in}->param('dr') eq 'rows') {
|
|
|
|
print qq!<p><table width=500 border=1 cellpadding=0 cellspacing=0><tr><td><table width="100%" border=0 cellpadding=1 cellspacing=0>!;
|
|
print "<tr><td><font $FONT><b>Modify</b></font></td>", $self->{html}->display_row_cols({ mode => 'search_results' }), "</tr>";
|
|
|
|
while (my $result = $sth->fetchrow_hashref) {
|
|
foreach my $key (@pk) {
|
|
if ($self->{table}->can('_complete_name')) {
|
|
my $new = {};
|
|
for (keys %{$result}) {
|
|
$new->{$self->{table}->_complete_name($_)} = $result->{$_};
|
|
}
|
|
$result = $new;
|
|
}
|
|
my $val = $result->{$key};
|
|
$self->{html}->escape(\$val);
|
|
print qq~<input type=hidden name="$i-$key" value="$val">~;
|
|
}
|
|
print "<tr ", ( ($i % 2) ? $ROW_COLOR1 : $ROW_COLOR2 ), ">";
|
|
print qq~<td><input type=radio name=modify value="$i"></td>~;
|
|
print $self->{html}->display_row({ mode => 'modify_search_results', values => $result });
|
|
print "</tr>\n";
|
|
$i++;
|
|
}
|
|
|
|
print "</table></td></tr></table></td></tr></table>\n";
|
|
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
while (my $result = $sth->fetchrow_hashref) {
|
|
foreach my $key (@pk) {
|
|
if ($self->{table}->can('_complete_name')) {
|
|
my $new = {};
|
|
for (keys %{$result}) {
|
|
$new->{$self->{table}->_complete_name($_)} = $result->{$_};
|
|
}
|
|
$result = $new;
|
|
}
|
|
my $val = $result->{$key};
|
|
$self->{html}->escape(\$val);
|
|
print qq~<input type=hidden name="$i-$key" value="$val">~;
|
|
}
|
|
print qq~<p><table border=0><tr><td><input type=radio name=modify value="$i"></td><td>~;
|
|
print $self->{html}->display({ mode => 'modify_search_results', values => $result });
|
|
print "</td></tr></table>\n";
|
|
$i++;
|
|
}
|
|
|
|
};
|
|
|
|
|
|
print $speedbar if ($speedbar);
|
|
print "<p>", $self->_buttons("Modify");
|
|
print $self->_end_form;
|
|
print $self->_footer;
|
|
print $self->_end_html;
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $obj->modify_form($message);
|
|
# ------------------
|
|
# Returns the form to modify a single record.
|
|
# $message is optional. It will be at the top of the form.
|
|
##
|
|
$COMPILE{modify_form} = __LINE__ . <<'END_OF_SUB';
|
|
sub modify_form {
|
|
my ($self, $msg) = @_;
|
|
print $self->{in}->header;
|
|
$msg &&= qq|<FONT COLOR="red"><B>$msg</B></FONT>|;
|
|
|
|
my $values;
|
|
my $mod = $self->{cgi}->{modify};
|
|
if (! exists $self->{cgi}->{modify}) {
|
|
return $self->modify_error("Please select a record to modify before continuing.");
|
|
}
|
|
if ($self->{cgi}->{modify} == 0) {
|
|
$values = $self->{cgi};
|
|
}
|
|
else {
|
|
my $lookup = {};
|
|
for ($self->{table}->pk) { $lookup->{$_} = $self->{cgi}->{"$mod-$_"}; }
|
|
$values = $self->{table}->get($lookup, 'HASH');
|
|
}
|
|
print $self->_start_html({ title => "Modify Record" });
|
|
print $self->_header("Modify Record", $msg || "Modify a record.");
|
|
print $self->_start_form({ do => "modify_record", db => $self->{cgi}->{db} });
|
|
print $self->{html}->form({ mode => 'modify_form', values => $values, view_key => 1, file_field => 1, file_delete => 1 });
|
|
my @pk;
|
|
if (exists $self->{table}->{tables}) {
|
|
for my $t (values %{$self->{table}->{tables}}) {
|
|
push @pk, map { $t->name . '.' . $_ } $t->pk;
|
|
}
|
|
}
|
|
else {
|
|
@pk = $self->{table}->pk;
|
|
}
|
|
print qq(
|
|
<p>
|
|
<table border=1 cellpadding=0 cellspacing=0><tr><td align=center>
|
|
<table border=0 width=500><tr><td align=center><center><font $FONT><input type=submit value="Modify Record"></font></center></td>
|
|
</form>);
|
|
print $self->_start_form({ do => "delete_records", db => $self->{cgi}->{db} }, { name => 'admin_delete' });
|
|
print qq(<td align=center><center><font $FONT>);
|
|
for (@pk) {
|
|
print qq(<input type=hidden name="1-$_" value=") . $self->{in}->html_escape($values->{$_}) . qq(">);
|
|
}
|
|
print qq(
|
|
<input type=hidden name=delete value=1>
|
|
<input type=submit value="Delete Record" onclick="return confirm('Are you sure you wish to delete this record?')">
|
|
);
|
|
print qq(
|
|
</font></center></td></tr></table>
|
|
</td></tr></table>
|
|
);
|
|
print $self->_end_form;
|
|
print "<p>", $self->_footer;
|
|
print $self->_end_html;
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $obj->modify_record;
|
|
# --------------------
|
|
# Makes the modifications to the record. Returns the
|
|
# failure page on error (which is the modify form with a message)
|
|
# and the success page on success.
|
|
##
|
|
$COMPILE{modify_record} = __LINE__ . <<'END_OF_SUB';
|
|
sub modify_record {
|
|
my $self = shift;
|
|
|
|
# Format arrays for insertion
|
|
$self->format_insert_cgi;
|
|
|
|
if ($self->{table}->modify($self->{cgi})) {
|
|
return $self->modify_success;
|
|
}
|
|
else {
|
|
$self->{cgi}->{modify} = 0;
|
|
if ($GT::SQL::errcode eq 'ALREADYCHANGED') {
|
|
my $lookup = {};
|
|
for ($self->{table}->pk) {
|
|
$lookup->{$_} = $self->{cgi}->{$_};
|
|
}
|
|
my $rec = $self->{table}->get($lookup, 'HASH');
|
|
if ($rec) {
|
|
foreach (keys %$rec) {
|
|
$self->{cgi}->{$_} = $rec->{$_};
|
|
}
|
|
return $self->modify_form("The record you are attempting to modify has changed since you last accessed it, please make your changes again and resubmit.");
|
|
}
|
|
else {
|
|
return $self->modify_error("The record you attempted to modify could not be found.");
|
|
}
|
|
}
|
|
my $error = $GT::SQL::error;
|
|
$error =~ s/\n/<br>\n<li>/g;
|
|
return $self->modify_form("<ul><li>$error</ul>");
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $obj->modify_success;
|
|
# ---------------------
|
|
# Returns the success form after someone modifies
|
|
# a record.
|
|
##
|
|
$COMPILE{modify_success} = __LINE__ . <<'END_OF_SUB';
|
|
sub modify_success {
|
|
my $self = shift;
|
|
print $self->{in}->header;
|
|
my $lookup = {};
|
|
my @pk;
|
|
if (exists $self->{table}->{tables}) {
|
|
for my $t (values %{$self->{table}->{tables}}) {
|
|
push @pk, map { $t->name . '.' . $_ } $t->pk;
|
|
}
|
|
}
|
|
else {
|
|
@pk = $self->{table}->pk;
|
|
}
|
|
foreach (@pk) {
|
|
$lookup->{$_} = $self->{cgi}->{$_} if (exists $self->{cgi}->{$_});
|
|
}
|
|
my $rec = $self->{table}->get($lookup, 'HASH');
|
|
if (! $rec) {
|
|
return $self->modify_error("The record you attempted to modify could not be found.");
|
|
}
|
|
|
|
print $self->_start_html({ title => "Record Modified" });
|
|
print $self->_header("Record Modified", "The following record was successfully updated:");
|
|
print "<p>";
|
|
|
|
print $self->{html}->display({ mode => 'modify_success', values => $rec });
|
|
print "<p>", $self->_footer;
|
|
print $self->_end_html;
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $obj->modify_error;
|
|
# ---------------------
|
|
# Modify error which doesn't/can't display the record.
|
|
##
|
|
$COMPILE{modify_error} = __LINE__ . <<'END_OF_SUB';
|
|
sub modify_error {
|
|
my $self = shift;
|
|
my $msg = shift;
|
|
print $self->{in}->header;
|
|
|
|
print $self->_start_html({ title => "Modify Error" });
|
|
print $self->_header("Modify Error", $msg);
|
|
print "<P>", $self->_footer;
|
|
print $self->_end_html;
|
|
}
|
|
END_OF_SUB
|
|
|
|
# ================================================================================ #
|
|
# MODIFY MULTIPLE RECORDS #
|
|
# ================================================================================ #
|
|
|
|
##
|
|
# $obj->modify_multi_search_results;
|
|
# ------------------------
|
|
# Returns the forms to modify records.
|
|
##
|
|
$COMPILE{modify_multi_search_results} = __LINE__ . <<'END_OF_SUB';
|
|
sub modify_multi_search_results {
|
|
|
|
my $self = shift;
|
|
print $self->{in}->header;
|
|
|
|
# Make sure the user passed in some values to search on
|
|
$self->_check_opts or return $self->modify_search_form("You must specify at least one search term");
|
|
|
|
# Format the cgi for searching
|
|
$self->format_search_cgi;
|
|
|
|
# Do the search and count the results.
|
|
my $sth = $self->{table}->query_sth($self->{cgi}) or return $self->modify_search_form($GT::SQL::error);
|
|
my $hits = $self->{table}->hits();
|
|
|
|
# Return if we haven't found anything.
|
|
if ($hits == 0) {
|
|
return $self->modify_search_form("Your search returned no results.");
|
|
}
|
|
|
|
# Go straight to the modify form if we only have on result.
|
|
if ($hits == 1) {
|
|
$self->{cgi}->{modify} = 0;
|
|
my $row = $sth->fetchrow_hashref;
|
|
foreach (keys %$row) {
|
|
$self->{cgi}->{$_} = $row->{$_};
|
|
}
|
|
return $self->modify_form();
|
|
}
|
|
|
|
print $self->_start_html({ title => "Modify Search Results" });
|
|
print $self->_start_form({ do => 'modify_multi_records', db => $self->{cgi}->{db} });
|
|
print $self->_header("Modify Search Results", "Your search returned <b>$hits</b> result(s).");
|
|
my $speedbar = '';
|
|
if ($hits > ($self->{cgi}->{mh} || 25)) {
|
|
my $name = GT::CGI->url(remove_empty => 1);
|
|
$speedbar = "<p><font $FONT>Pages: ";
|
|
$speedbar .= $self->{html}->toolbar($self->{cgi}->{nh} || 1, $self->{cgi}->{mh} || 25, $hits, $name);
|
|
$speedbar .= "</font></p>\n";
|
|
print $speedbar;
|
|
}
|
|
my $i = 1;
|
|
while (my $result = $sth->fetchrow_hashref) {
|
|
print qq~<p><table border=0><tr><td><input type="checkbox" name="modify" value="$i"></td><td>~;
|
|
print $self->{html}->form({ mode => 'modify_multi_search_results', values => $result, multiple => $i, view_key => 1, file_field => 1, file_delete => 1 });
|
|
print "</td></tr></table>\n";
|
|
$i++;
|
|
}
|
|
print $speedbar if ($speedbar);
|
|
print "<p>", $self->_buttons("Modify");
|
|
print $self->_end_form;
|
|
print $self->_footer;
|
|
print $self->_end_html;
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $obj->modify_multi_records;
|
|
# ---------------------------
|
|
# This performs the modify on the multiple records. This returns
|
|
# the success page on error and the modify form on failure. It should
|
|
# call the modify form in a way that it can reproduce the records that
|
|
# were not successfully modified. See the comments above to see how
|
|
# modify_multi_form is called.
|
|
##
|
|
$COMPILE{modify_multi_records} = __LINE__ . <<'END_OF_SUB';
|
|
sub modify_multi_records {
|
|
my $self = shift;
|
|
if (! exists $self->{cgi}->{modify}) {
|
|
return $self->modify_error("Please select a record to modify before continuing.");
|
|
}
|
|
# If they selected only one record to modify we still need an array ref
|
|
ref $self->{cgi}->{modify} eq 'ARRAY' or $self->{cgi}->{modify} = [$self->{cgi}->{modify}];
|
|
|
|
# Format the cgi for inserting
|
|
$self->format_insert_cgi;
|
|
|
|
# Hash to handle errors if there are any errors.
|
|
my $errors = {};
|
|
my $errcode = {};
|
|
|
|
# Need to know the names of the columns for this Table.
|
|
my @columns = keys %{$self->{table}->cols};
|
|
|
|
# Need to know the number of records modified
|
|
my $rec_modified = 0;
|
|
|
|
# For through the record numbers. These are the values of the
|
|
# check boxes
|
|
foreach my $rec_num (@{$self->{cgi}->{modify}}) {
|
|
|
|
# The hash ref, we need, to modify a record.
|
|
my $change = {};
|
|
|
|
# For through the column names to build our modification hash
|
|
foreach my $column (@columns) {
|
|
$change->{$column} = $self->{cgi}->{"$rec_num-$column"} if exists $self->{cgi}->{"$rec_num-$column"};
|
|
}
|
|
|
|
# Make the changes and capture any errors.
|
|
my $ret = $self->{table}->modify($change);
|
|
if (defined $ret) {
|
|
$rec_modified++;
|
|
}
|
|
else {
|
|
if ($GT::SQL::error){
|
|
my $error = $GT::SQL::error;
|
|
$error =~ s/\n/<br>\n<li>/g;
|
|
$errors->{$rec_num} = "<li>$error";
|
|
}
|
|
$errcode->{$rec_num} = $GT::SQL::errcode if ($GT::SQL::errcode);
|
|
}
|
|
}
|
|
|
|
# Return the results page with the proper arguments depending on if we got an error or not.
|
|
return (keys %{$errors}) ? $self->modify_multi_results($rec_modified, $errors, $errcode) : $self->modify_multi_results($rec_modified);
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $obj->modify_multi_results($num_modified);
|
|
# -------------------------------------------
|
|
# This will return the results page after the user modifies
|
|
# the record from the modify_multi_form. $num_modified is the
|
|
# number of records that were modified.
|
|
#
|
|
# $obj->modify_multi_results($num_modified, \%not_modified, \%error_codes);
|
|
# -----------------------------------------------------------
|
|
# This is how you handle errors. The first argument is the number
|
|
# of records that were modified. The second is a hash ref of primary
|
|
# keys to reasons the message was not modified. If there is more than
|
|
# one column that makes up the primary key they should be flatened
|
|
# to a comma separated list of keys in the proper order.
|
|
##
|
|
$COMPILE{modify_multi_results} = __LINE__ . <<'END_OF_SUB';
|
|
sub modify_multi_results {
|
|
my ($self, $num_modified, $errors, $errcodes) = @_;
|
|
my ($ok_out, $error_out) = ('', '');
|
|
$errcodes ||= {};
|
|
|
|
# Lets get our error records if we messed up.
|
|
if ($errors) {
|
|
my @cond = ();
|
|
$error_out = $self->_header("Modify Failed", "The following record(s) were not modified successfully. Please correct the errors and submit again.");
|
|
$error_out .= $self->_start_form({ do => 'modify_multi_records', db => $self->{cgi}->{db} });
|
|
|
|
my $cols = $self->{table}->cols;
|
|
foreach my $rec (keys %$errors) {
|
|
my $values = {};
|
|
if ($errcodes->{$rec} eq 'NORECMOD') {
|
|
foreach my $col (keys %$cols) {
|
|
$values->{$col} = $self->{cgi}->{"$rec-$col"};
|
|
}
|
|
$error_out .= qq~<p><font color=red $FONT><b>The record could not be found in the database</b></FONT>~;
|
|
$error_out .= qq~<br><table border=0><tr><td> </td><td>~;
|
|
$error_out .= $self->{html}->display({ mode => 'modify_multi_results_norec', values => $values });
|
|
$error_out .= qq~</td></tr></table>\n~;
|
|
}
|
|
elsif ($errcodes->{$rec} eq 'ALREADYCHANGED') {
|
|
my $lookup = {};
|
|
for ($self->{table}->pk) {
|
|
$lookup->{$_} = $self->{cgi}->{"$rec-$_"};
|
|
}
|
|
my $result = $self->{table}->get($lookup, 'HASH');
|
|
foreach (keys %$result) {
|
|
$values->{$_} = $result->{$_};
|
|
}
|
|
$error_out .= qq~<p><font color=red $FONT><b>The record you are attempting to modify has changed since you last accessed it, please make your changes again and resubmit.</b></font>~;
|
|
$error_out .= qq~<br><table border=0><tr><td><input type="checkbox" name="modify" value="$rec"></td><td>~;
|
|
$error_out .= $self->{html}->form({ mode => 'modify_multi_result_changed', values => $values, multiple => $rec });
|
|
$error_out .= qq~</td></tr></table>\n~;
|
|
}
|
|
else {
|
|
$error_out .= qq~<p><font color=red $FONT><b>$errors->{$rec}</b></font><br><table border=0><tr><td><input type="checkbox" name="modify" value="$rec"></td><td>~;
|
|
foreach my $col (keys %$cols) {
|
|
$values->{$col} = $self->{cgi}->{"$rec-$col"};
|
|
}
|
|
$error_out .= $self->{html}->form({ values => $values, multiple => $rec, mode => 'modify_multi_results_err' });
|
|
$error_out .= qq~</td></tr></table>\n~;
|
|
}
|
|
}
|
|
$error_out .= "<p>" . $self->_buttons("Modify");
|
|
$error_out .= $self->_end_form;
|
|
}
|
|
|
|
# If there were successfull modifications.
|
|
if ($num_modified) {
|
|
$ok_out = $self->_header("Modify Success", "<b>$num_modified</b> record(s) were successfully updated.");
|
|
$ok_out .= "<p>";
|
|
}
|
|
|
|
# Print the HTML
|
|
print $self->{in}->header;
|
|
print $self->_start_html({ title => "Record Modified" });
|
|
print $ok_out;
|
|
print $error_out;
|
|
print $self->_end_html;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{format_insert_cgi} = __LINE__ . <<'END_OF_SUB';
|
|
sub format_insert_cgi {
|
|
my $self = shift;
|
|
my $cols = $self->{table}->cols;
|
|
foreach (keys % $cols) {
|
|
if (! exists $self->{cgi}->{$_} and uc($cols->{$_}->{form_type}) eq 'CHECKBOX') {
|
|
$self->{cgi}->{$_} = '';
|
|
}
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{format_search_cgi} = __LINE__ . <<'END_OF_SUB';
|
|
sub format_search_cgi {
|
|
my $self = shift;
|
|
foreach (keys %{$self->{table}->cols}) {
|
|
next unless (ref $self->{cgi}->{$_} eq 'ARRAY');
|
|
if (exists $self->{cgi}->{"$_-opt"} and $self->{cgi}->{"$_-opt"} eq 'LIKE') {
|
|
$self->{cgi}->{$_} = join("$GT::SQL::Display::HTML::INPUT_SEPARATOR%", sort @{$self->{cgi}->{$_}});
|
|
}
|
|
else {
|
|
$self->{cgi}->{$_} = join($GT::SQL::Display::HTML::INPUT_SEPARATOR, sort @{$self->{cgi}->{$_}});
|
|
}
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
# ================================================================================ #
|
|
# EDIT TABLES #
|
|
# ================================================================================ #
|
|
|
|
$COMPILE{editor_table_form} = __LINE__ . <<'END_OF_SUB';
|
|
sub editor_table_form {
|
|
# -------------------------------------------------------------------
|
|
# $obj->editor_table_form;
|
|
# ------------------------
|
|
# Prints the form to edit the table
|
|
# definitions.
|
|
#
|
|
my ($self, $msg) = @_;
|
|
print $self->{in}->header;
|
|
|
|
|
|
# Get the variables that need to be preserved and generate urls for them.
|
|
my $preserve_hash = $self->preserve();
|
|
my $preserve = '';
|
|
foreach my $p (keys %$preserve_hash) {
|
|
$preserve .= qq|&$p=$preserve_hash->{$p}|;
|
|
}
|
|
|
|
# Update the table if required
|
|
$self->{in}->param('update_def') and $msg .= $self->edit_table_def || "Table Definition Update Successful";
|
|
|
|
$msg &&= qq|<FONT COLOR="red"><B>$msg</B></FONT>|;
|
|
my $table = $self->{record};
|
|
print $self->_start_html({ title => "Table Editor: $table" });
|
|
print $self->_header("Table Editor", $msg || "Table Maintenance: $table");
|
|
print $self->_start_form({ do => 'editor_table_form', db => $self->{cgi}->{db}, update_def => 1 });
|
|
my $url = GT::CGI->url({ query_string => 0 });
|
|
|
|
my $show_weight_h = (keys %{$self->{table}->weight}) ? "<th>Index Weight</th>" : '';
|
|
if ($show_weight_h) {
|
|
$show_weight_h = qq~<td valign="top"><font $FONT>Search<br>Weight</font></td>~;
|
|
}
|
|
else {
|
|
$show_weight_h = '';
|
|
}
|
|
print qq~
|
|
<p><a name="update"><font face=Arial size=3><b>Edit $table Table Definition</b></a></font><br>
|
|
<font $FONT>Below is all the columns in your $table table. By clicking on one of the column names, you can view more details
|
|
as well as alter the column definition.</font><br><br>
|
|
<table border=1 cellpadding=0 cellspacing=0><tr><td>
|
|
<table border=0 cellpadding=3 cellspacing=2>
|
|
<tr>
|
|
<td valign="top"><font $FONT>Position</font></td>
|
|
<td valign="top"><font $FONT>Column<br>Name</font></td>
|
|
<td valign="top"><font $FONT>Column<br>Type</font></td>
|
|
<td valign="top"><font $FONT>Not<br>Null</font></td>
|
|
<td valign="top"><font $FONT>Default</font></td>
|
|
<td valign="top"><font $FONT>Form<br>Display</font></td>
|
|
<td valign="top"><font $FONT>Form<br>Type</font></td>
|
|
<td valign="top"><font $FONT>Form<br>Regex</font></td>
|
|
$show_weight_h
|
|
</tr>
|
|
~;
|
|
my %cols = %{$self->{table}->cols};
|
|
foreach my $column ($self->{table}->ordered_columns) {
|
|
my %attribs = %{$cols{$column}};
|
|
$attribs{pos} ||= ' ';
|
|
$attribs{type} ||= ' ';
|
|
$attribs{not_null} ||= ' ';
|
|
$attribs{default} = ' ' if not defined $attribs{default} or $attribs{default} eq '';
|
|
$attribs{form_display} ||= ' ';
|
|
$attribs{form_type} ||= 'TEXT';
|
|
$attribs{regex} ||= ' ';
|
|
|
|
if ($show_weight_h) {
|
|
$attribs{weight} ||= ' ';
|
|
$show_weight_h = qq~<td><font $FONT>$attribs{weight}</font></td>~;
|
|
}
|
|
($attribs{not_null} eq '1') ? ($attribs{not_null} = "Yes") : ($attribs{not_null} = "No");
|
|
print qq~
|
|
<tr>
|
|
<td><font $FONT>$attribs{pos}</font></td>
|
|
~;
|
|
if ($attribs{protect}) {
|
|
print qq~<td><font $FONT>$column</font></td>~;
|
|
}
|
|
else {
|
|
print qq~<td><font $FONT><a href="$url?db=$table&do=editor_columns&modify=$column$preserve">$column</a></font></td>~;
|
|
}
|
|
print qq~
|
|
<td><font $FONT>$attribs{type}~;
|
|
print "($attribs{size})" if ($attribs{size});
|
|
print "(" . join (", " => @{$attribs{values}}) . ")" if ($attribs{values} and (ref $attribs{values}));
|
|
print qq~</font></td>
|
|
<td><font $FONT>$attribs{not_null}</font></td>
|
|
<td><font $FONT>$attribs{default}</font></td>
|
|
<td><font $FONT>$attribs{form_display}</font></td>
|
|
<td><font $FONT>$attribs{form_type}</font></td>
|
|
<td><font $FONT>$attribs{regex}</font></td>
|
|
$show_weight_h
|
|
</tr>
|
|
~;
|
|
}
|
|
print qq~
|
|
</table>
|
|
</td></tr></table>
|
|
|
|
<br>
|
|
|
|
<table width=500 border=1 cellpadding=0 cellspacing=0><tr><td>
|
|
<table border=0 width=500>
|
|
<tr>
|
|
<td colspan=2 bgcolor="#DDDDDD"><font $FONT><b>Database Information</b></font></td>
|
|
</tr>
|
|
|
|
<tr>
|
|
<td><font $FONT>Indexing Scheme
|
|
<td><font $FONT><select name="search_driver">~;
|
|
|
|
my $search_driver = $self->{table}->search_driver();
|
|
require GT::SQL::Search;
|
|
print map {"<option " . ( $search_driver eq $_ ? "selected" : "" ) . ">$_" } GT::SQL::Search->available_drivers();
|
|
|
|
print qq~</select>
|
|
</tr>
|
|
</table>
|
|
</td></tr></table>
|
|
|
|
<br>
|
|
|
|
<table border=1 cellpadding=0 cellspacing=0><tr><td>
|
|
<table border=0 cellpadding=3 cellspacing=2 width=500>
|
|
<tr>
|
|
<td align=center><font $FONT><input type=submit value="Update Table $table">
|
|
</table>
|
|
</td></tr></table>
|
|
|
|
<br>
|
|
~;
|
|
|
|
print $self->_prop_navbar;
|
|
print $self->_end_form;
|
|
print $self->_footer;
|
|
print $self->_end_html;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{edit_table_def} = __LINE__ . <<'END_OF_SUB';
|
|
sub edit_table_def {
|
|
# -------------------------------------------------------------------
|
|
my $self = shift;
|
|
my $in = $self->{in};
|
|
|
|
# handle the indexing scheme
|
|
my $e = $self->{db}->editor( $in->param('db') );
|
|
$e->change_search_driver( $in->param('search_driver') ) or return $GT::SQL::error;
|
|
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{editor_columns} = __LINE__ . <<'END_OF_SUB';
|
|
sub editor_columns {
|
|
# -------------------------------------------------------------------
|
|
# Form to modify a selected column.
|
|
#
|
|
my ($self, $msg) = @_;
|
|
print $self->{in}->header;
|
|
|
|
# Get the variables that need to be preserved and generate urls for them.
|
|
my $preserve_hash = $self->preserve();
|
|
my $preserve = '';
|
|
foreach my $p (keys %$preserve_hash) {
|
|
$preserve .= qq|&$p=$preserve_hash->{$p}|;
|
|
}
|
|
|
|
$msg &&= qq|<FONT COLOR="red"><B>$msg</B></FONT>|;
|
|
my $table = $self->{record};
|
|
my $column = $self->{cgi}->{modify};
|
|
my %cols = $self->{table}->cols;
|
|
my %attribs = %{$cols{$column}};
|
|
my $url = GT::CGI->url({ query_string => 0 });
|
|
exists $cols{$column} or return $self->editor_table_form("Column ($column) does not exist in table" . $self->{table}->name);
|
|
|
|
# Print the intro.
|
|
print $self->_start_html({ title => "Edit <b>$column</b> Column Definition" });
|
|
print $self->_header("Table Editor", $msg || "Edit <b>$column</b> Column Definition");
|
|
print $self->_start_form({ do => 'editor_modify_columns', db => $self->{cgi}->{db}, modify => $column });
|
|
print qq~
|
|
<p><font $FONT>For information on what each column means, <b><a href="$url?do=editor_column_help&db=$table$preserve">click here</a></b>.</p>
|
|
~;
|
|
|
|
# Set up defaults for the fields
|
|
foreach my $col (qw/column type not_null file_save_in file_save_url file_max_size file_save_scheme default form_display form_type form_size form_names form_values regex weight values size/) {
|
|
$attribs{$col} = $self->{cgi}->{$col} if (defined $self->{cgi}->{$col});
|
|
}
|
|
$attribs{column} ||= $column;
|
|
$attribs{form_type} ||= 'TEXT';
|
|
$attribs{form_size} ||= ($attribs{form_type} eq 'SELECT') ? 0 : '';
|
|
ref $attribs{form_size} and ($attribs{form_size} = join (",", @{$attribs{form_size}}));
|
|
ref $attribs{form_names} and ($attribs{form_names} = join ("\n", @{$attribs{form_names}}));
|
|
ref $attribs{form_values} and ($attribs{form_values} = join ("\n", @{$attribs{form_values}}));
|
|
ref $attribs{values} and ($attribs{values} = join ("\n", @{$attribs{values}}));
|
|
|
|
# Display the form.
|
|
my $index_list = $self->_index_list($column);
|
|
print $self->editor_column_form(\%attribs, $index_list, 'modify');
|
|
|
|
print $self->_buttons("Update Table");
|
|
print "<p>";
|
|
print $self->_prop_navbar;
|
|
print $self->_end_form;
|
|
print $self->_footer;
|
|
print $self->_end_html;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{editor_modify_columns} = __LINE__ . <<'END_OF_SUB';
|
|
sub editor_modify_columns {
|
|
# --------------------------------------------------------
|
|
# Modifies a column definition.
|
|
#
|
|
my $self = shift;
|
|
ref $self->{cgi}->{db}
|
|
and return $self->error('BADARGS','FATAL', "Editor can only be called with one table, not a relation.");
|
|
my $editor = $self->{db}->editor($self->{cgi}->{db});
|
|
|
|
my %attribs;
|
|
my $column = $self->{cgi}->{modify} || return $self->editor_columns("You must enter a column name.");
|
|
foreach my $def (qw/column type not_null default form_display form_type form_size file_save_in file_save_url file_max_size file_save_scheme regex weight size/) {
|
|
$attribs{$def} = $self->{cgi}->{$def} if (defined $self->{cgi}->{$def});
|
|
}
|
|
$attribs{form_type} ||= 'TEXT';
|
|
$attribs{form_names} = [split /[\r\n]+/, $self->{cgi}->{form_names}];
|
|
$attribs{form_values} = [split /[\r\n]+/, $self->{cgi}->{form_values}];
|
|
$attribs{values} = [split /[\r\n]+/, $self->{cgi}->{values}];
|
|
|
|
# Keep any values that where there before
|
|
my $old_def = $self->{table}->cols->{$column};
|
|
for my $val (keys %$old_def) {
|
|
$attribs{$val} = $old_def->{$val} unless exists $attribs{$val};
|
|
}
|
|
|
|
# Error checking
|
|
my $errors = $self->editor_column_checks($column, \%attribs, 'modify');
|
|
if ($self->{cgi}->{index} eq 'primary' and ($column ne $self->{table}->{schema}->{pk})) {
|
|
$errors .= "<li>This table already has a primary key.";
|
|
}
|
|
$errors and return $self->editor_columns("<ul>$errors</ul>");
|
|
|
|
# Add/Drop indexes.
|
|
my $index_type = $self->_index_type($column);
|
|
my @post_change;
|
|
if ($index_type ne $self->{cgi}->{index}) {
|
|
if ($index_type eq 'none') {
|
|
# Adding an index - delay this until _after_ the column has been changed
|
|
if ($self->{cgi}->{index} eq 'regular') {
|
|
push @post_change, [add_index => "${column}_idx" => [$column]];
|
|
}
|
|
else {
|
|
push @post_change, [add_unique => "${column}_idx" => [$column]];
|
|
}
|
|
}
|
|
elsif ($self->{cgi}->{index} eq 'none') {
|
|
# Dropping an index
|
|
if ($index_type eq 'regular') {
|
|
my $index = $self->{table}->index;
|
|
INDEX: foreach my $index_name (keys %$index) {
|
|
foreach my $col_name (@{$index->{$index_name}}) {
|
|
next unless ($col_name eq $column);
|
|
$editor->drop_index($index_name) or return $self->editor_columns($GT::SQL::error);
|
|
last INDEX;
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
my $unique = $self->{table}->unique;
|
|
INDEX: foreach my $unique_name (keys %$unique) {
|
|
foreach my $col_name (@{$unique->{$unique_name}}) {
|
|
next unless ($col_name eq $column);
|
|
$editor->drop_unique($unique_name) or return $self->editor_columns($GT::SQL::error);
|
|
last INDEX;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# Make the changes
|
|
delete $attribs{column};
|
|
$editor->alter_col($column, \%attribs) or return $self->editor_columns($editor->error);
|
|
|
|
for (@post_change) {
|
|
my ($meth, @args) = @$_;
|
|
$editor->$meth(@args);
|
|
}
|
|
|
|
return $self->editor_table_form("$column has been updated!");
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{editor_column_form} = __LINE__ . <<'END_OF_SUB';
|
|
sub editor_column_form {
|
|
# -------------------------------------------------------------------
|
|
# Displays an Add/Modify column form.
|
|
#
|
|
my ($self, $attribs, $index_list, $mode) = @_;
|
|
|
|
my $output = qq~
|
|
<table width=500 border=1 cellpadding=0 cellspacing=0><tr><td>
|
|
<table border=0 width=500>~;
|
|
|
|
if ($mode eq 'add') {
|
|
$output .= qq~
|
|
<tr><td colspan=2 bgcolor="#DDDDDD"><font $FONT><b>Database Information</b></font></td></tr>
|
|
<tr><td><font $FONT>Column Name</td><td><input type=text name=column value="$attribs->{column}"></td></tr>
|
|
~;
|
|
}
|
|
|
|
else {
|
|
$output .= qq~
|
|
<tr><td colspan=2 bgcolor="#DDDDDD"><font $FONT><b>Database Information</b></font></td></tr>
|
|
<tr><td colspan=2><font $FONT><b>WARNING</b>: If you change a field's type, data in that field may be lost. Also, if you alter one of the system fields, it may render your system inoperable.</td></tr>
|
|
<tr><td><font $FONT>Column Name</td><td><font $FONT>$attribs->{column}</font> <input type="hidden" name="column" value="$attribs->{column}"></td></tr>
|
|
~;
|
|
};
|
|
|
|
my $match = 0;
|
|
my @types = qw/INT TINYINT SMALLINT MEDIUMINT BIGINT FLOAT DOUBLE CHAR VARCHAR TEXT DATE DATETIME ENUM/;
|
|
for (@types) {
|
|
if ($attribs->{type} eq $_) {
|
|
$match = 1;
|
|
last;
|
|
}
|
|
}
|
|
my $extra = '';
|
|
if (! $match) {
|
|
$extra = "<option selected>$attribs->{type}";
|
|
}
|
|
$output .= qq~
|
|
<tr><td><font $FONT>Column Type</td><td><select name="type">
|
|
$extra\n~;
|
|
for (@types) {
|
|
$output .= qq|<option|;
|
|
$output .= qq| selected="selected"| if $attribs->{type} eq $_;
|
|
$output .= qq|>$_</option>\n|;
|
|
}
|
|
$output .= qq~
|
|
</select>
|
|
</td></tr>
|
|
<tr><td><font $FONT>Column Index</td><td><font $FONT>$index_list</td></tr>
|
|
<tr><td><font $FONT>Column Size<br>(Only for CHAR types)</td><td><input type=text name=size value="$attribs->{size}"></td></tr>
|
|
<tr><td><font $FONT>Column Values<br>(Only for ENUM types)</td><td><textarea name=values rows=3 cols=20>$attribs->{values}</textarea></td></tr>
|
|
<tr><td><font $FONT>Not Null
|
|
</td><td><font $FONT>
|
|
Yes<input name="not_null" type=radio value=1~; $output .= " checked" if ($attribs->{not_null}); $output .= qq~>
|
|
No<input name="not_null" type=radio value=0~; $output .= " checked" if (!$attribs->{not_null}); $output .= qq~>
|
|
</td></tr>
|
|
<tr><td><font $FONT>Default</td><td><input type="text" name="default" value="$attribs->{default}"></td></tr>
|
|
<tr><td colspan=2 bgcolor="#DDDDDD"><font $FONT><b>Form Information</b></font></td></tr>
|
|
<tr><td><font $FONT>Form Display</td><td><input type="text" name="form_display" value="$attribs->{form_display}"></td></tr>
|
|
<tr><td><font $FONT>Form Type</td><td>
|
|
<select name=form_type>
|
|
<option~; $output .= " selected" if ($attribs->{form_type} eq 'HIDDEN'); $output .= qq~ value="HIDDEN">HIDDEN</option>
|
|
<option~; $output .= " selected" if ($attribs->{form_type} eq 'SELECT'); $output .= qq~ value="SELECT">SELECT</option>
|
|
<option~; $output .= " selected" if ($attribs->{form_type} eq 'MULTIPLE'); $output .= qq~ value="MULTIPLE">MULTI-SELECT</option>
|
|
<option~; $output .= " selected" if ($attribs->{form_type} eq 'CHECKBOX'); $output .= qq~ value="CHECKBOX">CHECKBOX</option>
|
|
<option~; $output .= " selected" if ($attribs->{form_type} eq 'RADIO'); $output .= qq~ value="RADIO">RADIO</option>
|
|
<option~; $output .= " selected" if ($attribs->{form_type} eq 'TEXT'); $output .= qq~ value="TEXT">TEXT</option>
|
|
<option~; $output .= " selected" if ($attribs->{form_type} eq 'TEXTAREA'); $output .= qq~ value="TEXTAREA">TEXTAREA</option>
|
|
<option~; $output .= " selected" if ($attribs->{form_type} eq 'PASSWORD'); $output .= qq~ value="PASSWORD">PASSWORD</option>
|
|
<option~; $output .= " selected" if ($attribs->{form_type} eq 'FILE'); $output .= qq~ value="FILE">FILE</option>
|
|
</select></td></tr>
|
|
<tr><td><font $FONT>Form Size</td><td><input type=text name=form_size value="$attribs->{form_size}"></td></tr>
|
|
<tr><td valign="top"><font $FONT>Form Names<br>(Stored in Database)<br>Only for checkbox, multi-select or radio forms.</td><td valign="top"><textarea cols=20 rows=3 name=form_names>$attribs->{form_names}</textarea></td></tr>
|
|
<tr><td valign="top"><font $FONT>Form Values<br>(Displayed on Form)<br>Only for checkbox, multi-select or radio forms.</td><td valign="top"><textarea cols=20 rows=3 name=form_values>$attribs->{form_values}</textarea></td></tr>
|
|
<tr><td><font $FONT>File Save Location<br>(Only for FILE types. Stored on disk)</td><td><input type=text name=file_save_in value="$attribs->{file_save_in}"></td></tr>
|
|
<tr><td><font $FONT>File Save URL<br>(Only for FILE types)</td><td><input type=text name=file_save_url value="$attribs->{file_save_url}"></td></tr>
|
|
<tr><td><font $FONT>File Save Method<br>(Only for FILE types)</td><td><select name=file_save_scheme>
|
|
<option~; $output .= " selected" if ($attribs->{file_save_scheme} eq 'HASHED'); $output .= qq~>HASHED</option>
|
|
<option~; $output .= " selected" if ($attribs->{file_save_scheme} eq 'SIMPLE'); $output .= qq~>SIMPLE</option>
|
|
</select>
|
|
</td></tr>
|
|
<tr><td><font $FONT>File Maximum Size<br>(Only for FILE types.)</td><td><input type=text name=file_max_size value="$attribs->{file_max_size}"></td></tr>
|
|
|
|
<tr><td><font $FONT>Form Regex</td><td><input type=text name=regex value="$attribs->{regex}"></td></tr>
|
|
~;
|
|
|
|
# Only display Search Weight form if this table has a search weight set.
|
|
if (keys %{$self->{table}->weight}) {
|
|
$output .= qq~<tr><td><font $FONT>Search Weight</td><td><input size=3 type=text name=weight value="$attribs->{weight}"></td></tr>~;
|
|
}
|
|
|
|
$output .= qq~
|
|
</table>
|
|
</tr></td></table>
|
|
<br>
|
|
~;
|
|
return $output;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{editor_column_checks} = __LINE__ . <<'END_OF_SUB';
|
|
sub editor_column_checks {
|
|
# -------------------------------------------------------------------
|
|
# Check to make sure a column add/change is valid.
|
|
#
|
|
my ($self, $column, $attribs) = @_;
|
|
my $errors = '';
|
|
|
|
# Remove attributes that don't make sense.
|
|
$attribs->{type} eq 'CHAR' or $attribs->{type} eq 'VARCHAR' or delete $attribs->{size};
|
|
$attribs->{type} eq 'ENUM' or delete $attribs->{values};
|
|
$attribs->{form_type} =~ /^(?:SELECT|MULTIPLE|CHECKBOX|RADIO)$/ or delete $attribs->{form_names};
|
|
$attribs->{form_type} =~ /^(?:SELECT|MULTIPLE|CHECKBOX|RADIO)$/ or delete $attribs->{form_values};
|
|
$attribs->{form_type} =~ /^(?:CHECKBOX|RADIO)$/ and delete $attribs->{form_size};
|
|
$attribs->{default} =~ /^\s*$/ and delete $attribs->{default};
|
|
|
|
# Go through and weed out problem cases.
|
|
if ($column !~ /^(\w+)$/) {
|
|
$errors .= "<li>Column name '$column' is invalid. The column name can only contain letters, numbers and an underscore.";
|
|
}
|
|
if ($column =~ /^[\d_]/) {
|
|
$errors .= "<li>Column name '$column' is invalid. Column names can not start with a number or an underscore.";
|
|
}
|
|
if (($attribs->{type} eq 'CHAR' or $attribs->{type} eq 'VARCHAR') and ($attribs->{size} > 255 or $attribs->{size} < 1)) {
|
|
$errors .= "<li>Size '$attribs->{size}' is invalid. It must be between 1 and 255.";
|
|
}
|
|
if ($attribs->{type} eq 'ENUM') {
|
|
unless (ref $attribs->{values} eq 'ARRAY' and @{$attribs->{values}} >= 1) {
|
|
$errors .= "<li>You must specify the ENUM values in the 'Column Value' text area. Enter the value one perl line.</li>\n";
|
|
}
|
|
if ($attribs->{default}) {
|
|
my $ok;
|
|
for my $value (@{$attribs->{values}}) {
|
|
$ok = 1, last if $value eq $attribs->{default};
|
|
}
|
|
unless ($ok) {
|
|
$errors .= "<li>Your default must match one of the listed ENUM values.";
|
|
}
|
|
}
|
|
}
|
|
if ($attribs->{type} =~ /INT$/) {
|
|
if ($attribs->{default} and $attribs->{default} =~ /\D/) {
|
|
$errors .= "<li>The default value for INT columns cannot contain non-integral values.</li>";
|
|
}
|
|
}
|
|
if ($attribs->{form_type} =~ /^(?:SELECT|MULTIPLE|CHECKBOX|RADIO)$/) {
|
|
if (! (@{$attribs->{form_names}} or @{$attribs->{form_values}}) ) {
|
|
$errors .= "<li>For radio, checkbox and select forms, you must specify the names and the values in the two textarea boxes one per line. The names are what is stored in the database, and the values is what is displayed in the browser.";
|
|
}
|
|
else {
|
|
if (@{$attribs->{form_names}} ne @{$attribs->{form_values}}) {
|
|
$errors .= "<li>Make sure you have the same number of lines for Form Names as you do for Form Values.";
|
|
}
|
|
}
|
|
}
|
|
if ($attribs->{form_type} eq 'TEXTAREA') {
|
|
if ($attribs->{form_size} =~ /^\s*(\d+)\s*,\s*(\d+)\s*$/) {
|
|
$attribs->{form_size} = [$1, $2];
|
|
}
|
|
elsif ($attribs->{form_size} =~ /^\s*(\d+)\s*$/) {
|
|
$attribs->{form_size} = $1;
|
|
}
|
|
else {
|
|
$errors .= "<li>For TEXTAREA forms, please specify the size of the textarea as COLS,ROWS. For example, to have a 50 column, by 6 rows textarea box, you would enter 50,6 in the Form Size box.";
|
|
}
|
|
}
|
|
if ($attribs->{form_type} eq 'FILE') {
|
|
if ( $attribs->{file_save_in}) {
|
|
( -e $attribs->{file_save_in} and -w $attribs->{file_save_in}) or
|
|
$errors .= "<li>File Save Location does not exist or is not writeable.";
|
|
}
|
|
else {
|
|
$errors .= "<li>File Save Location must be set.";
|
|
}
|
|
if ($attribs->{type} ne 'CHAR' and $attribs->{type} ne 'VARCHAR') {
|
|
$errors .= "<li>Database column must be of CHAR or VARCHAR.";
|
|
}
|
|
}
|
|
if (($attribs->{not_null} == 0) and ($self->{cgi}->{index} ne 'none')) {
|
|
$errors .= "<li>A column must be defined as not null if you want to index it.";
|
|
}
|
|
if (($self->{cgi}->{index} ne 'none') and ($attribs->{type} eq 'TEXT')) {
|
|
$errors .= "<li>You can not have an index on TEXT columns.";
|
|
}
|
|
if ($attribs->{weight} and $attribs->{weight} !~ /^\d+$/) {
|
|
$errors .= "<li>Search weight can only contain digits.</li>";
|
|
}
|
|
return $errors;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{editor_add_field_form} = __LINE__ . <<'END_OF_SUB';
|
|
sub editor_add_field_form {
|
|
# -------------------------------------------------------------------
|
|
# Displays a form to add a new column.
|
|
#
|
|
my ($self, $msg) = @_;
|
|
print $self->{in}->header;
|
|
|
|
# Get the variables that need to be preserved and generate urls for them.
|
|
my $preserve_hash = $self->preserve();
|
|
my $preserve = '';
|
|
foreach my $p (keys %$preserve_hash) {
|
|
$preserve .= qq|&$p=$preserve_hash->{$p}|;
|
|
}
|
|
|
|
$msg &&= qq|<FONT COLOR="red"><B>$msg</B></FONT>|;
|
|
my $table = $self->{record};
|
|
print $self->_start_html({ title => "Table Editor: $table" });
|
|
|
|
# Set up defaults for the fields
|
|
my %attribs = ();
|
|
foreach my $def (qw/
|
|
column type not_null default form_display form_type form_size regex weight
|
|
size form_names form_values values file_save_in file_save_scheme
|
|
file_save_url file_max_size
|
|
/) {
|
|
$attribs{$def} = defined $self->{cgi}->{$def} ? $self->{cgi}->{$def} : '';
|
|
}
|
|
$attribs{form_type} ||= 'TEXT';
|
|
my $url = GT::CGI->url({ query_string => 0 });
|
|
|
|
print $self->_header("Table Editor", $msg || "Add a New Field to $table");
|
|
print $self->_start_form({ do => 'editor_add_field', db => $self->{cgi}->{db} });
|
|
print qq~
|
|
<p><font $FONT>For information on what each column means, <b><a href="$url?do=editor_column_help&db=$table$preserve">click here</a></b>.</p>
|
|
~;
|
|
my $index_list = $self->_index_list();
|
|
print $self->editor_column_form(\%attribs, $index_list, 'add');
|
|
|
|
print $self->_buttons("Add Field to");
|
|
print "<p>";
|
|
print $self->_prop_navbar;
|
|
print $self->_end_form;
|
|
print $self->_footer;
|
|
print $self->_end_html;
|
|
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{editor_add_field} = __LINE__ . <<'END_OF_SUB';
|
|
sub editor_add_field {
|
|
# -------------------------------------------------------------------
|
|
# Add a new column to the database.
|
|
#
|
|
my $self = shift;
|
|
ref $self->{cgi}->{db}
|
|
and return $self->error('BADARGS','FATAL', "Editor can only be called with one table, not a relation.");
|
|
my $editor = $self->{db}->editor($self->{cgi}->{db});
|
|
|
|
my %attribs;
|
|
my $table = $self->{cgi}->{db};
|
|
my $column = $self->{cgi}->{column} || return $self->editor_add_field_form("You must enter a column name.");
|
|
my %cols = $self->{table}->cols;
|
|
$attribs{type} = $self->{cgi}->{type} || return $self->editor_add_field_form("You must enter a column type.");
|
|
$attribs{size} = $self->{cgi}->{size};
|
|
$attribs{form_display} = $self->{cgi}->{form_display} || $self->{cgi}->{column};
|
|
$attribs{not_null} = $self->{cgi}->{not_null} || 0;
|
|
$attribs{default} = $self->{cgi}->{default};
|
|
$attribs{form_type} = $self->{cgi}->{form_type} || 'TEXT';
|
|
$attribs{form_size} = $self->{cgi}->{form_size} || '';
|
|
$attribs{regex} = $self->{cgi}->{regex} || '';
|
|
$attribs{weight} = $self->{cgi}->{weight} || '';
|
|
$attribs{file_save_in} = $self->{cgi}->{file_save_in} || '';
|
|
$attribs{file_save_url} = $self->{cgi}->{file_save_url} || '';
|
|
$attribs{file_max_size} = $self->{cgi}->{file_max_size} || '';
|
|
$attribs{file_save_scheme} = $self->{cgi}->{file_save_scheme} || '';
|
|
$attribs{form_names} = [split /[\r\n]+/, $self->{cgi}->{form_names}];
|
|
$attribs{form_values} = [split /[\r\n]+/, $self->{cgi}->{form_values}];
|
|
$attribs{values} = [split /[\r\n]+/, $self->{cgi}->{values}];
|
|
$attribs{pos} = keys(%cols) + 1;
|
|
|
|
# Error checking
|
|
my $errors = $self->editor_column_checks($column, \%attribs, 'add');
|
|
if (exists $cols{$column}) {
|
|
$errors .= "<li>Column '$column' already exists, please choose another name.";
|
|
}
|
|
if ($self->{cgi}->{index} eq 'primary') {
|
|
$errors .= "<li>You can not add a primary key to an existing table.";
|
|
}
|
|
$errors and return $self->editor_add_field_form("<ul>$errors</ul>");
|
|
|
|
# Add the column.
|
|
delete $attribs{column};
|
|
$editor->add_col($column, \%attribs) or return $self->editor_add_field_form("Unable to add column '$column': $GT::SQL::error");
|
|
|
|
my $field_form_message = "The column '$column' was added successfully, however an error occurred while ";
|
|
$self->{cgi}->{modify} = $column;
|
|
# Add the indexes.
|
|
if ($self->{cgi}->{index} eq 'regular') {
|
|
$editor->add_index($column . '_idx' => [$column]) or return $self->editor_columns("$field_form_message adding the index: $GT::SQL::error");
|
|
}
|
|
elsif ($self->{cgi}->{index} eq 'unique') {
|
|
$editor->add_unique($column . '_udx' => [$column]) or return $self->editor_columns("$field_form_message adding the unique index: $GT::SQL::error");
|
|
}
|
|
$self->{table}->reload;
|
|
|
|
return $self->editor_table_form("The database has been succesfully updated.");
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{editor_delete_field_form} = __LINE__ . <<'END_OF_SUB';
|
|
sub editor_delete_field_form {
|
|
# -------------------------------------------------------------------
|
|
# Displays a form to delete a column.
|
|
#
|
|
my ($self, $msg) = @_;
|
|
print $self->{in}->header;
|
|
|
|
$msg &&= qq|<FONT COLOR="red"><B>$msg</B></FONT>|;
|
|
my $table = $self->{record};
|
|
print $self->_start_html({ title => "Table Editor: $table" });
|
|
print $self->_header("Table Editor", $msg || "Delete a Field from $table.");
|
|
print $self->_start_form({ do => 'editor_delete_field', db => $self->{cgi}->{db} });
|
|
|
|
print qq~
|
|
<table border=1 cellpadding=0 cellspacing=0><tr><td>
|
|
<table border=0 width=500><tr><td>
|
|
<p><font $FONT><b>WARNING:</b> If you remove a field, all data in that field will be lost. Also, if you remove
|
|
one of the system fields, certain functions may not work any more!<br><br>~;
|
|
my @cols = grep !exists $self->{table}->{schema}->{cols}->{$_}->{protect}, $self->{table}->ordered_columns;
|
|
if (@cols) {
|
|
print qq~
|
|
Delete the following field:
|
|
<select name="delete-field">
|
|
~;
|
|
foreach my $column (@cols) {
|
|
print "<option>$column</option>";
|
|
}
|
|
print qq~
|
|
</select>
|
|
<font $FONT><input type=submit name=delete value="Delete Field"></font></p>
|
|
~;
|
|
}
|
|
else {
|
|
print qq<<p align="center"><font color="red">No columns can be deleted.</font></p>>;
|
|
}
|
|
print qq~
|
|
</td></tr></table>
|
|
</td></tr></table>
|
|
<br>
|
|
~;
|
|
print $self->_prop_navbar;
|
|
print $self->_end_form;
|
|
print $self->_footer;
|
|
print $self->_end_html;
|
|
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{editor_delete_field} = __LINE__ . <<'END_OF_SUB';
|
|
sub editor_delete_field {
|
|
# -------------------------------------------------------------------
|
|
# Remove a field from the table.
|
|
#
|
|
my $self = shift;
|
|
ref $self->{cgi}->{db}
|
|
and return $self->error('BADARGS','FATAL', "Editor can only be called with one table, not a relation.");
|
|
my $editor = $self->{db}->editor($self->{cgi}->{db});
|
|
|
|
my $table = $self->{cgi}->{db};
|
|
my $field = $self->{cgi}->{'delete-field'} || return $self->editor_delete_field_form("Please select a field to delete!");
|
|
($field eq 'ID') and return $self->editor_delete_field_form("You can't remove the ID field.");
|
|
|
|
# Drop the column from the database.
|
|
$editor->drop_col($field) or return $self->editor_delete_field_form($GT::SQL::error);
|
|
|
|
return $self->editor_delete_field_form("The database has been successfully updated.");
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{editor_update_def} = __LINE__ . <<'END_OF_SUB';
|
|
sub editor_update_def {
|
|
# -------------------------------------------------------------------
|
|
# Re-sync the def file with what's in the database.
|
|
#
|
|
my $self = shift;
|
|
|
|
# We need a creator for this.
|
|
my $c = $self->{db}->creator($self->{table}->name);
|
|
$c->load_table or return $self->editor_table_form("Could not update def files reason $GT::SQL::error");
|
|
|
|
# Re Load our table object.
|
|
$self->{table}->reload;
|
|
|
|
return $self->editor_table_form("The .def file has been re-synced.");
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{editor_column_help} = __LINE__ . <<'END_OF_SUB';
|
|
sub editor_column_help {
|
|
# --------------------------------------------------------
|
|
# Displays a help page for the editor.
|
|
#
|
|
my ($self, $msg) = @_;
|
|
my $table = $self->{cgi}->{db};
|
|
print $self->{in}->header;
|
|
print $self->_start_html;
|
|
print $self->_header("Table Editor", $msg || "Add/Edit Columns Help.");
|
|
print $self->_start_form({ do => 'editor_add_field', db => $self->{cgi}->{db} });
|
|
print qq~
|
|
<table width=500 border=1 cellpadding=3 cellspacing=0><tr><td>
|
|
<table border=0 width=500>
|
|
<p><font $FONT>From here you can add a new column to your table <b>$table</b>. When creating your column, you should set the following options:
|
|
<ul>
|
|
<li><b>Column Name</b>: This is the name of your column. It must be a valid SQL name, which is just letters, numbers and the underscore character. Also,
|
|
try to avoid reserved words like FROM, SELECT, WHERE, JOIN, etc.
|
|
<li><b>Column Type</b>: This is the type of column you want to create. Your choices are:
|
|
<ul>
|
|
<li>INT: This stores integer numbers, i.e. 1, 2, 3. Whole numbers without decimal points between -2147483648 and 2147483647.
|
|
<li>TINYINT: This stores integers between -128 and 127.
|
|
<li>SMALLINT: This stores integers between -32768 and 32767.
|
|
<li>MEDIUMINT: This stores integers between -8388608 and 8388607.
|
|
<li>BIGINT: This stores integers between -9223372036854775808 and 9223372036854775807.
|
|
<li>FLOAT: This stores 32-bit floating point numbers.
|
|
<li>DOUBLE: This stores 64-bit floating point numbers.
|
|
<li>CHAR: This stores any string up to a maximum size of 255. If you set a CHAR, you must set the
|
|
maximum size in Column Size.
|
|
<li>VARCHAR: This is the same as a CHAR column type except in the way it is stored and retrieved
|
|
from the database.
|
|
<li>TEXT: This stores a (virtually) unlimited amount of text. Use this for storing very large
|
|
amounts of texts.
|
|
<li>DATE: This stores a date defaulting to yyyy-mm-dd format.
|
|
<li>ENUM: This stores an enumerated list. This is useful when you want a field that can be
|
|
one of several values. For example, you could create a Status column that can contain
|
|
the values: 'Not Registered', 'Registered', 'Moderator', 'SuperUser'. The entries in this
|
|
column must be one of the listed values. You specify what values you want using one line
|
|
per entry in the Column Values field.
|
|
</ul>
|
|
<li><b>Column Index</b>: This determins what sort of index the SQL server should use to speed up queries. If you use
|
|
an index, you must set Not Null to Yes.
|
|
<li><b>Column Size</b>: This is only useful for CHAR types. It stores the maximum size a field can be and should range
|
|
anywhere from 1 to 255.
|
|
<li><b>Column Values</b>: This is only useful for ENUM types. It stores the list of possible values, one per line.
|
|
<li><b>Not Null</b>: If you set this to Yes, then a value must be entered for this column. If you set this to No, then
|
|
when you add a record, this column can be left blank.
|
|
<li><b>Default</b>: This is the default value that will be displayed when adding a record.
|
|
<li><b>Form Type</b>: This is the type of form to use when adding or modifying a record. Your choices are:
|
|
<ul>
|
|
<li>Hidden: This column will be hidden on the add and modify forms.
|
|
<li>Select: A select list will be generated. For select lists, Form Size determines the size
|
|
of the select list (set to 0 for a single select list, higher for multiple select lists). You should
|
|
enter the values of the select list (what will be displayed to the user) in the Form Values textarea, and
|
|
the data of the select list (what will be stored in the database) in the Form Names textarea.
|
|
<li>Checkbox: This generates a set of checkboxes. You need to enter into Form Values a list of all
|
|
the checkbox values (what will be displayed to the user), and in Form Names, a list of what will be stored
|
|
in the database. The data is stored in the database joined on a new line.
|
|
<li>Radio: This generates a radio option list. You must enter into Form Names the value that will be stored in the database,
|
|
and in Form Values, the value that will be displayed.
|
|
<li>Text: This generates a simple text box. You can set the size of text box using Form Size.
|
|
<li>Textarea: This generates a textarea field. You can set the rows and columns to use in the Form Size by entering rows,cols
|
|
(for example: 30,4).
|
|
<li>Password: This generates a password box. You can set the size of password box using Form Size.
|
|
<li>File: This creates a standard file field. You must set the File Save Location and set the database type to CHAR.
|
|
</ul>
|
|
<li><b>Form Size</b>: This is only useful for select, text or textarea form types. For selects, set this to 0 to be a single
|
|
select field, set it to a postive number to be a multi select field. For Text fields, set this to the size of the text box, for
|
|
textarea types, set this to rows,cols to specify the size.
|
|
<li><b>Form Names</b>: This is only useful for Select, Checkbox or Radio types. This is what will be stored in the database. You
|
|
should enter one value per line.
|
|
<li><b>Form Values</b>: This is only useful for Select, Checkbox or Radio types. This is what will be displayed to the user. You should
|
|
enter one value per line.
|
|
|
|
<li><b>File Save Location</b>: Specifies in which directory where the the files are saved. Once you have set this, please try not to
|
|
change the save path. If you must, do not move the existing files unless you are prepared to prepared to update your
|
|
"@{[$self->{table}->name()]}_Files" table to reflect the move.
|
|
|
|
<li><b>File Save URL</b>: If this directory is accessibly by URL, specjfiy the base url here. This will allow retrieval of the full URL
|
|
path to the file should you want to display the file for viewing or download.
|
|
|
|
<li><b>File Save Method</b>: Once this has been set, please do not change unless there are no files being handled by the system.
|
|
This option sets how the files are to be stored in the directory. If you expect many files to be uploaded, the system will
|
|
use a collection of different directories to store the files. This allows faster lookups for by the OS and experienced
|
|
users will be able to "symlink" some of the directories to other harddrives to distribute the load.
|
|
|
|
<li><b>File Maximum Size</b>: Caps the maximum number of bytes of files users can upload.
|
|
|
|
<li><b>Form Regex</b>: This is a perl regular expression that data must match before being inserted or updated.
|
|
<li><b>Search Weight</b>: If this is set to a positive value, this field will be included in the search index. Note: you must
|
|
rebuild the search index after changing/adding a search weight.
|
|
</ul>
|
|
</p>
|
|
</tr></td></table>
|
|
</tr></td></table>
|
|
~;
|
|
print "<p>";
|
|
print $self->_prop_navbar;
|
|
print $self->_end_form;
|
|
print $self->_footer;
|
|
print $self->_end_html;
|
|
return;
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $self->editor_import_data_form;
|
|
# -------------------------------
|
|
# Prints the page to import data.
|
|
##
|
|
$COMPILE{editor_import_data_form} = __LINE__ . <<'END_OF_SUB';
|
|
sub editor_import_data_form {
|
|
my ($self, $msg) = @_;
|
|
print $self->{in}->header;
|
|
$msg &&= qq|<FONT COLOR="red"><B>$msg</B></FONT>|;
|
|
my $table = $self->{record};
|
|
|
|
|
|
print $self->_start_html({ title => "Table Editor: $table" });
|
|
print $self->_header("Table Editor", $msg || "Import Data to $table.");
|
|
print $self->_start_form({ do => 'editor_import_data', db => $self->{cgi}->{db} }, { name => 'ImportForm'});
|
|
|
|
|
|
print qq~
|
|
<SCRIPT language="Javascript">
|
|
<!--
|
|
|
|
function AddAll (From, To) {
|
|
var FromObj = document.ImportForm[From];
|
|
var ToObj = document.ImportForm[To];
|
|
|
|
var i = 1;
|
|
var track = 1;
|
|
while (i < FromObj.options.length) {
|
|
if (track == FromObj.options.length) {
|
|
alert ("You can not add more than the number of fields in the select list.");
|
|
return;
|
|
}
|
|
if (ToObj.options[track].value != "") { track++; continue }
|
|
for (var l = 1; l < ToObj.options.length; l++) {
|
|
if (ToObj.options[l].value == FromObj.options[i].value) {
|
|
alert ("You can not have duplitcate values for an import.");
|
|
return false;
|
|
}
|
|
}
|
|
ToObj.options[track].value = FromObj.options[i].value;
|
|
ToObj.options[track].text = FromObj.options[i].text;
|
|
ToObj.options[track].selected = true;
|
|
i++;
|
|
track++;
|
|
}
|
|
return true;
|
|
}
|
|
|
|
function AddIt (From, To) {
|
|
var FromObj = document.ImportForm[From];
|
|
var ToObj = document.ImportForm[To];
|
|
|
|
var track = 1;
|
|
var i = 1;
|
|
while (i < FromObj.options.length) {
|
|
if (track == FromObj.options.length) {
|
|
alert ("You can not add more than the number of fields in the select list.");
|
|
return false;
|
|
}
|
|
if (ToObj.options[track].value != "") { track++; continue }
|
|
if (FromObj.options[i].selected) {
|
|
for (var l = 1; l < ToObj.options.length; l++) {
|
|
if (ToObj.options[l].value == FromObj.options[i].value) {
|
|
alert ("You can not have duplitcate values for an import.");
|
|
return false;
|
|
}
|
|
}
|
|
ToObj.options[track].value = FromObj.options[i].value;
|
|
ToObj.options[track].text = FromObj.options[i].text;
|
|
ToObj.options[track].selected = true;
|
|
track++;
|
|
}
|
|
i++;
|
|
}
|
|
return true;
|
|
}
|
|
|
|
function Clear (What) {
|
|
var Obj = document.ImportForm[What];
|
|
for (var i = 1; i < Obj.options.length; i++) {
|
|
Obj.options[i].value = "";
|
|
Obj.options[i].text = "";
|
|
Obj.options[i].selected = false;
|
|
}
|
|
return true;
|
|
}
|
|
|
|
//-->
|
|
</SCRIPT>
|
|
~;
|
|
|
|
print qq~
|
|
<table border=0 width=500><tr><td>
|
|
<p><font $FONT>You can either import from a file or you can cut and paste the contents into a textarea box. If you
|
|
have a large number of records, you should really import from a file. If you use quick mode, the file must contain the same
|
|
number of fields as the current table, and in the same order. If you don't use quick mode, the first line of either the file
|
|
or the text box must be a list of column names!<br>
|
|
|
|
</td></tr></table>
|
|
<table border=0 width=500><tr><td>
|
|
<tr><td colspan=3 align=center>
|
|
<font $FONT><b>Fields to Import</b></font></td></tr>
|
|
<tr><td><font $FONT>
|
|
~;
|
|
|
|
my @cols = $self->{table}->ordered_columns;
|
|
print qq|<select name="ImportLeft" size=10>\n<option value="">----------------------------</option>\n|;
|
|
foreach my $column (@cols) {
|
|
print '<option value="'. $column . '">' . $column . '</option>' . "\n";
|
|
}
|
|
print qq~
|
|
</select></td><td align="center">
|
|
<input type="button" value="Add All >" onclick="AddAll('ImportLeft', 'ImportRight');"><br>
|
|
<input type="button" value="Add >" onclick="AddIt('ImportLeft', 'ImportRight');"><br>
|
|
<input type="button" value="Clear" onclick="Clear('ImportRight');"><br>
|
|
<td><font $FONT>
|
|
|
|
~;
|
|
|
|
print qq|<select name="ImportRight" size=10 multiple>\n<option value="">----------------------------</option>\n|;
|
|
foreach my $column (@cols) {
|
|
print qq|<option value=""></option>\n|;
|
|
}
|
|
print qq~
|
|
</select>
|
|
</td></tr></table>
|
|
<br>
|
|
<table border=0 width=500><tr><td>
|
|
<p><font $FONT>
|
|
Import data from file: <input type=text name="import-file" size=10> or from textarea box:<br>
|
|
<textarea name="import-text" rows=3 cols=40></textarea><br>
|
|
Use <input type=text name="import-delim" value="|" size=1> as delimiter.
|
|
<input type=checkbox name="import-delete" value=1> Delete old data first
|
|
<br>
|
|
</tr></td></table>
|
|
~;
|
|
print $self->_buttons("Import Data into");
|
|
print "<P>";
|
|
print $self->_end_form;
|
|
print $self->_prop_navbar;
|
|
print "<P>";
|
|
print $self->_footer;
|
|
print $self->_end_html;
|
|
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{editor_import_data} = __LINE__ . <<'END_OF_SUB';
|
|
sub editor_import_data {
|
|
# --------------------------------------------------------
|
|
# Import data from textarea box or file.
|
|
#
|
|
my $self = shift;
|
|
my ($delim, $file, $text, $res, @header);
|
|
|
|
$delim = $self->{cgi}->{'import-delim'} || return $self->editor_import_data_form("No import delimiter specified!");
|
|
$file = $self->{cgi}->{'import-file'};
|
|
$text = $self->{cgi}->{'import-text'};
|
|
|
|
# Make sure they have picked the fields to import
|
|
$self->{cgi}->{'ImportRight'} or return $self->editor_import_data_form("No fields selected to import");
|
|
@header = reverse ((ref ($self->{cgi}->{'ImportRight'}) eq 'ARRAY') ? @{$self->{cgi}->{'ImportRight'}} : $self->{cgi}->{'ImportRight'});
|
|
|
|
my $todo = 0;
|
|
for (@header) {
|
|
unless (/^$/) {
|
|
$todo = 1;
|
|
last;
|
|
}
|
|
}
|
|
unless ($todo) { return $self->editor_import_data_form("No fields selected to import") }
|
|
|
|
# Make sure there is some data to import
|
|
$file or $text or return $self->editor_import_data_form("You must enter at least a filename or data in the textarea box.");
|
|
$file and $text and return $self->editor_import_data_form("Please only enter either a filename or data in the textarea box, not both.");
|
|
$delim = "\t" if $delim eq '\t';
|
|
|
|
# Store the lines to import in @lines and the header in $header.
|
|
my ($good_cnt, $err_cnt, $line, $line_num, @lines, @data, $error, %record, $i);
|
|
if ($file) {
|
|
open (FILE, "<$file") or return $self->editor_import_data_form("Unable to open file '$file': $!");
|
|
local $/;
|
|
@lines = split /[\r\n]+/, <FILE>;
|
|
close FILE;
|
|
}
|
|
else {
|
|
@lines = split /[\r\n]+/, $text;
|
|
}
|
|
|
|
# Remove old data if requested.
|
|
my $table = $self->{cgi}->{db};
|
|
if ($self->{cgi}->{'import-delete'}) {
|
|
$self->{table}->delete_all;
|
|
}
|
|
|
|
# Do the import.
|
|
$good_cnt = $err_cnt = 0;
|
|
LINE: for my $line_num (0 .. $#lines) {
|
|
($err_cnt > 10) and last LINE;
|
|
$line = $lines[$line_num];
|
|
@data = split /\Q$delim\E/, $line, -1;
|
|
if ($#data != $#header) {
|
|
$error .= "<li>" . ($line_num+2) . ": Row count: " . ($#data+1) .
|
|
" does not match header count: (@data) (@header)" . ($#header+1) . "\n";
|
|
$err_cnt++;
|
|
next LINE;
|
|
}
|
|
$i = 0;
|
|
%record = ();
|
|
for (@data) {
|
|
$data[$i] =~ s/``/$delim/g;
|
|
$data[$i] =~ s/~~/\n/g;
|
|
$record{$header[$i]} = $data[$i];
|
|
$i++;
|
|
}
|
|
unless ($line_num){ # check the first line and ignore it if this is a header line
|
|
my @check_diff = grep $record{$_} ne $_ => @data;
|
|
(@check_diff) or next LINE;
|
|
}
|
|
if (!$self->{table}->add(\%record, 1)) {
|
|
$error .= "<li>" . ($line_num+2) . ": Failed validation. Error: <ul>$GT::SQL::error</ul>\n";
|
|
$err_cnt++;
|
|
next LINE;
|
|
}
|
|
$good_cnt++;
|
|
}
|
|
|
|
# Return the results.
|
|
if ($error) {
|
|
return $self->editor_import_data_form(($err_cnt >= 10) ?
|
|
"Aborting, too many errors!<br><br>Rows imported: $good_cnt<br>Errors with the following rows:
|
|
<font size=-1><ul>$error</ul></font><br>" :
|
|
"Rows imported: $good_cnt<br>Errors with the following rows: <font size=-1><ul>$error</ul></font><br>");
|
|
}
|
|
return $self->editor_import_data_form("Rows imported: $good_cnt.");
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $self->editor_export_data_form;
|
|
# -------------------------------
|
|
# Prints the page to export data.
|
|
##
|
|
$COMPILE{editor_export_data_form} = __LINE__ . <<'END_OF_SUB';
|
|
sub editor_export_data_form {
|
|
my ($self, $msg) = @_;
|
|
print $self->{in}->header;
|
|
|
|
$msg &&= qq|<FONT COLOR="red"><B>$msg</B></FONT>|;
|
|
my $table = $self->{record};
|
|
print $self->_start_html({ title => "Table Editor: $table" });
|
|
print $self->_header("Table Editor", $msg || "Export Data from $table.");
|
|
|
|
print qq~
|
|
<SCRIPT language="Javascript">
|
|
<!--
|
|
|
|
function AddAll (From, To) {
|
|
var FromObj = document.ExportForm[From];
|
|
var ToObj = document.ExportForm[To];
|
|
|
|
var i = 1;
|
|
var track = 1;
|
|
while (i < FromObj.options.length) {
|
|
if (track == FromObj.options.length) {
|
|
alert ("You can not add more than the number of fields in the select list.");
|
|
return;
|
|
}
|
|
if (ToObj.options[track].value != "") { track++; continue }
|
|
ToObj.options[track].value = FromObj.options[i].value;
|
|
ToObj.options[track].text = FromObj.options[i].text;
|
|
ToObj.options[track].selected = true;
|
|
i++;
|
|
track++;
|
|
}
|
|
return true;
|
|
}
|
|
|
|
function AddIt (From, To) {
|
|
var FromObj = document.ExportForm[From];
|
|
var ToObj = document.ExportForm[To];
|
|
|
|
var track = 1;
|
|
var i = 1;
|
|
while (i < FromObj.options.length) {
|
|
if (track == FromObj.options.length) {
|
|
alert ("You can not add more than the number of fields in the select list.");
|
|
return false;
|
|
}
|
|
if (ToObj.options[track].value != "") { track++; continue }
|
|
if (FromObj.options[i].selected) {
|
|
ToObj.options[track].value = FromObj.options[i].value;
|
|
ToObj.options[track].text = FromObj.options[i].text;
|
|
ToObj.options[track].selected = true;
|
|
track++;
|
|
}
|
|
i++;
|
|
}
|
|
return true;
|
|
}
|
|
|
|
function Clear (What) {
|
|
var Obj = document.ExportForm[What];
|
|
for (var i = 1; i < Obj.options.length; i++) {
|
|
Obj.options[i].value = "";
|
|
Obj.options[i].text = "";
|
|
Obj.options[i].selected = false;
|
|
}
|
|
return true;
|
|
}
|
|
|
|
//-->
|
|
</SCRIPT>
|
|
~;
|
|
print $self->_start_form({ do => 'editor_export_data', db => $self->{cgi}->{db} }, {name => 'ExportForm'});
|
|
|
|
print qq~
|
|
<table border=0 width=500><tr><td>
|
|
<p><font $FONT>You can either export your data from $table table to the screen or to a file.
|
|
If you have a large amount of
|
|
data it is recommended to export the contents to a file. Quick mode should be
|
|
used when exporting to a file as it
|
|
uses the SQL server to do the exporting and is considerably faster.</font><br>
|
|
</td></tr></table>
|
|
|
|
<table border=0 width=500><tr><td>
|
|
<tr><td colspan=3 align=center>
|
|
<font $FONT><b>Fields to Export</b></font></td></tr>
|
|
<tr><td><font $FONT>
|
|
~;
|
|
|
|
my @cols = $self->{table}->ordered_columns;
|
|
print qq|<select name="ExportLeft" size=10>\n<option value="">----------------------------</option>\n|;
|
|
foreach my $column (@cols) {
|
|
print '<option value="'. $column . '">' . $column . '</option>' . "\n";
|
|
}
|
|
print qq~
|
|
</select></td><td align="center"><font $FONT>
|
|
<input type="button" value="Add All >" onclick="AddAll('ExportLeft', 'ExportRight');"><br>
|
|
<input type="button" value="Add >" onclick="AddIt('ExportLeft', 'ExportRight');"><br>
|
|
<input type="button" value="Clear" onclick="Clear('ExportRight');"></td>
|
|
<td><font $FONT>
|
|
~;
|
|
|
|
print qq|<select name="ExportRight" size=10 multiple>\n<option value="">----------------------------</option>\n|;
|
|
foreach (@cols) {
|
|
print qq|<option value=""></option>\n|;
|
|
}
|
|
print qq~
|
|
</select>
|
|
</td></tr></table>
|
|
<br>
|
|
<table border=0 width=500><tr><td><font $FONT>
|
|
Export data to: <select name="export-mode"><option>file<option>screen</select>
|
|
filename: <input type=text name="export-file" size=10><br>
|
|
Use <input type=text name="export-delim" value="|" size=1> as delimiter.
|
|
</font>
|
|
</td></tr></table>
|
|
~;
|
|
print $self->_buttons("Export Data from");
|
|
print "<P>";
|
|
print $self->_end_form;
|
|
print $self->_prop_navbar;
|
|
print "<P>";
|
|
print $self->_footer;
|
|
print $self->_end_html;
|
|
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{editor_export_data} = __LINE__ . <<'END_OF_SUB';
|
|
sub editor_export_data {
|
|
# --------------------------------------------------------
|
|
# Export data to text file/screen.
|
|
#
|
|
my $self = shift;
|
|
ref $self->{cgi}->{db}
|
|
and return $self->error('BADARGS','FATAL', "Editor can only be called with one table, not a relation.");
|
|
my $editor = $self->{db}->editor($self->{cgi}->{db});
|
|
|
|
my ($delim, $quick, $res);
|
|
|
|
$self->{cgi}->{'ExportRight'} or return $self->editor_export_data_form("No fields selected to export.");
|
|
my @order = reverse(ref $self->{cgi}->{'ExportRight'} eq 'ARRAY' ? @{$self->{cgi}->{'ExportRight'}} : $self->{cgi}->{'ExportRight'});
|
|
|
|
my $todo = 0;
|
|
for (@order) {
|
|
unless (/^$/) {
|
|
$todo = 1;
|
|
last;
|
|
}
|
|
}
|
|
unless ($todo) { return $self->editor_export_data_form("No fields selected to Export.") }
|
|
|
|
$delim = $self->{cgi}->{'export-delim'};
|
|
($delim eq '\t') and ($delim = "\t");
|
|
|
|
if ($self->{cgi}->{'export-mode'} eq 'file') {
|
|
$self->{cgi}->{'export-file'} or return $self->editor_export_data_form("Please enter a file name!");
|
|
$editor->export_data(
|
|
{
|
|
file => $self->{cgi}->{'export-file'},
|
|
delim => $delim,
|
|
header => 1,
|
|
order => \@order
|
|
}
|
|
) or return $self->editor_export_data_form($GT::SQL::error);
|
|
return $self->editor_export_data_form("Data has been exported to: $self->{cgi}->{'export-file'}");
|
|
}
|
|
else {
|
|
print $self->{in}->header;
|
|
$editor->export_data(
|
|
{
|
|
delim => $delim,
|
|
header => 1,
|
|
order => \@order
|
|
}
|
|
) or return $self->editor_export_data_form($GT::SQL::error);
|
|
return;
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
# ================================================================================ #
|
|
# PRIVATE/INTERNAL METHODS #
|
|
# ================================================================================ #
|
|
|
|
##
|
|
# $self->_check_opts;
|
|
# -------------------
|
|
# This checks to make sure the user specified at least one
|
|
# column to search on.
|
|
##
|
|
$COMPILE{_check_opts} = __LINE__ . <<'END_OF_SUB';
|
|
sub _check_opts {
|
|
my $self = shift;
|
|
my $sel = 0;
|
|
|
|
# Relation does not play fare :(
|
|
my $cols = $self->{table}->cols;
|
|
for (keys %{$self->{cgi}}) { $sel = 1 if (($self->{cgi}->{$_} =~ /\S/) and exists $cols->{$_}) }
|
|
if ((exists $self->{cgi}->{query} and $self->{cgi}->{query} =~ /\S/) or
|
|
(exists $self->{cgi}->{keyword} and $self->{cgi}->{keyword} =~ /\S/)) {
|
|
$sel = 1;
|
|
}
|
|
$sel or return;
|
|
return 1;
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $self->_header;
|
|
# ---------------
|
|
# Returns the header to be used with the forms, error pages, etc...
|
|
##
|
|
$COMPILE{_header} = __LINE__ . <<'END_OF_SUB';
|
|
sub _header {
|
|
my ($self, $head, $msg) = @_;
|
|
if ($self->{header}) {
|
|
if (ref $self->{header} eq 'CODE') {
|
|
return $self->{header}->($self, $head, $msg);
|
|
}
|
|
else {
|
|
return $self->{header};
|
|
}
|
|
}
|
|
else {
|
|
my $out = qq~
|
|
<table border=1 cellpadding=0 cellspacing=0>
|
|
<tr>
|
|
<td>
|
|
<table border=0 bgcolor="#FFFFFF" cellpadding=3 cellspacing=3 width=500 valign=top>
|
|
<tr>
|
|
<td align=left bgcolor="$BAR_COLOR">
|
|
<font $BAR_FONT><b>$self->{record}: $head</b></font>
|
|
</td>
|
|
</tr>
|
|
<tr>
|
|
<td>
|
|
<p><center><font $TITLE_FONT><b>$self->{record}: $head</b></font></center></p>
|
|
<p><font $FONT>$msg</font></p>
|
|
</td>
|
|
</tr>
|
|
</table>
|
|
</td>
|
|
</tr>
|
|
</table>
|
|
~;
|
|
}
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $self->_footer;
|
|
# ---------------
|
|
# Returns the footer to set for each form.
|
|
##
|
|
$COMPILE{_footer} = __LINE__ . <<'END_OF_SUB';
|
|
sub _footer {
|
|
my $self = shift;
|
|
|
|
# Get the variables that need to be preserved and generate urls for them.
|
|
my $preserve_hash = $self->preserve();
|
|
my $preserve = '';
|
|
foreach my $p (keys %$preserve_hash) {
|
|
$preserve .= qq|&$p=$preserve_hash->{$p}|;
|
|
}
|
|
|
|
if ($self->{footer}) {
|
|
if (ref $self->{footer} eq 'CODE') {
|
|
my $ret = $self->{footer}->($self);
|
|
return $ret if (defined $ret);
|
|
}
|
|
else {
|
|
return $self->{footer};
|
|
}
|
|
}
|
|
my $url = GT::CGI->url({ query_string => 0 }) . "?";
|
|
my @vals = GT::CGI->param('db');
|
|
foreach my $val (@vals) {
|
|
$url .= "db=" . GT::CGI->escape($val) . "&";
|
|
}
|
|
chop $url;
|
|
my $ret = qq~
|
|
<table border=1 cellpadding=0 cellspacing=0><tr><td align=center>
|
|
<table border=0 width=500><tr><td align=center>
|
|
<center><font $FONT>$self->{record}:
|
|
<a href="$url&do=add_form$preserve">Add</a> |
|
|
<a href="$url&do=modify_search_form$preserve">Modify</a> |
|
|
<a href="$url&do=delete_search_form$preserve">Delete</a> |
|
|
<a href="$url&do=search_form$preserve">Search</a>
|
|
~;
|
|
if (!exists $self->{table}->{tables}) {
|
|
$ret .= qq~ |
|
|
<a href="$url&do=editor_table_form$preserve">Properties</a>
|
|
~;
|
|
}
|
|
$ret .= qq~
|
|
</font></center></td></tr></table>
|
|
</td></tr></table>
|
|
~;
|
|
return $ret;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_prop_navbar} = __LINE__ . <<'END_OF_SUB';
|
|
sub _prop_navbar {
|
|
my $self = shift;
|
|
|
|
# Get the variables that need to be preserved and generate urls for them.
|
|
my $preserve_hash = $self->preserve();
|
|
my $preserve = '';
|
|
foreach my $p (keys %$preserve_hash) {
|
|
$preserve .= qq|&$p=$preserve_hash->{$p}|;
|
|
}
|
|
|
|
my @vals = GT::CGI->param('db');
|
|
my $url = GT::CGI->url({ query_string => 0 }) . "?";
|
|
foreach my $val (@vals) {
|
|
$url .= "db=" . GT::CGI->escape($val) . "&";
|
|
}
|
|
chop $url;
|
|
return qq~
|
|
<table border=1 cellpadding=0 cellspacing=0><tr><td>
|
|
<table border=0 cellpadding=3 cellspacing=2 width="500">
|
|
<tr><td align=center><center><font $FONT>Properties:
|
|
<a href="$url&do=editor_add_field_form$preserve">Add Column</a> |
|
|
<a href="$url&do=editor_delete_field_form$preserve">Delete Column</a> |
|
|
<a href="$url&do=editor_import_data_form$preserve">Import Data</a> |
|
|
<a href="$url&do=editor_export_data_form$preserve">Export Data</a> |
|
|
<a href="$url&do=editor_update_def$preserve">Resync Database</a>
|
|
</center></td></tr>
|
|
</table>
|
|
</td></tr>
|
|
</table>
|
|
~;
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $self->_search_options;
|
|
# ---------------
|
|
# Returns the search options.
|
|
##
|
|
$COMPILE{_search_options} = __LINE__ . <<'END_OF_SUB';
|
|
sub _search_options {
|
|
my $self = shift;
|
|
my $opts = shift;
|
|
if ($self->{search_options}) {
|
|
if (ref $self->{search_options} eq 'CODE') {
|
|
return $self->{search_options}->($self, $opts);
|
|
}
|
|
else {
|
|
return $self->{search_options};
|
|
}
|
|
}
|
|
|
|
# First, figure out the sort by columns.
|
|
my $c = $self->{table}->cols;
|
|
my ($hash, $order) = ({}, []);
|
|
foreach my $col (sort {
|
|
defined $c->{$a}->{pos} or warn "No pos for $a\n";
|
|
defined $c->{$b}->{pos} or warn "No pos for $b\n";
|
|
|
|
$c->{$a}->{'pos'} <=> $c->{$b}->{'pos'}
|
|
} keys %$c) {
|
|
$hash->{$col} = $c->{$col}->{form_display} || $col;
|
|
push @$order, $col;
|
|
}
|
|
my $sb = $self->{html}->select(
|
|
{
|
|
name => "sb",
|
|
values => $hash,
|
|
sort_order => $order,
|
|
default => $self->{cgi}->{sb},
|
|
blank => 1
|
|
}
|
|
);
|
|
|
|
my $so = $self->{html}->select(
|
|
{
|
|
name => "so",
|
|
values => {
|
|
'ASC' => 'Ascending',
|
|
'DESC' => 'Descending'
|
|
},
|
|
default => $self->{cgi}->{sb},
|
|
blank => 1
|
|
}
|
|
);
|
|
|
|
my $dr = $self->{html}->select(
|
|
{
|
|
name => "dr",
|
|
values => {
|
|
'' => 'As Elements',
|
|
'rows' => 'As Rows'
|
|
},
|
|
default => $self->{cgi}->{dr},
|
|
blank => 1
|
|
}
|
|
);
|
|
|
|
# Then set the rest of the form options.
|
|
my $ma = exists $self->{cgi}->{ma} ? 'CHECKED' : '';
|
|
my $mh = exists $self->{cgi}->{mh} ? $self->{cgi}->{mh} : 25;
|
|
my $kw = exists $self->{cgi}->{keyword} ? $self->{cgi}->{keyword} : '';
|
|
my $idx = exists $self->{cgi}->{indexed} ? $self->{cgi}->{indexed} : '';
|
|
|
|
my $out = qq~
|
|
<table border=1 cellpadding=0 cellspacing=0><tr><td>
|
|
<table border=0 width=500>
|
|
<tr>
|
|
<td><font $FONT>Maximum Hits:</font></td>
|
|
<td><input type="text" name="mh" size="3" value="$mh"></td>
|
|
<td><font $FONT>Match Any: </font></td>
|
|
<td><input type="checkbox" name="ma"$ma></td>
|
|
</tr>
|
|
<tr>
|
|
<td><font $FONT>Keyword Search:</font></td>
|
|
<td colspan=3><input type="text" name="keyword" value="$kw"></td>
|
|
</tr>
|
|
<tr>
|
|
<td><font $FONT>Indexed Search:</font></td>
|
|
<td colspan=3><input type="text" name="query" value="$idx"></td>
|
|
</tr>
|
|
<tr>
|
|
<td><font $FONT>Sort By:</font></td>
|
|
<td><font $FONT>$sb</td>
|
|
<td><font $FONT>Using:</font></td>
|
|
<td><font $FONT>$so</td>
|
|
</tr>~;
|
|
|
|
if ( ( () = $self->{in}->param('db') ) == 1 ) {
|
|
$out .= qq~
|
|
<tr>
|
|
<td><font $FONT>Display Records:</font></td>
|
|
<td><font $FONT>$dr</td>
|
|
</tr>
|
|
~;
|
|
}
|
|
|
|
if (exists $opts->{modify_mult} and $opts->{modify_mult}) {
|
|
$out .= qq~
|
|
<tr>
|
|
<td><font $FONT>Modify Multiple:</font></td>
|
|
<td colspan=3><input type="checkbox" name="modify_multi_form" value="1"></td>
|
|
</tr>
|
|
~;
|
|
}
|
|
$out .= qq~
|
|
</table>
|
|
</td></tr>
|
|
</table>
|
|
~;
|
|
return $out;
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $self->_start_form;
|
|
# -------------------------
|
|
# Display the opening form tag.
|
|
##
|
|
$COMPILE{_start_form} = __LINE__ . <<'END_OF_SUB';
|
|
sub _start_form {
|
|
my $self = shift;
|
|
my $opts = shift || {};
|
|
my $meth = exists $opts->{method} ? $opts->{method} : 'POST';
|
|
my $attrib = shift || {};
|
|
|
|
# If a code ref was specified execute it and return the output to be printed
|
|
if ($self->{start_form}) {
|
|
if (ref $self->{start_form} eq 'CODE') {
|
|
return $self->{start_form}->($self, $opts, $meth);
|
|
}
|
|
else {
|
|
return $self->{start_form};
|
|
}
|
|
}
|
|
|
|
# Get the variables that need to be preserved and generate hidden tags for them.
|
|
my $preserve = $self->preserve();
|
|
my $hidden_tags = '';
|
|
foreach my $p (keys %$preserve) {
|
|
$hidden_tags .= qq|<input type=hidden name="$p" value="$preserve->{$p}">|;
|
|
}
|
|
|
|
my $out = ''; my @vals;
|
|
my $url = GT::CGI->url({ query_string => 0 });
|
|
my $att = ' ';
|
|
$attrib->{name} ||= 'admin';
|
|
foreach (keys %{$attrib}) { $att .= qq|$_="$attrib->{$_}" | }
|
|
foreach my $key (keys %$opts) {
|
|
next if ($key eq 'method');
|
|
my $val = $opts->{$key};
|
|
(ref $val eq 'ARRAY') ? (@vals = @$val) : (@vals = ($val));
|
|
foreach my $val2 (@vals) {
|
|
$self->{html}->escape(\$val2);
|
|
$out .= qq~<input type="hidden" name="$key" value="$val2">~;
|
|
}
|
|
}
|
|
my $mimeenc = $self->{table}->_file_cols() ? 'enctype="multipart/form-data"' : '';
|
|
return qq~<form method="$meth" $mimeenc action="$url"$att>$hidden_tags$out\n~;
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $self->_end_form;
|
|
# -------------------------
|
|
# Display the opening form tag.
|
|
##
|
|
$COMPILE{_end_form} = __LINE__ . <<'END_OF_SUB';
|
|
sub _end_form {
|
|
my $self = shift;
|
|
if (defined $self->{end_form} and $self->{end_form}) {
|
|
if (ref $self->{end_form} eq 'CODE') {
|
|
return $self->{end_form}->($self);
|
|
}
|
|
else {
|
|
return $self->{end_form};
|
|
}
|
|
}
|
|
return "</form>\n";
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $self->_start_html;
|
|
# -------------------------
|
|
# Display the opening form tag.
|
|
##
|
|
$COMPILE{_start_html} = __LINE__ . <<'END_OF_SUB';
|
|
sub _start_html {
|
|
my $self = shift;
|
|
my $opts = shift || {};
|
|
if ($self->{start_html}) {
|
|
if (ref $self->{start_html} eq 'CODE') {
|
|
return $self->{start_html}->($self, $opts);
|
|
}
|
|
else {
|
|
return $self->{start_html};
|
|
}
|
|
}
|
|
my $title = exists $opts->{title} ? $opts->{title} : '';
|
|
my $body = exists $opts->{body} ? $opts->{body} : $BODY;
|
|
return qq~<html>\n<head><title>$title: $self->{record}</title></head><body $BODY>\n~;
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $self->_end_html;
|
|
# -------------------------
|
|
# Display the opening form tag.
|
|
##
|
|
$COMPILE{_end_html} = __LINE__ . <<'END_OF_SUB';
|
|
sub _end_html {
|
|
my $self = shift;
|
|
if ($self->{end_html}) {
|
|
if (ref ($self->{end_html}) eq 'CODE') {
|
|
return $self->{end_html}->($self);
|
|
}
|
|
else {
|
|
return $self->{end_html};
|
|
}
|
|
}
|
|
return "</body>\n</html>\n";
|
|
}
|
|
END_OF_SUB
|
|
|
|
##
|
|
# $self->_buttons;
|
|
# -------------------------
|
|
# Display closing table with form buttons.
|
|
##
|
|
$COMPILE{_buttons} = __LINE__ . <<'END_OF_SUB';
|
|
sub _buttons {
|
|
my $self = shift;
|
|
my $name = shift;
|
|
return qq~
|
|
<table border=1 cellpadding=0 cellspacing=0><tr><td align=center>
|
|
<table border=0 width=500><tr><td align=center><center><font $FONT><input type=submit value="$name $self->{record}"></font></center></td></tr></table>
|
|
</td></tr></table>
|
|
~;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_index_list} = __LINE__ . <<'END_OF_SUB';
|
|
sub _index_list {
|
|
my ($self, $column) = @_;
|
|
my $indexed = $self->{cgi}->{index} || 'none';
|
|
if ($column and ! $self->{cgi}->{index}) {
|
|
$indexed =
|
|
$self->{table}->_is_indexed($column) ? 'regular' :
|
|
$self->{table}->_is_unique($column) ? 'unique' :
|
|
$self->{table}->_is_pk($column) ? 'primary' :
|
|
'none';
|
|
}
|
|
if ($column and $indexed eq 'primary') {
|
|
return "Primary Key";
|
|
}
|
|
my $output = '<select name="index">';
|
|
$output .= qq~<option value="none"~ . ($indexed eq 'none' ? ' SELECTED' : '') . qq~>None</option>~;
|
|
$output .= qq~<option value="regular"~ . ($indexed eq 'regular' ? ' SELECTED' : '') . qq~>Regular</option>~;
|
|
$output .= qq~<option value="unique"~ . ($indexed eq 'unique' ? ' SELECTED' : '') . qq~>Unique</option>~;
|
|
$output .= qq~<option value="primary"~ . ($indexed eq 'primary' ? ' SELECTED' : '') . qq~>Primary Key</option>~
|
|
unless $column;
|
|
$output .= "</select>";
|
|
return $output;
|
|
}
|
|
END_OF_SUB
|
|
|
|
$COMPILE{_index_type} = __LINE__ . <<'END_OF_SUB';
|
|
sub _index_type {
|
|
my ($self, $column) = @_;
|
|
my $indexed = 'none';
|
|
if ($column) {
|
|
$self->{table}->_is_indexed($column) and ($indexed = 'regular');
|
|
$self->{table}->_is_unique($column) and ($indexed = 'unique');
|
|
$self->{table}->_is_pk($column) and ($indexed = 'primary');
|
|
}
|
|
return $indexed;
|
|
}
|
|
END_OF_SUB
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
GT::SQL::Admin - instant admin for any sql table.
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
my $cgi = new GT::CGI;
|
|
my $db = new GT::SQL '/path/to/def';
|
|
my $admin = new GT::SQL::Admin;
|
|
if ($admin->for_me($cgi)) {
|
|
$admin->process(db => $db, cgi => $cgi);
|
|
}
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
GT::SQL::Admin provides an easy way to build a table/relation
|
|
management application. It provides all the HTML and code to
|
|
easily:
|
|
|
|
1. Add records
|
|
2. Delete records
|
|
3. Modify records
|
|
4. Search records
|
|
5. Add columns
|
|
6. Drop columns
|
|
7. Alter table properties
|
|
8. Import data
|
|
9. Export data
|
|
|
|
all in about 6 lines of code.
|
|
|
|
=head2 Usage
|
|
|
|
To use GT::SQL::Admin you need to pass in an existing
|
|
L<GT::SQL> object, and a L<GT::CGI> object.
|
|
|
|
In it's simplest usage, you can simply call:
|
|
|
|
my $admin = new GT::SQL::Admin;
|
|
$admin->process(db => $db, cgi => $cgi);
|
|
|
|
and the admin module will figure out what was requested and display
|
|
the appropriate screen. There is a $admin->for_me method that will
|
|
look to see if the cgi object contains something for the admin
|
|
to do, returning 1 if yes, 0 otherwise. You would then do:
|
|
|
|
my $cgi = new GT::CGI;
|
|
my $admin = new GT::SQL::Admin;
|
|
if ($admin->for_me($cgi)) {
|
|
$admin->process(db => $db, cgi => $cgi);
|
|
}
|
|
|
|
You can also call any of the methods individually. You can create an
|
|
add form like:
|
|
|
|
$admin->add_form;
|
|
|
|
and it will be printed to STDOUT.
|
|
|
|
To change the look of a page, you can pass in strings or code refs
|
|
to display any of the following items:
|
|
|
|
start_html
|
|
header
|
|
start_form
|
|
end_form
|
|
footer
|
|
end_html
|
|
|
|
and the admin will use your html/code when displaying. You can also pass
|
|
in to process:
|
|
|
|
record => 'MyObject'
|
|
|
|
and the admin will use that string when displaying titles like 'Add MyObject'.
|
|
If you don't specify, it will default to the name of the table.
|
|
|
|
=head2 Subclassing the admin
|
|
|
|
You can enhance the functionality of an admin quite easily. By default
|
|
GT::SQL::Admin expects to find a GT::SQL object, a GT::CGI object, and uses
|
|
internally a GT::SQL::Display::HTML object for any form/record html
|
|
generation.
|
|
|
|
Alternatively, you can subclass one or more of the above and use your
|
|
own libraries. For instance, if you wanted to expand the form generation,
|
|
you could subclass the GT::SQL::Display::HTML object and override the display()
|
|
and form() method with your own.
|
|
|
|
The admin will pass in a 'mode' to both display and form that will tell
|
|
you what it is using the form for. This can be one of:
|
|
|
|
search_form
|
|
search_results
|
|
add_form
|
|
add_success
|
|
delete_search_form
|
|
delete_search_results
|
|
download_file
|
|
modify_search_form
|
|
modify_search_results
|
|
modify_form
|
|
modify_success
|
|
modify_multi_search_results
|
|
modify_multi_results_norec
|
|
modify_multi_result_changed
|
|
modify_multi_results_err
|
|
|
|
|
|
There are also several options that can be passed in. See the
|
|
L<GT::SQL::Display::HTML> module for more information.
|
|
|
|
Also be sure to read about subclassing in L<GT::SQL>.
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
http://www.gossamer-threads.com/
|
|
|
|
=head1 VERSION
|
|
|
|
Revision: $Id: Admin.pm,v 1.161 2009/05/11 22:57:15 brewt Exp $
|
|
|
|
=cut
|